16/xx/modex/DEMO06.PAS

   1 (*\r
   2     DEMO06 - Magnifying glass\r
   3     (c) 1994 Alessandro Scotti\r
   4 *)\r
   5 uses Crt, Modex;\r
   6 \r
   7 const\r
   8   R = 40;               (* Lens radius *)\r
   9   K : real = 1.8;       (* Magnifying factor, less makes a stronger lens *)\r
  10 type\r
  11   TLine   = array[ 0..319 ] of byte;\r
  12   PLine   = ^TLine;\r
  13   TScreen = array[ 0..239 ] of PLine;\r
  14 var\r
  15   VScreen: TScreen;                             (* Virtual screen *)\r
  16   BallX  : array[ 0..R, 0..R ] of integer;\r
  17   BallY  : array[ 0..R, 0..R ] of integer;\r
  18   Sprite : array[ -R..R, -R..R ] of byte;\r
  19   Page   : word;\r
  20 \r
  21 (* Returns "lens-view" coordinates of X,Y *)\r
  22 procedure GetCoords( var X, Y: integer );\r
  23 var\r
  24   LR, Z, SinA, SinB, TgB, Q: real;\r
  25 begin\r
  26   LR := Sqrt( X*X + Y*Y );\r
  27   if( LR = 0 ) then Exit;\r
  28   if( LR < R ) then begin\r
  29     Z := Sqrt( R*R - LR*LR );\r
  30     SinA := LR / R;\r
  31     SinB := SinA / K;\r
  32     TgB := SinB / Sqrt( 1-SinB*SinB );\r
  33     Q := LR - TgB*Z;\r
  34     X := Round( X * ( Q/LR ) );\r
  35     Y := Round( Y * ( Q/LR ) );\r
  36   end;\r
  37 end;\r
  38 \r
  39 procedure Init;\r
  40 var\r
  41   F      : file;\r
  42   Palette: array[ 0..767 ] of record R, G, B: byte; end;\r
  43   X, Y,\r
  44   X2, Y2 : integer;\r
  45 begin\r
  46   (* Load background image *)\r
  47   Assign( F, 'demo06.dat' );\r
  48   Reset( F, 1 );\r
  49   BlockRead( F, Palette, 768 );\r
  50   mxSetPalette( @Palette, 0, 256 );\r
  51   for Y:=0 to 239 do begin\r
  52     New( VScreen[Y] );\r
  53     BlockRead( F, VScreen[Y]^, 320 );\r
  54     mxPutImage( VScreen[Y], 0, 480+Y, 320, 1, OP_MOVE );\r
  55   end;\r
  56   Close( F );\r
  57   (* Build lens *)\r
  58   for X:=0 to R do begin\r
  59     for Y:=0 to R do begin\r
  60       X2 := X;\r
  61       Y2 := Y;\r
  62       GetCoords( X2, Y2 );\r
  63       BallX[X, Y] := X2;\r
  64       BallY[X, Y] := Y2;\r
  65     end;\r
  66   end;\r
  67 end;\r
  68 \r
  69 procedure PutLens( OX, OY: integer );\r
  70 var\r
  71   X, Y: integer;\r
  72 begin\r
  73   for X:=0 to R do begin\r
  74     for Y:=0 to R do begin\r
  75       Sprite[Y][X] := VScreen[ OY+BallY[X,Y] ]^[ OX+BallX[X,Y] ];\r
  76       Sprite[Y][-X] := VScreen[ OY+BallY[X,Y] ]^[ OX-BallX[X,Y] ];\r
  77       Sprite[-Y][X] := VScreen[ OY-BallY[X,Y] ]^[ OX+BallX[X,Y] ];\r
  78       Sprite[-Y][-X] := VScreen[ OY-BallY[X,Y] ]^[ OX-BallX[X,Y] ];\r
  79     end;\r
  80   end;\r
  81   (* Draw the sprite *)\r
  82   mxPutImage( @Sprite, OX-R, OY-R+Page, 2*R+1, 2*R+1, OP_MOVE );\r
  83 end;\r
  84 \r
  85 function Delta: integer;\r
  86 begin\r
  87   Delta := Random(3)+2;\r
  88 end;\r
  89 \r
  90 procedure Check( Cond: boolean; var Coord, DeltaC: integer; NewCoord, Sign: integer );\r
  91 begin\r
  92   if( Cond ) then begin\r
  93     Coord := NewCoord;\r
  94     DeltaC := Sign*Delta;\r
  95   end;\r
  96 end;\r
  97 \r
  98 var\r
  99   X, Y, DX, DY: integer;\r
 100   C: char;\r
 101 begin\r
 102   mxInit;\r
 103   mxSetMode( MX_320x240 );\r
 104   Init;\r
 105   Page := 240;\r
 106   X := R;\r
 107   Y := R;\r
 108   Randomize;\r
 109   DX := Delta;\r
 110   DY := Delta;\r
 111 \r
 112   (* Main loop *)\r
 113   repeat\r
 114     (* Update video *)\r
 115     mxBitBlt( 0, 480, 320, 240, 0, Page );\r
 116     PutLens( X, Y );\r
 117     mxCircle( X, Page+Y, R, 0 );\r
 118     (* Update lens coordinates *)\r
 119     Inc( X, DX );\r
 120     Check( X+R >= 319, X, DX, 319-R, -1 );\r
 121     Check( X <= R, X, DX, R, +1 );\r
 122     Inc( Y, DY );\r
 123     Check( Y+R >= 239, Y, DY, 239-R, -1 );\r
 124     Check( Y <= R, Y, DY, R, +1 );\r
 125     (* Flip pages: double buffering, avoid wait for display *)\r
 126     case Page of\r
 127       0  : begin PortW[$3D4] := $000C; Page := 240; end;\r
 128       240: begin PortW[$3D4] := $4B0C; Page := 0; end;\r
 129     end;\r
 130     mxWaitRetrace; (* Wait for hidden page to show *)\r
 131   until( KeyPressed );\r
 132 \r
 133   mxSetMode( MX_TEXT );\r
 134   mxTerm;\r
 135 end.\r