wwww

[16.git] / 16 / x_ / modex / PLASMA.PAS

diff --git a/16/x_/modex/PLASMA.PAS b/16/x_/modex/PLASMA.PAS
new file mode 100755 (executable)
index 0000000..237e292
--- /dev/null
+++ b/16/x_/modex/PLASMA.PAS
@@ -0,0 +1,103 @@
+unit Plasma;\r
+interface\r
+\r
+const\r
+  PAL_RGB       = 0;\r
+  PAL_CLOUDS    = 1;\r
+  PAL_LANDSCAPE = 2;\r
+\r
+procedure MakePlasma( X, Y: integer; W, H: word; C1, C2, C3, C4: byte );\r
+procedure MakePlasmaPalette( var Palette; What: word );\r
+\r
+implementation uses Modex;\r
+\r
+procedure NewColor( XA, YA, X, Y, XB, YB: integer );\r
+var\r
+  Color: longint;\r
+begin\r
+  Color := Abs( XA-XB )+Abs( YA-YB );\r
+  Color := Random( Color shl 1 )-Color;\r
+  Color := (Color+mxGetPixel( XA, YA )+mxGetPixel( XB, YB )+1) shr 1;\r
+  if( Color < 1 ) then Color := 1;\r
+  if( Color > 192 ) then Color := 192;\r
+  if( mxGetPixel( X, Y ) = 0 ) then\r
+    mxPutPixel( X, Y, Lo(Color) );\r
+end;\r
+\r
+procedure Divide( X1, Y1, X2, Y2: integer );\r
+var\r
+  X, Y, Color: integer;\r
+begin\r
+  if not( (X2-X1<2)and(Y2-Y1<2) ) then begin\r
+    X := (X1+X2) shr 1;\r
+    Y := (Y1+Y2) shr 1;\r
+    NewColor( X1, Y1, X, Y1, X2, Y1 );\r
+    NewColor( X2, Y1, X2, Y, X2, Y2 );\r
+    NewColor( X1, Y2, X, Y2, X2, Y2 );\r
+    NewColor( X1, Y1, X1, Y, X1, Y2 );\r
+    Color := (mxGetPixel( X1, Y1 )+mxGetPixel( X2, Y1 )+\r
+              mxGetPixel( X2, Y2 )+mxGetPixel( X1, Y2 )) shr 2;\r
+    mxPutPixel( X, Y, Color );\r
+    Divide( X1, Y1, X, Y );\r
+    Divide( X, Y1, X2, Y );\r
+    Divide( X, Y, X2, Y2 );\r
+    Divide( X1, Y, X, Y2 );\r
+  end;\r
+end;\r
+\r
+procedure MakePlasma;\r
+begin\r
+  Dec( W );\r
+  Dec( H );\r
+  mxPutPixel( X, Y, C1 );\r
+  mxPutPixel( X, Y+H, C2 );\r
+  mxPutPixel( X+W, Y+H, C3 );\r
+  mxPutPixel( X+W, Y, C4 );\r
+  Divide( X, Y, X+W, Y+H );\r
+end;\r
+\r
+procedure MakePlasmaPalette;\r
+type\r
+  TPal = array[ byte ] of record R, G, B: byte end;\r
+var\r
+  I: word;\r
+begin\r
+  FillChar( TPal(Palette)[1], 192*3, 0 );\r
+  case What of\r
+    PAL_CLOUDS:\r
+      for I:=1 to 192 do begin\r
+        TPal(Palette)[I].R := Abs( I-96 )*63 div 96;\r
+        TPal(Palette)[I].G := Abs( I-96 )*63 div 96;\r
+        TPal(Palette)[I].B := 63;\r
+      end;\r
+    PAL_LANDSCAPE:\r
+      begin\r
+        for I:=0 to 31 do begin\r
+          TPal(Palette)[I+1].R := I;\r
+          TPal(Palette)[I+1].G := I;\r
+          TPal(Palette)[I+1].B := I + I shr 1+15;\r
+        end;\r
+        for I:=32 to 63 do begin\r
+          TPal(Palette)[I+1].R := 0;\r
+          TPal(Palette)[I+1].G := I;\r
+          TPal(Palette)[I+1].B := 0;\r
+        end;\r
+        for I:=64 to 191 do begin\r
+          TPal(Palette)[I+1].R := (I-64) div 3 + 15;\r
+          TPal(Palette)[I+1].G := (I-64) div 3 + 15;\r
+          TPal(Palette)[I+1].B := (I-64) div 3 + 15;\r
+        end;\r
+      end;\r
+    else\r
+      for I:=1 to 64 do begin\r
+        TPal(Palette)[I].G := I-1;\r
+        TPal(Palette)[I].B := 64-I;\r
+        TPal(Palette)[I+64].R := I-1;\r
+        TPal(Palette)[I+64].G := 64-I;\r
+        TPal(Palette)[I+128].B := I-1;\r
+        TPal(Palette)[I+128].R := 64-I;\r
+      end;\r
+  end;\r
+end;\r
+\r
+end.
\ No newline at end of file