[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

    {
    This is my plasma code. Written here for windows 24bit mode. There's
    some comments in it. It had a problem. I tried to fix it. Couldn't.
    Deleted some POSITIVELY ABSOLUTELY ESSENTIAL bits of code, and the
    problem went away. Don't ask me, I just wrote it.

    You should be able to put it to palette based code pretty easy. It
    started out that way and then got converted to RGB. Probably all you'd
    need to do, is kill red and green, and just use blue as the palette
    entry. Your problem to make sure your palette has nice colours.

    It still tends to be a little ridgy on the primary axes. If anybody can
    get rid of that, that would be cool. Let me know.

    It's also a fractal terrain generator. Same alg. This is just 3 fractal
    terrain altitude maps overlaid in rgb.

    (Oh, yeah, it's not really windows code. All the real windows code
    should be separate from the useful code, just in case you don't do
    windows, don't be scared.)

    --8<--------------------------------------------------------
    }

    program plasma;
    {integer version of cloud.
     Only works 24bit. Change resolution
     constants width, height if you need.}
    {Left button starts drawing.
     CTRL-ALT-DEL to stop. Or wait for it to finish, and
     right button}
    uses OWindows, ODialogs, WinTypes, WinProcs;

    const
    {integer version of old real constant.
     For calm versions, try FUZZ1/FUZZ2=0.3
     For wild versions, try FUZZ1/FUZZ2=10}
      FUZZ1=1;
      FUZZ2=6;

      width= 800;
      height= 600;

    type
         TMyApp=object (TApplication)
           procedure InitMainWindow; virtual;
           end;

         PMyWindow=^TPlasmaWindow;
         TPlasmaWindow=object (TWindow)
           r,g,b:byte;
           w,h:integer;
           constructor init(AParent:PWindowsObject; ATitle:PChar);
           procedure SetUpWindow; virtual;
           procedure WMLButtonDown(var Msg:TMessage); virtual wm_First+wm_LButtonDown;
           procedure WMRButtonDown(var Msg:TMessage); virtual wm_First+wm_RButtonDown;
           function getclassname:pchar; virtual;
           procedure getwindowclass(var awndclass:twndclass); virtual;
           end;

    var maxx,maxy:integer;
        backg:TColorRef;
        i:integer;

    function clamp(x:integer):byte;
    begin
    {  if x<0 then x:=0
      else if x>255 then x:=255;
      clamp:=x;}
      case x of
       -32767..0 : clamp:=0;
       0..255    : clamp:=x;
       256..32767: clamp:=255;
       else {oops};
       end; {case}
    end;

    function randomcolour:TColorRef;
    var r,g,b:byte;
    begin
        randomcolour:=rgb(random(256),random(256),random(256));
    end;

    procedure TMyApp.InitMainWindow;
    begin
       MainWindow := New(PMyWindow, Init(NIL,'Plasma'));
    end;

    constructor TPlasmaWindow.init(AParent:PWindowsObject; ATitle:PChar);
    begin
      inherited init(AParent,ATitle);
      r:=0; g:=0; b:=0;
      w:=2;h:=2;
      attr.x:=0; attr.y:=0;
      attr.w:=width; attr.h:=height;
      attr.style:=ws_popup + ws_visible;
    end;

    procedure TPlasmaWindow.SetUpWindow;
    begin
      inherited setupwindow;
    end;

    procedure TPlasmaWindow.WMLButtonDown(var Msg:TMessage);
    var ADC:HDC;
        AP,TempP:HPen;
        AB,TempB:HBrush;

        function max(a,b:integer):integer;
        begin
          if a<b then        max:=b      else        max:=a;
        end;

        function mid(a,b:integer):integer;
        begin
          mid:=(a + b) div 2;
        end;

        function ridge(a,b,c,d:integer):TColorref;
        {Take two endpoints, shift the mid point, based on how far apart they are.}
        var variance:integer;
            r,g,l:byte;
            m,n:TColorref;
            vd2:integer;
        begin
          variance:=max(c-a,d-b) * FUZZ1 div FUZZ2;
          vd2:=variance div 2;
          m:=getpixel(adc,(a),(b));
          n:=getpixel(adc,(c),(d));
          r:=clamp(((getrvalue(m) + getrvalue(n)) div 2{ + (random(variance))-vd2}));
          g:=clamp(((getgvalue(m) + getgvalue(n)) div 2{ + (random(variance))-vd2}));
          l:=clamp(((getbvalue(m) + getbvalue(n)) div 2{ + (random(variance))-vd2}));
          ridge:=rgb(r,g,l);
        end;

        function shift(a,b,c,d:integer; col:tcolorref):tcolorref;
        var variance:integer;
            r,g,l:byte;
            vd2:integer;
        begin
    {      variance:=max(d-b,c-a) * FUZZ1 div FUZZ2;}
          variance:=(c-a) * FUZZ1 div FUZZ2;
          vd2:=variance div 2;
          r:=clamp(getrvalue(col) + (random(variance))-vd2);
          g:=clamp(getgvalue(col) + (random(variance))-vd2);
          l:=clamp(getbvalue(col) + (random(variance))-vd2);
          shift:=rgb(r,g,l);
        end;

        procedure quarter(l,t,r,b:integer);
        var mx,my,width,colour,variance:integer;
            mzr,mzg,mzb:byte;
            c:char;
            m,n,o,p,tc:TColorRef;
            vd2:integer;
            abrush:hbrush;
        begin
          width:=r-l;
          if (width>1) or (b-t>1) then
            begin
            variance:=width * FUZZ1 div fuzz2 ;
            vd2:=variance div 2;
            mx:=mid(l,r);
            my:=mid(t,b);
            m:=getpixel(adc,l,t);
            n:=getpixel(adc,l,b);
            o:=getpixel(adc,r,t);
            p:=getpixel(adc,r,b);
            mzr:=clamp((getrvalue(m) + getrvalue(n) + getrvalue(o) + getrvalue(p)) div 4 + random(variance)-vd2);
            mzg:=clamp((getgvalue(m) + getgvalue(n) + getgvalue(o) + getgvalue(p)) div 4 + random(variance)-vd2);
            mzb:=clamp((getbvalue(m) + getbvalue(n) + getbvalue(o) + getbvalue(p)) div 4 + random(variance)-vd2);

            setpixel(adc,mx,my,rgb(mzr,mzg,mzb));
            setpixel(adc,(l),(my),ridge(l,t,l,b));
            setpixel(adc,(r),(my),ridge(r,t,r,b));
            setpixel(adc,(mx),(t),ridge(l,t,r,t));
            setpixel(adc,(mx),(b),ridge(l,b,r,b));

            quarter(l,t,mx,my);
            quarter(l,my,mx,b);
            quarter(mx,t,r,my);
            quarter(mx,my,r,b);
            end;
        end;

    begin
      ADC:=getdc(HWindow);
      randomize;
      maxx:=width-1; maxy:=height-1;
      backg:=getpixel(ADC,10,10);
      setpixel(adc,0,0,randomcolour);
      setpixel(adc,0,maxy,randomcolour);
      setpixel(adc,maxx,0,randomcolour);
      setpixel(adc,maxx,maxy,randomcolour);
      setpixel(adc,mid(0,maxx),0,randomcolour);
      setpixel(adc,mid(0,maxx),maxy,randomcolour);
      setpixel(adc,0,mid(0,maxy),randomcolour);
      setpixel(adc,maxx,mid(0,maxy),randomcolour);
      quarter(0,0,maxx,maxy);
      end;

    procedure TPlasmaWindow.WMRButtonDown(var Msg:TMessage);
    begin
      destroy;
    end;

    function TPlasmaWindow.getclassname:pchar;
    begin
      getclassname:='Cloud Window';
    end;

    procedure TPlasmaWindow.getwindowclass(var awndclass:twndclass);
    begin
      inherited getwindowclass(awndclass);
      awndclass.hbrbackground:=getstockobject(white_brush);
    end;

    var DitherApp:TMyApp;

    begin
      DitherApp.init('Cloud');
      DitherApp.run;
      DitherApp.done;
    end.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]