+++ /dev/null
-(*\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