Program Plasma;

Uses Crt;

Type
  RGB = Record
    R, G, B  : Byte;
  End;
  Palette = Array[0..255] of RGB; { Structure to hold 768 byte palette }

Var
  XRes,              { X Resolution of the screen, make as big as necessary }
  YRes : Integer;    { Y Resolution of the screen, make as big as necessary }
  D    : Palette;    { Palette used in program                              }


Procedure SetPalette(Var c : Palette);
{ Sets the palette, Really? }

Var
  x : Byte;

Begin
  For x := 0 to 255 do
    Begin
      Port[$3C8] := x;           { Set the DAC register for proper color }
      Port[$3C9] := c[x].R;      { Set th Red value }
      Port[$3C9] := c[x].g;      { Set the green value }
      Port[$3C9] := c[x].b;      { Set the blue value  }
    End;
End;

Procedure CyclePalette(Var TPal : Palette);
{ Cycles the palette }

Var
  Temp : RGB;

Begin
  Temp := TPal[0];                 { Store first color values }
  Move(TPal[1], TPal[0], 768-3);   { shift color values down one }
  TPal[255] := Temp;               { store first color values in last color }
  SetPalette(TPal)
End;

Function GetPixel(x, y : Word) : Byte;

Begin
  GetPixel := Mem[$A000:(y * 320) + x];
End;


Procedure MakePalette(Var Color : Palette);
{ Set up the palette to make colors look OK when cycling }
{ Not really too spectacular, play with this to get the desired }
{ palette cycling }


Var
  x : Integer;

Begin
  For x := 0 to 127 do
    Begin
      Color[x].r := 0;
      Color[x].g := (x div 2);
      Color[x].b := (x div 2);
    End;
  For x := 127 to 255 do
    Begin
      Color[x].r := 0;
      Color[x].g := 127 - (x div 2);
      Color[x].b := 127 - (x div 2);
    End;
End;

Procedure PutPixel(x, y : Word; c : Byte);

Begin
  Mem[$A000:(Y*320)+X] := c;
End;


Procedure NewColor(xa, ya, x, y, xb, yb : Integer);
{ Places a new color on the screen based on the average values }
{ of the surrounding pixels plus a random value                }

Const
  RoughNess = 2.25;  { How rough you want the plasma to be }
                     { 1.00  is very smooth                }
                     { 6.00  is very rough                 }
                     { Play around to get results          }

Var
  color : Integer;

Begin
  color := Abs(xa-xb) + abs(ya-yb);
  color := ((GetPixel(xa,ya) + GetPixel(xb, yb)) Div 2) + Round((Random - 0.5)
             * Color * Roughness);
  if color < 1             { Make sure color stays within 1..255 range }
    then Color := 1
    else if color > 255    { can change 255 to any number to reserve }
      then color := 255;   { for you own purposes, say 224, reserving }
                           { colors 225 to 255 for yourself }
                           { don't forget to change the palette cycling }
                           { procedure though! }
  if getpixel(x, y) = 0        { make sure the screen is clear at that point }
    then PutPixel(x, y, color);
End;

Procedure Iterate(x1, y1, x2, y2 : Integer);
{ Does the actual box seperation }

var
  x, y, color : integer;

Begin
  if not((x2-x1<2) and (y2-y1<2)) then
    begin
      x := (x1 + x2) shr 1;
      y := (y1 + y2) shr 1;
      NewColor(x1, y1, x , y1, x2, y1);
      NewColor(x2, y1, x2, y,  x2, y2);
      NewColor(x1, y2, x,  y2, x2, y2);
      NewColor(x1, y1, x1, y,  x1, y2);
      color := (getpixel(x1, y1) + getpixel(x2, y1) +
                getpixel(x2, y2) + getpixel(x1,y2) + 2) Shr 2;
      PutPixel(x, y, color);
      Iterate(x1,y1,x,y);
      Iterate(x,y1,x2,y);
      Iterate(x,y,x2,y2);
      Iterate(x1,y,x,y2);
    end;
End;


Procedure InitGraph; Assembler;
{ Set Mode 13h, 320x200x256 graphics mode }

Asm
  MOV  AX,$0013
  INT  $10
End;

Begin
  XRes := 320;
  YRes := 200;
  Initgraph;
  MakePalette(D);    { set up palette to be cycled }
  setpalette(D);
  Randomize;

  { Put "SEED" pixels here, can be colors 1 - 255, NOT 0!!! }

  Iterate(0, 0, XRes, YRes);
  repeat
    cyclePalette(D);
    delay(20);       { Cycling without delay is too fast! }
  until keypressed;
  TextMode(co80);
End.