16/xw_/modex/PLASMA.PAS

   1 unit Plasma;\r
   2 interface\r
   3 \r
   4 const\r
   5   PAL_RGB       = 0;\r
   6   PAL_CLOUDS    = 1;\r
   7   PAL_LANDSCAPE = 2;\r
   8 \r
   9 procedure MakePlasma( X, Y: integer; W, H: word; C1, C2, C3, C4: byte );\r
  10 procedure MakePlasmaPalette( var Palette; What: word );\r
  11 \r
  12 implementation uses Modex;\r
  13 \r
  14 procedure NewColor( XA, YA, X, Y, XB, YB: integer );\r
  15 var\r
  16   Color: longint;\r
  17 begin\r
  18   Color := Abs( XA-XB )+Abs( YA-YB );\r
  19   Color := Random( Color shl 1 )-Color;\r
  20   Color := (Color+mxGetPixel( XA, YA )+mxGetPixel( XB, YB )+1) shr 1;\r
  21   if( Color < 1 ) then Color := 1;\r
  22   if( Color > 192 ) then Color := 192;\r
  23   if( mxGetPixel( X, Y ) = 0 ) then\r
  24     mxPutPixel( X, Y, Lo(Color) );\r
  25 end;\r
  26 \r
  27 procedure Divide( X1, Y1, X2, Y2: integer );\r
  28 var\r
  29   X, Y, Color: integer;\r
  30 begin\r
  31   if not( (X2-X1<2)and(Y2-Y1<2) ) then begin\r
  32     X := (X1+X2) shr 1;\r
  33     Y := (Y1+Y2) shr 1;\r
  34     NewColor( X1, Y1, X, Y1, X2, Y1 );\r
  35     NewColor( X2, Y1, X2, Y, X2, Y2 );\r
  36     NewColor( X1, Y2, X, Y2, X2, Y2 );\r
  37     NewColor( X1, Y1, X1, Y, X1, Y2 );\r
  38     Color := (mxGetPixel( X1, Y1 )+mxGetPixel( X2, Y1 )+\r
  39               mxGetPixel( X2, Y2 )+mxGetPixel( X1, Y2 )) shr 2;\r
  40     mxPutPixel( X, Y, Color );\r
  41     Divide( X1, Y1, X, Y );\r
  42     Divide( X, Y1, X2, Y );\r
  43     Divide( X, Y, X2, Y2 );\r
  44     Divide( X1, Y, X, Y2 );\r
  45   end;\r
  46 end;\r
  47 \r
  48 procedure MakePlasma;\r
  49 begin\r
  50   Dec( W );\r
  51   Dec( H );\r
  52   mxPutPixel( X, Y, C1 );\r
  53   mxPutPixel( X, Y+H, C2 );\r
  54   mxPutPixel( X+W, Y+H, C3 );\r
  55   mxPutPixel( X+W, Y, C4 );\r
  56   Divide( X, Y, X+W, Y+H );\r
  57 end;\r
  58 \r
  59 procedure MakePlasmaPalette;\r
  60 type\r
  61   TPal = array[ byte ] of record R, G, B: byte end;\r
  62 var\r
  63   I: word;\r
  64 begin\r
  65   FillChar( TPal(Palette)[1], 192*3, 0 );\r
  66   case What of\r
  67     PAL_CLOUDS:\r
  68       for I:=1 to 192 do begin\r
  69         TPal(Palette)[I].R := Abs( I-96 )*63 div 96;\r
  70         TPal(Palette)[I].G := Abs( I-96 )*63 div 96;\r
  71         TPal(Palette)[I].B := 63;\r
  72       end;\r
  73     PAL_LANDSCAPE:\r
  74       begin\r
  75         for I:=0 to 31 do begin\r
  76           TPal(Palette)[I+1].R := I;\r
  77           TPal(Palette)[I+1].G := I;\r
  78           TPal(Palette)[I+1].B := I + I shr 1+15;\r
  79         end;\r
  80         for I:=32 to 63 do begin\r
  81           TPal(Palette)[I+1].R := 0;\r
  82           TPal(Palette)[I+1].G := I;\r
  83           TPal(Palette)[I+1].B := 0;\r
  84         end;\r
  85         for I:=64 to 191 do begin\r
  86           TPal(Palette)[I+1].R := (I-64) div 3 + 15;\r
  87           TPal(Palette)[I+1].G := (I-64) div 3 + 15;\r
  88           TPal(Palette)[I+1].B := (I-64) div 3 + 15;\r
  89         end;\r
  90       end;\r
  91     else\r
  92       for I:=1 to 64 do begin\r
  93         TPal(Palette)[I].G := I-1;\r
  94         TPal(Palette)[I].B := 64-I;\r
  95         TPal(Palette)[I+64].R := I-1;\r
  96         TPal(Palette)[I+64].G := 64-I;\r
  97         TPal(Palette)[I+128].B := I-1;\r
  98         TPal(Palette)[I+128].R := 64-I;\r
  99       end;\r
 100   end;\r
 101 end;\r
 102 \r
 103 end.