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

    {
    > Howdy, I am looking for some Pascal (no ASM please :) plasma or fire
    > psudocode..

     well i guess this is better than psuedocode... it creates plasma.img in
     your current directory, so delete it for a new random pattern, also
     change the delay at the end to your liking. l8r! btw I must have posted
     this at least 4 times now to various people in the last two weeks!
    }

    {$I-}
    program plasma;

      uses
        Crt,Dos;

      const
        F = 0.0000000000000000001; { the "roughness" of the image }

      type
        ColorValue = record Rvalue,Gvalue,Bvalue: byte; end;
        PaletteType = array [0..255] of ColorValue;

      var
        ch: char;
        i: integer;
        p: PaletteType;
        image: file;
        ok: boolean;

      procedure SetVGApalette(var tp: PaletteType);
        var regs: Registers;
      begin { procedure SetVGApalette }
        with regs do
          begin
            AX:=$1012;
            BX:=0; { first register to set }
            CX:=256; { number of registers to set }
            ES:=Seg(tp); DX:=Ofs(tp);
          end;
        Intr($10,regs);
      end; { procedure SetVGApalette }

      procedure PutPixel(x,y: integer; c: byte);
      begin { procedure PutPixel }
        mem[$A000:word(320*y+x)]:=c;
      end; { procedure PutPixel }

      function GetPixel(x,y: integer): byte;
      begin { function GetPixel }
        GetPixel:=mem[$A000:word(320*y+x)];
      end; { function GetPixel }

      procedure adjust(xa,ya,x,y,xb,yb: integer);
        var
          d: integer;
          v: real;
      begin { procedure adjust }
        if GetPixel(x,y)<>0 then exit;
        d:=Abs(xa-xb)+Abs(ya-yb);
        v:=(GetPixel(xa,ya)+GetPixel(xb,yb))/2+(random-0.5)*d*F;
        if v<1 then v:=1;
        if v>=193 then v:=192;
        PutPixel(x,y,Trunc(v));
      end; { procedure adjust }

      procedure subDivide(x1,y1,x2,y2: integer);
        var
          x,y: integer;
          v: real;
      begin { procedure subDivide }
        if KeyPressed then exit;
        if (x2-x1<2) and (y2-y1<2) then exit;

        x:=(x1+x2) div 2;
        y:=(y1+y2) div 2;

        adjust(x1,y1,x,y1,x2,y1);
        adjust(x2,y1,x2,y,x2,y2);
        adjust(x1,y2,x,y2,x2,y2);
        adjust(x1,y1,x1,y,x1,y2);

        if GetPixel(x,y)=0 then
          begin
            v:=(GetPixel(x1,y1)+GetPixel(x2,y1)+GetPixel(x2,y2)+GetPixel(x1,y2))/4;
            PutPixel(x,y,Trunc(v));
          end;

        subDivide(x1,y1,x,y);
        subDivide(x,y1,x2,y);
        subDivide(x,y,x2,y2);
        subDivide(x1,y,x,y2);
      end; { procedure subDivide }

      procedure rotatePalette(var p: PaletteType; n1,n2,d: integer);
        var
          q: PaletteType;
      begin { procedure rotatePalette }
        q:=p;
        for i:=n1 to n2 do
          p[i]:=q[n1+(i+d) mod (n2-n1+1)];
        SetVGApalette(p);
      end; { procedure rotatePalette }

    begin
      Inline($B8/$13/0/$CD/$10); { select video mode 13h (320x200 with 256 colors)
    }
      with p[0] do               { set background palette entry to grey }
        begin
          Rvalue:=32;
          Gvalue:=32;
          Bvalue:=32;
        end;

      for i:=0 to 63 do { create the color wheel }
        begin
          with p[i+1] do begin Rvalue:=i; Gvalue:=63-i; Bvalue:=0; end;
          with p[i+65] do begin Rvalue:=63-i; Gvalue:=0; Bvalue:=i; end;
          with p[i+129] do begin Rvalue:=0; Gvalue:=i; Bvalue:=63-i; end;
        end;

      SetVGApalette(p);

      Assign(image,'PLASMA.IMG');
      Reset(image,1);
      ok:=(ioResult=0);

      if not ok or (ParamCount<>0) then { create a new image }
        begin
          Randomize;

          PutPixel(0,0,1+Random(192));
          PutPixel(319,0,1+Random(192));
          PutPixel(319,199,1+Random(192));
          PutPixel(0,199,1+Random(192));

          subDivide(0,0,319,199);

          Rewrite(image,1);
          BlockWrite(image,mem[$A000:0],$FA00);
        end
      else { use the previous image }
        BlockRead(image,mem[$A000:0],$FA00);

      Close(image);

      repeat
        rotatePalette(p,1,192,+1);
      delay(50);
      until KeyPressed;

      ch:=ReadKey; if ch=#0 then ch:=ReadKey;

      TextMode(LastMode);
    end.

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