trying to translate that lib into open watcom...

[16.git] / 16 / xw__ / modex / DEMO06.PAS

diff --git a/16/xw__/modex/DEMO06.PAS b/16/xw__/modex/DEMO06.PAS
new file mode 100755 (executable)
index 0000000..f26af06
--- /dev/null
+++ b/16/xw__/modex/DEMO06.PAS
@@ -0,0 +1,135 @@
+(*\r
+    DEMO06 - Magnifying glass\r
+    (c) 1994 Alessandro Scotti\r
+*)\r
+uses Crt, Modex;\r
+\r
+const\r
+  R = 40;               (* Lens radius *)\r
+  K : real = 1.8;       (* Magnifying factor, less makes a stronger lens *)\r
+type\r
+  TLine   = array[ 0..319 ] of byte;\r
+  PLine   = ^TLine;\r
+  TScreen = array[ 0..239 ] of PLine;\r
+var\r
+  VScreen: TScreen;                             (* Virtual screen *)\r
+  BallX  : array[ 0..R, 0..R ] of integer;\r
+  BallY  : array[ 0..R, 0..R ] of integer;\r
+  Sprite : array[ -R..R, -R..R ] of byte;\r
+  Page   : word;\r
+\r
+(* Returns "lens-view" coordinates of X,Y *)\r
+procedure GetCoords( var X, Y: integer );\r
+var\r
+  LR, Z, SinA, SinB, TgB, Q: real;\r
+begin\r
+  LR := Sqrt( X*X + Y*Y );\r
+  if( LR = 0 ) then Exit;\r
+  if( LR < R ) then begin\r
+    Z := Sqrt( R*R - LR*LR );\r
+    SinA := LR / R;\r
+    SinB := SinA / K;\r
+    TgB := SinB / Sqrt( 1-SinB*SinB );\r
+    Q := LR - TgB*Z;\r
+    X := Round( X * ( Q/LR ) );\r
+    Y := Round( Y * ( Q/LR ) );\r
+  end;\r
+end;\r
+\r
+procedure Init;\r
+var\r
+  F      : file;\r
+  Palette: array[ 0..767 ] of record R, G, B: byte; end;\r
+  X, Y,\r
+  X2, Y2 : integer;\r
+begin\r
+  (* Load background image *)\r
+  Assign( F, 'demo06.dat' );\r
+  Reset( F, 1 );\r
+  BlockRead( F, Palette, 768 );\r
+  mxSetPalette( @Palette, 0, 256 );\r
+  for Y:=0 to 239 do begin\r
+    New( VScreen[Y] );\r
+    BlockRead( F, VScreen[Y]^, 320 );\r
+    mxPutImage( VScreen[Y], 0, 480+Y, 320, 1, OP_MOVE );\r
+  end;\r
+  Close( F );\r
+  (* Build lens *)\r
+  for X:=0 to R do begin\r
+    for Y:=0 to R do begin\r
+      X2 := X;\r
+      Y2 := Y;\r
+      GetCoords( X2, Y2 );\r
+      BallX[X, Y] := X2;\r
+      BallY[X, Y] := Y2;\r
+    end;\r
+  end;\r
+end;\r
+\r
+procedure PutLens( OX, OY: integer );\r
+var\r
+  X, Y: integer;\r
+begin\r
+  for X:=0 to R do begin\r
+    for Y:=0 to R do begin\r
+      Sprite[Y][X] := VScreen[ OY+BallY[X,Y] ]^[ OX+BallX[X,Y] ];\r
+      Sprite[Y][-X] := VScreen[ OY+BallY[X,Y] ]^[ OX-BallX[X,Y] ];\r
+      Sprite[-Y][X] := VScreen[ OY-BallY[X,Y] ]^[ OX+BallX[X,Y] ];\r
+      Sprite[-Y][-X] := VScreen[ OY-BallY[X,Y] ]^[ OX-BallX[X,Y] ];\r
+    end;\r
+  end;\r
+  (* Draw the sprite *)\r
+  mxPutImage( @Sprite, OX-R, OY-R+Page, 2*R+1, 2*R+1, OP_MOVE );\r
+end;\r
+\r
+function Delta: integer;\r
+begin\r
+  Delta := Random(3)+2;\r
+end;\r
+\r
+procedure Check( Cond: boolean; var Coord, DeltaC: integer; NewCoord, Sign: integer );\r
+begin\r
+  if( Cond ) then begin\r
+    Coord := NewCoord;\r
+    DeltaC := Sign*Delta;\r
+  end;\r
+end;\r
+\r
+var\r
+  X, Y, DX, DY: integer;\r
+  C: char;\r
+begin\r
+  mxInit;\r
+  mxSetMode( MX_320x240 );\r
+  Init;\r
+  Page := 240;\r
+  X := R;\r
+  Y := R;\r
+  Randomize;\r
+  DX := Delta;\r
+  DY := Delta;\r
+\r
+  (* Main loop *)\r
+  repeat\r
+    (* Update video *)\r
+    mxBitBlt( 0, 480, 320, 240, 0, Page );\r
+    PutLens( X, Y );\r
+    mxCircle( X, Page+Y, R, 0 );\r
+    (* Update lens coordinates *)\r
+    Inc( X, DX );\r
+    Check( X+R >= 319, X, DX, 319-R, -1 );\r
+    Check( X <= R, X, DX, R, +1 );\r
+    Inc( Y, DY );\r
+    Check( Y+R >= 239, Y, DY, 239-R, -1 );\r
+    Check( Y <= R, Y, DY, R, +1 );\r
+    (* Flip pages: double buffering, avoid wait for display *)\r
+    case Page of\r
+      0  : begin PortW[$3D4] := $000C; Page := 240; end;\r
+      240: begin PortW[$3D4] := $4B0C; Page := 0; end;\r
+    end;\r
+    mxWaitRetrace; (* Wait for hidden page to show *)\r
+  until( KeyPressed );\r
+\r
+  mxSetMode( MX_TEXT );\r
+  mxTerm;\r
+end.\r