home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vpbgib2.zip / OS2DIVE.PAS < prev    next >
Pascal/Delphi Source File  |  1996-11-02  |  75KB  |  2,266 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples  Version 1.1             █}
  4. {█      DIVE Class - Beta 2                              █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1996 fPrint UK Ltd                 █}
  7. {█      Written May 1996 by Allan Mertner                █}
  8. {█      Inspired by DIVERace by Michael Mrosowski        █}
  9. {█                                                       █}
  10. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  11.  
  12. {$Delphi+}
  13.  
  14. unit Os2Dive;
  15.  
  16. {$IFDEF VER10}
  17.   !! This unit requires a version of Virtual Pascal later than 1.00
  18. {$ENDIF}
  19.  
  20. interface
  21.  
  22. uses
  23.   Os2Def, Os2Base, Os2mm, Os2PmApi,  // OS/2 API definitions
  24.   Use32, VPUtils, SysUtils, Mutex;   // Utility libraries
  25.  
  26. const
  27.   // Standard menu commands handled by default msg handler
  28.   ID_DIVEMENU = 1000;
  29.   ID_NEWTEXT  = 1001;
  30.   ID_SNAP     = 1002;
  31.   ID_SNAP2    = 1003;
  32.   ID_SNAPFULL = 1004;
  33.   ID_EXIT     = 1005;
  34.   ID_PAUSE    = 1006;
  35.   ID_SETCOLOR = 2000;
  36.  
  37. const
  38.   // Maximum display size
  39.   xmax = 1279;
  40.   ymax = 1023;
  41.   FastBlitSupported : Boolean = True;
  42.   SuppressMessages : Boolean = False;
  43.  
  44. type
  45.   Pixel = Record
  46.     x,y: Integer;
  47.   end;
  48.   tRect = Record
  49.     x1,y1, x2,y2: Integer;
  50.   end;
  51.  
  52. type
  53.   DisplayBufferArray = Array[ 0..(ymax+1)*(xmax+1)-1 ] of Byte;
  54.   pDisplayBufferArray = ^DisplayBufferArray;
  55.   tDiveWindow = class;
  56.   tUpdateFunc = Procedure( Dive: tDiveWindow );
  57.   ArcCoorType = record
  58.     X         : Integer;
  59.     Y         : Integer;
  60.     Xstart    : Integer;
  61.     Ystart    : Integer;
  62.     Xend      : Integer;
  63.     Yend      : Integer;
  64.   end;
  65.  
  66.   EDive = class(Exception);
  67.   EDiveDraw = class(EDive);
  68.  
  69.   tDiveWindow = class
  70.   private
  71.     ScreenX: LongInt;
  72.     ScreenY: LongInt;
  73.     hDive: HDive;
  74.     fImage: Longint;
  75.     fSizeX: Longint;
  76.     fSizeY: Longint;
  77.     fccColorFormat : Longint;
  78.     fLineSize: Longint;
  79.     hwndClient: HWnd;
  80.     fColorBits: Byte;
  81.     tidBlitThread: tid;
  82.     tidTimerThread: tid;
  83.     tidPaletteThread: tid;
  84.     TimerEvent: Hev;
  85.     fStopping: Boolean;
  86.     fDisplayBuf: pDisplayBufferArray;
  87.     fUpdateBuffer: tUpdateFunc;
  88.     fMessageHandler: fnWP;
  89.     fLineMode: Boolean;
  90.     fPauseDisplay: Boolean;
  91.     pPalette: Pointer;
  92.     PaletteChanged: Set of 0..255;
  93.     pChanged: Boolean;
  94.     fChanged: Boolean;
  95.     fChangedRect: RectL;
  96.     OldPal: HPs;
  97.     PSPal: HPS;
  98.     SetupBlitter : SETUP_BLITTER;
  99.     mtx_Update: tMutexSem;
  100.     mtx_Rect: tMutexSem;
  101.     mtx_Palette: tMutexSem;
  102.     LineThickness: Word;
  103.     LinePattern: Word;                     // Pattern for line drawing
  104.     fVP: tRect;                            // Current ViewPort
  105.     fVPClip: Boolean;                      // Clipping mode
  106.     fxAspect: Integer;                     // Aspect settings
  107.     fyAspect: Integer;
  108.     PatternInx: Integer;
  109.     fFastBlit: Boolean;
  110.     Procedure SetMainWindowTitle( s: string );
  111.   protected
  112.     hwndFrame: HWnd;
  113.     LastArc: ArcCoorType;
  114.     Procedure SetPaletteArray;
  115.     function GetColours: Longint;
  116.     procedure InitWindow( ResType, ResID: Longint ); virtual;
  117.     function  GetPix(x,y: Longint): Longint;
  118.     procedure SetPix(x,y: Longint; Value: Longint);
  119.     function BeginUpdate: Integer;
  120.     procedure EndUpdate;
  121.     property DisplayBuffer: pDisplayBufferArray read fDisplayBuf;
  122.     procedure SetRGBColor( Num: Word; red,green,blue: byte );
  123.  
  124.     // ViewPort functions; take native x,y coordinates
  125.     function  GetWinPix(x,y: Longint): Longint;
  126.     procedure SetWinPix(x,y, Value: Longint );
  127.     function VPBufAdr( x,y: Integer ): Integer;
  128.     function VPTransformXY( var x, y: Integer ): Boolean;
  129.     procedure VPTransformXXY( var xa, xb, y: Integer );
  130.     procedure VPTransformXYXY( var xa, ya, xb, yb: Integer );
  131.     procedure PixelChanged( x,y: Integer );
  132.     function VPWidth: Integer;
  133.     function VPHeight: Integer;
  134.     function VPXMax: Integer;
  135.     function VPYMax: Integer;
  136.     procedure SetViewPort( xa, ya, xb, yb: Integer );
  137.     procedure FillLine( x1,x2,y,c: Longint );
  138.   public
  139.     FillPattern: Array[0..15] of SmallWord;
  140.     FillColor: Word;
  141.     FillBkColor: Word;
  142.     LinePutMode: Integer;
  143.     // Constructors and destructors
  144.     constructor Create( SizeX, SizeY: Longint; ColorBits: Byte );
  145.     constructor CreateRes( SizeX, SizeY: Longint; ColorBits: Byte; ResType, ResID: Longint );
  146.     destructor Destroy; override;
  147.  
  148.     // Message handling loop
  149.     procedure run; virtual;
  150.  
  151.     // Properties of the window as a whole
  152.     property Colours: Longint read GetColours;
  153.     property Stopping: Boolean read fStopping write fStopping;
  154.     property xSize: Longint read fSizeX;
  155.     property ySize: Longint read fSizeY;
  156.     property PauseDisplay: Boolean read fPauseDisplay write fPauseDisplay;
  157.     property ImageChanged: Boolean read fChanged write fChanged;
  158.     procedure RectChanged( x1,y1, x2,y2: Integer );
  159.     procedure AllChanged;
  160.     property ViewPort: tRect read fVP write fVP;
  161.     property VPClip: Boolean read fVPClip write fVPClip;
  162.     property xAspect: Integer read fxAspect write fxAspect;
  163.     property yAspect: Integer read fyAspect write fyAspect;
  164.     procedure WaitDraw; // Wait until refresh has occured
  165.     procedure SetLineThickness( Thickness: Word );
  166.     procedure SetLinePattern( Pattern: Word );
  167.     property FastBlit: boolean read fFastBlit write fFastBlit;
  168.  
  169.     // User hooks
  170.     property UpdateBuffer: tUpdateFunc read fUpdateBuffer write fUpdateBuffer;
  171.     property MessageHandler: FNWp read fMessageHandler write fMessageHandler;
  172.  
  173.     // Drawing primitives
  174.     procedure Clear( Col: Longint );
  175.     property LineMode: Boolean read fLineMode write fLineMode;
  176.     function FillPatternColor( x, y: Integer ): Integer;
  177.  
  178.     // All Draw* procedures take coordinates within ViewPort
  179.     property Pixels[x,y:Longint]: longint read GetPix write SetPix; default;
  180.     procedure DrawLine( x1,y1, x2,y2, c: Longint );
  181.     procedure DrawFillLine( x1,x2,y: Integer );
  182.     procedure DrawBox( x1,y1, x2,y2, c: Longint );
  183.     procedure DrawFillRect( x1,y1, x2,y2, c: Longint );
  184.     procedure DrawTriangle( p1,p2,p3: Pixel; c: Longint );
  185.     procedure DrawQuad( p1,p2,p3,p4: Pixel; c: Longint );
  186.     Procedure DrawStr( x, y, col, BackCol: Integer; s: String );
  187.     Procedure DrawArc( Center: Pixel; Rad, StAngle, EndAngle, Col: Integer );
  188.     Procedure DrawEllipse( Center: Pixel; XRad, YRad, StAngle, EndAngle, Col: Integer );
  189.     Procedure DrawPieSlice( Center: Pixel; Rad, StAngle, EndAngle, Col: Integer );
  190.     Procedure Flip( Steps: Longint );
  191.   end;
  192.  
  193. const
  194.   coltranslate : boolean = true;           // Translate 256 Colors for Dive ?
  195.  
  196. var
  197.   tSin,tCos : array[0..4*360] of Integer;
  198.   h_ab : Longint;
  199.  
  200. {$IFDEF DEBUG}
  201. procedure log( s: String );
  202. {$ENDIF}
  203.  
  204. implementation
  205.  
  206. {$IFDEF DEBUG}
  207. var
  208.   logfile:text;
  209.   mtx_log: HMtx;
  210.  
  211. procedure log( s: String );
  212. begin
  213.   dosrequestmutexsem( mtx_log, sem_indefinite_wait );
  214.   append(logfile);
  215.   writeln(logfile,format( 'ID %d: %s', [ GetThreadID, s] ));
  216.   close(logfile);
  217.   dosreleasemutexsem( mtx_log );
  218. end;
  219. {$ENDIF}
  220.  
  221.  
  222. type
  223.  t_rgbx = record
  224.             case boolean of
  225.               true: (b,g,r,x:byte);
  226.               false:(l:Longint);
  227.           end;
  228.  
  229.  t_rgbxpal8 = array[0..255] of t_rgbx;
  230.  p_rgbxpal8 = ^t_rgbxpal8;
  231.  
  232. const
  233.   FourCC_LUT8 = ord('L')+(ord('U') shl 8)+(ord('T') shl 16)+(ord('8') shl 24);
  234.   FourCC_R565 = ord('R')+(ord('5') shl 8)+(ord('6') shl 16)+(ord('5') shl 24);
  235.   FourCC_BGR4 = ord('B')+(ord('G') shl 8)+(ord('R') shl 16)+(ord('4') shl 24);
  236.   FourCC_SCRN = 0;
  237.  
  238.   pszMyWindow:Pchar = 'DiveWindow';
  239.   pszTitleText:Pchar = 'Dive Window';
  240.  
  241. var
  242.   h_dc : hDC;
  243.   h_pal:HPAL;
  244.  
  245. var achTitle: array[0..255] of char;
  246.  
  247. Procedure tDiveWindow.SetMainWindowTitle(s:string);
  248. begin
  249.   StrPCopy( @achTitle, s );
  250.   WinPostMsg ( hwndFrame, WM_COMMAND, ID_NEWTEXT, longint(@achTitle));
  251. end;
  252.  
  253. Function GetSnapHeight(ulHeight:ULONG):ULONG;
  254. begin
  255.   Inc( ulHeight, WinQuerySysValue ( HWND_DESKTOP, SV_CYSIZEBORDER ) * 2);
  256. {  Inc( ulHeight, WinQuerySysValue ( HWND_DESKTOP, SV_CYBORDER ) * 2);
  257.   Inc( ulHeight, WinQuerySysValue ( HWND_DESKTOP, SV_CYMENU )*2 );}
  258.   Inc( ulHeight, WinQuerySysValue ( HWND_DESKTOP, SV_CYTITLEBAR ) );
  259.   GetSnapHeight:=ulHeight;
  260. end;
  261.  
  262. Function GetSnapWidth(ulWidth:ULONG):ULONG;
  263. begin
  264.   Inc( ulWidth, WinQuerySysValue ( HWND_DESKTOP, SV_CXSIZEBORDER ) * 2);
  265.   GetSnapWidth:=ulWidth;
  266. end;
  267.  
  268. function MyWindowProc(Window: HWnd; Msg: ULong; Mp1,Mp2: MParam): MResult;cdecl;
  269. const
  270.   h_psPal     :HPS = 0;              (* Presentation Space handle            *)
  271.   test:longint = $303030;
  272. var
  273.   point_l     :POINTL;               (* Point to offset from Desktop         *)
  274.   swpos       :SWP;                  (* Window position                      *)
  275.   h_rgn       :HRGN;                 (* Region handle                        *)
  276.   h_ps        :HPS;                  (* Presentation Space handle            *)
  277.   rcls        :array[0..49] of RECTL;(* Rectangle coordinates                *)
  278.   rgnCtl      :RGNRECT;              (* Processing control structure         *)
  279.   MyDive      :tDiveWindow;
  280.   pPal        :PLONG;
  281.  
  282.   NoRectl     :PRECTL;
  283.   PaletteColors:ULONG;
  284.   xwidth      : uLong;
  285.   yHeight     : uLong;
  286.  
  287.   sizl:SIZEL;
  288.  
  289.   rc:Ulong;
  290.   ColorTable: p_rgbxpal8;
  291.   p:pChar;
  292.  
  293. begin
  294.   NoRectl:=Nil;
  295.   MyDive:= tDiveWindow(WinQueryWindowULong (Window, 0));
  296.   // Run user's message handler first
  297.   If ( MyDive <> nil ) and Assigned( MyDive.MessageHandler ) then
  298.     begin
  299.       Result := MyDive.MessageHandler( Window, Msg, mp1, mp2 );
  300.       If Result <> 0 then
  301.         // Message handled by user
  302.         Exit;
  303.     end;
  304.  
  305.   if (MyDive <> nil) or (msg=WM_CREATE) then begin
  306.     case msg of
  307.       WM_CREATE:
  308.         winPostMsg( Window, 11111, 0, 0 );
  309.       11111:
  310.         begin
  311.           // Set Up the physical palette
  312.           sizl.cx := 0;
  313.           sizl.cy := 0;
  314.           h_DC := WinOpenWindowDC(Window);
  315.           h_psPal := GpiCreatePS(h_ab,h_dc,sizl,
  316.                        PU_PELS or GPIF_DEFAULT or GPIT_MICRO or GPIA_ASSOC);
  317.  
  318.           h_pal := GpiQueryPalette( h_pspal );
  319. //          GpiQueryPaletteInfo( h_pal, h_pspal, 0, 0, 16, uLong( MyDive.pPalette^ ) );
  320.         end;
  321.       WM_COMMAND:
  322.         case USHORT(mp1) of
  323.           ID_SETCOLOR:
  324.             begin
  325.               DiveSetSourcePalette ( MyDive.hDive,
  326.                                      Short2FromMP(mp1),
  327.                                      1,
  328.                                      @mp2 );
  329.             end;
  330.           ID_SNAP:
  331.             // Snap Window to Dive Buffer Size
  332.             WinSetWindowPos ( MyDive.hwndFrame, HWND_TOP,
  333.                               0, 0,  // Ignored
  334.                               GetSnapWidth( MyDive.xsize ),
  335.                               GetSnapHeight( MyDive.ySize ),
  336.                               SWP_SIZE or SWP_ACTIVATE or SWP_SHOW );
  337.  
  338.           ID_SNAP2:
  339.             // Snap Window to Size & height * 2
  340.             With MyDive do
  341.               begin
  342.                 xWidth := xSize+GetSnapWidth( xSize );
  343.                 yHeight := ySize+GetSnapHeight( ySize );
  344.                 WinSetWindowPos ( hwndFrame, HWND_TOP,
  345.                                   (ScreenX-xWidth) div 2, (ScreenY-yHeight) div 2,
  346.                                   xWidth, yHeight,
  347.                                   SWP_MOVE or SWP_SIZE or SWP_ACTIVATE or SWP_SHOW );
  348.               end;
  349.  
  350.           ID_SNAPFULL:
  351.             // Snap to Full Size but retain (approx) aspect ratio
  352.             With MyDive do
  353.               begin
  354.                 yHeight := (fSizeY*ScreenX) div fSizeX;
  355.                 WinSetWindowPos ( hwndFrame, HWND_TOP,
  356.                                   0, (screenY-yHeight) div 2,
  357.                                   ScreenX, yHeight,
  358.                                   SWP_MOVE or SWP_SIZE or SWP_ACTIVATE or SWP_SHOW );
  359.               end;
  360.  
  361.           ID_EXIT:
  362.             // Post to quit the dispatch message loop.
  363.             WinPostMsg ( Window, WM_QUIT, 0, 0 );
  364.  
  365.           ID_PAUSE:
  366.             // Pause by stopping timer thread
  367.             with MyDive do
  368.               begin
  369.                 PauseDisplay := not PauseDisplay;
  370.                 If PauseDisplay then
  371.                   SetMainWindowTitle('PAUSED')
  372.                 else
  373.                   SetMainWindowTitle('Resumed');
  374.               end;
  375.  
  376.           ID_NEWTEXT:
  377.             // Write new text string to the title bar
  378.             WinSetWindowText ( MyDive.hwndFrame, PCHAR(mp2) );
  379.           else
  380.             begin
  381.               // Let PM handle this message.
  382.               MyWindowProc := WinDefWindowProc ( Window, msg, mp1, mp2 );
  383.               exit;
  384.             end;
  385.         end; // WM_COMMAND
  386.  
  387.       WM_VRNDISABLED:
  388.         DiveSetupBlitter ( MyDive.hDive, nil );
  389.  
  390.       WM_VRNENABLED:
  391.         begin
  392.           h_ps := WinGetPS ( Window );
  393.           if h_ps<>0 then begin
  394.             h_rgn := GpiCreateRegion ( h_ps, 0, NoRectl^ );
  395.             if h_rgn<>0 then begin
  396.               WinQueryVisibleRegion ( Window, h_rgn );
  397.               rgnCtl.ircStart     := 0;
  398.               rgnCtl.crc          := 50;
  399.               rgnCtl.ulDirection  := 1;
  400.  
  401.               // Get the all ORed rectangles
  402.               if GpiQueryRegionRects ( h_ps, h_rgn, NoRectl^, rgnCtl, rcls[0]) then
  403.                 begin
  404.                   // Now find the window position and size, relative to parent.
  405.                   WinQueryWindowPos ( MyDive.hwndClient, swpos );
  406.  
  407.                   // Convert the point to offset from desktop lower left.
  408.                   point_l.x := swpos.x;
  409.                   point_l.y := swpos.y;
  410.                   WinMapWindowPoints ( MyDive.hwndFrame,
  411.                                        HWND_DESKTOP, point_l, 1 );
  412.  
  413.                   // Tell DIVE about the new settings.
  414.                   With MyDive.SetupBlitter do
  415.                     begin
  416.                       ulStructLen := sizeof ( SETUP_BLITTER );
  417.                       fccSrcColorFormat := MyDive.fccColorFormat;
  418.                       ulSrcWidth := MyDive.fSizeX;
  419.                       ulSrcHeight := MyDive.fSizeY(* shr 1*);
  420.                       ulSrcPosX := 0;
  421.                       ulSrcPosY := 0;
  422.                       fInvert := FALSE (*TRUE*);
  423.                       ulDitherType := 0;
  424.  
  425.                       if coltranslate then
  426.                         fccDstColorFormat := FourCC_Scrn
  427.                       else
  428.                         fccDstColorFormat := FOURCC_LUT8;
  429.  
  430.                       ulDstWidth := swpos.cx;
  431.                       ulDstHeight := swpos.cy(*shr 1*);
  432.  
  433.                       lDstPosX := 0;
  434.                       lDstPosY := 0;
  435.                       lScreenPosX := point_l.x;
  436.                       lScreenPosY := point_l.y;
  437.                       ulNumDstRects := rgnCtl.crcReturned;
  438.                       pVisDstRects := @rcls;
  439.                     end; // With
  440.  
  441.                   rc := DiveSetupBlitter ( MyDive.hDive, @MyDive.SetupBlitter );
  442.                   if rc <> 0 then
  443.                     raise EDive.CreateFmt( 'Cannot setup DIVE blitter; rc = %d', [rc] );
  444.                 end
  445.               else
  446.                 begin
  447.                   rc := DiveSetupBlitter ( MyDive.hDive, nil );
  448.                   if rc <> 0 then
  449.                     raise EDive.CreateFmt( 'Cannot setup DIVE blitter; rc = %d', [rc] );
  450.                 end;
  451.  
  452.               GpiDestroyRegion( h_ps, h_rgn );
  453.             end;
  454.           end;
  455.         end; // WM_VRNENABLED
  456.  
  457.       WM_REALIZEPALETTE:
  458.         begin
  459. {          h_ps := WinBeginPaint ( MyDive.hwndFrame, 0 , Nil);
  460.  
  461.           GetMem(pPal,sizeof(LONG) * MyDive.Colours );
  462.  
  463.           GpiQueryRealColors ( h_ps, 0, 0, MyDive.Colours, pPal^ );
  464.  
  465.           if coltranslate then
  466.             DiveSetDestinationPalette ( MyDive.hDive, 0,
  467.                                         MyDive.Colours,
  468.                                         Pointer(pPal));
  469.           FreeMem(pPal,sizeof(LONG) * MyDive.Colours);
  470.  
  471.           WinEndPaint ( h_ps );}
  472.          end;
  473.  
  474.       WM_CHAR :
  475.         // Handle default hotkeys
  476.         if (CharMsgMp1(Mp1).fs and kc_KeyUp) = 0 then { Key is Down }
  477.           case uShort(mp2 shr 16) of
  478.             VK_F2 : WinPostMsg ( Window, WM_COMMAND, ID_SNAP2, 0 );
  479.             VK_F3 : WinPostMsg ( Window, WM_QUIT, 0, 0 );
  480.             VK_F4 : WinPostMsg ( Window, WM_COMMAND, ID_SNAPFULL, 0 );
  481.             VK_F5 : WinPostMsg ( Window, WM_COMMAND, ID_PAUSE, 0 );
  482.             VK_F6 : WinPostMsg ( Window, WM_COMMAND, ID_SNAP, 0 );
  483.           end;
  484.  
  485.       WM_SIZE, WM_ERaSEBACKGROUND:
  486.       begin
  487.         MyDive.AllChanged;
  488.         MyWindowProc := WinDefWindowProc ( Window, msg, mp1, mp2 );
  489.       end;
  490.  
  491.       WM_CLOSE:
  492.       begin
  493.         // Post to quit the dispatch message loop.
  494.         GpiSelectPalette(h_psPal,0);
  495.         GpiDeletePalette(h_pal);
  496.         GpiDestroyPS(h_psPal);
  497.  
  498.         WinPostMsg ( Window, WM_QUIT, 0, 0 );
  499.       end;
  500.     else
  501.       begin
  502.         // Let PM handle this message.
  503.         MyWindowProc := WinDefWindowProc ( Window, msg, mp1, mp2 );
  504.         exit;
  505.       end;
  506.     end; { Case msg }
  507.   end
  508.   else
  509.     begin
  510.       // Let PM handle this message.
  511.       MyWindowProc := WinDefWindowProc ( Window, msg, mp1, mp2 );
  512.       exit;
  513.     end;
  514.   MyWindowProc:=0;
  515. end;
  516.  
  517. function GetTime: Longint;
  518. begin
  519.   DosQuerySysInfo ( QSV_MS_COUNT, QSV_MS_COUNT, Result, 4 );
  520. end;
  521.  
  522. Function TimerThread( P: Pointer ): Longint;
  523. var
  524.   rc: ApiRet;
  525.  
  526. begin
  527.   with tDiveWindow(p) do
  528.     While not stopping do
  529.       begin
  530.         rc := DosPostEventSem( TimerEvent );
  531.         if rc = 6 then exit;
  532.         DosSleep(50);
  533.  
  534.         // If paused, delay until unpaused or exit
  535.         While PauseDisplay and not Stopping do
  536.           DosSleep(100);
  537.       end;
  538. end;
  539.  
  540. Function BlitterThread( P: Pointer ): Longint;
  541. var
  542.   MyDive      : tDiveWindow;
  543.   rc          : ApiRet;
  544.   PostCount   : Longint;
  545.   NewBlitter  : Setup_Blitter;
  546.   swpos       : SWP;                  // Window position
  547.   point_l     : POINTL;               // Point to offset from Desktop
  548.   xRatio      : Double;
  549.   yRatio      : Double;
  550.   RoundUpX    : Longint;
  551.   RoundUpY    : Longint;
  552.   DeltaY      : Longint;
  553.  
  554. begin
  555.   MyDive := tDiveWindow( P );
  556.  
  557.   // Set up colour palette
  558.   if ColTranslate then
  559.     With MyDive do
  560.       DiveSetSourcePalette ( hDive, 0, Colours, pPalette );
  561.  
  562.   try
  563.   With MyDive do
  564.     While not Stopping do
  565.       begin
  566.         If Assigned( UpdateBuffer ) then
  567.           if BeginUpdate = 0 then
  568.             begin
  569.               // Call user function to update buffer content
  570.               UpdateBuffer( MyDive );
  571.               EndUpdate;
  572.             end;
  573.  
  574.         if not PauseDisplay then
  575.           begin
  576.             mtx_Rect.Request;
  577.             // Make image appear in window
  578.             if fChanged then
  579.               begin
  580.                 mtx_Update.Request;
  581.                 if FastBlit then
  582.                   begin
  583.                     // Accelerated blit routine
  584.                     WinQueryWindowPos ( hwndClient, swpos );
  585.                     xRatio := swpos.cx / xSize;
  586.                     yRatio := swpos.cy / ySize;
  587.  
  588.                     // Calculate alignments for irregularly sized windows
  589.                     RoundUpX := max( 1, Round(xRatio) );
  590.                     While ( RoundUpX <> xRatio ) and (RoundUpX < xsize ) do
  591.                       RoundUpX := RoundUpX * 10;
  592.                     RoundUpY := max( 1, Round(yRatio) );
  593.                     While ( RoundUpY <> yRatio ) and (RoundUpy < ysize ) do
  594.                       RoundUpY := RoundUpY * 10;
  595.                     with NewBlitter do
  596.                       begin
  597.                         ulStructLen := sizeof ( SETUP_BLITTER ) - 16;
  598.                         fccSrcColorFormat := MyDive.fccColorFormat;
  599.                         if coltranslate then
  600.                           fccDstColorFormat := FourCC_Scrn
  601.                         else
  602.                           fccDstColorFormat := FOURCC_LUT8;
  603.                         ulDitherType := 0;
  604.                         fInvert := False;
  605.  
  606.                         // Calculate source rectangle based on fChangedRect
  607.                         with fChangedRect do
  608.                           begin
  609.                             // X Source and width
  610.                             ulSrcPosX   := xLeft;
  611.                             ulSrcWidth  := succ(xRight - xLeft);
  612.                             // Align source to avoid DIVE hiccups
  613.                             if ulSrcPosX mod RoundUpX <> 0 then  // Round down
  614.                               ulSrcPosX := max( 0, (ulSrcPosX div RoundUpX) * RoundUpX );
  615.                             if ulSrcWidth mod RoundUpX <> 0 then // Round up
  616.                               ulSrcWidth := succ( ulSrcWidth div RoundUpX ) * RoundUpX;
  617.                             // Limit source width to window width
  618.                             ulSrcWidth := min( xSize - ulSrcPosX, ulSrcWidth );
  619.  
  620.                             // Y Source
  621.                             ulSrcPosY   := yBottom;
  622.                             // Align source to avoid DIVE hiccups
  623.                             if ulSrcPosY mod RoundUpY <> 0 then  // Round up
  624.                               begin
  625.                                 ulSrcPosY := max( 0, pred(ulSrcPosY div RoundUpY) * RoundUpY );
  626.                                 yBottom := ulSrcPosY;
  627.                               end;
  628.  
  629.                             // Y Height
  630.                             ulSrcHeight := succ(yTop - yBottom);
  631.                             if ulSrcHeight mod RoundUpY <> 0 then // Round up
  632.                               while (yTop<=ySize) and (ulSrcHeight+ulSrcPosY<ysize) and (ulSrcHeight mod RoundUpY <> 0) do
  633.                                 begin
  634.                                   Inc(yTop);
  635.                                   Inc(ulSrcHeight);
  636.                                 end;
  637.                             ulSrcHeight := min( ysize - ulSrcPosY, ulSrcHeight );
  638.  
  639.                             // Destination rectangle, already aligned
  640.                             lDstPosX := Round(xRatio*ulSrcPosX);
  641.                             lDstPosY := swpos.cy-Round(yRatio*succ(yTop));
  642.                             ulDstWidth := Round(xratio*ulSrcWidth);
  643.                             ulDstHeight := Round(yratio*ulSrcHeight);
  644.                           end; // With fChangedRect
  645.                       end; // With
  646.                     {$IFDEF DEBUG}
  647.                     with NewBlitter do
  648.                       log( Format('Blitting Src (%3d,%3d) (%3d,%3d) Dst (%3d,%3d) (%3d,%3d)',
  649.                         [ ulSrcPosx, ulSrcPosY, ulSrcWidth, ulSrcHeight,
  650.                            lDstPosx, lDstPosY, ulDstWidth, ulDstHeight] ) );
  651.                     With fChangedRect do
  652.                       log( Format(' - swpos (%3d,%3d) fchanged (%3d,%3d,%3d,%3d)',
  653.                        [ swpos.cx, swpos.cy, xLeft, yBottom, xRight, yTop ] ) );
  654.                     {$ENDIF}
  655.  
  656.                     if DiveSetupBlitter ( hDive, @NewBlitter ) <> 0 then ;
  657.                   end; // FastBlit
  658.  
  659.                 with fChangedRect do
  660.                   begin
  661.                     xLeft := xsize;
  662.                     xRight := 0;
  663.                     yTop := 0;
  664.                     yBottom := ySize;
  665.                   end;
  666.                 fChanged := False;
  667.  
  668.                 mtx_Rect.Release;
  669.  
  670.                 if DiveBlitImage ( hDive, fImage, dive_Buffer_Screen ) <> 0 then ;
  671.                 mtx_Update.Release;
  672.               end
  673.             else
  674.               begin
  675.                 mtx_Rect.Release;
  676.  
  677.                 // Nothing to do - wait for timer
  678.                 rc := DosWaitEventSem( TimerEvent, 200 );
  679.                 if rc = 6 then exit;
  680.                 DosResetEventSem(TimerEvent,postcount);
  681.               end;
  682.           end;
  683.  
  684.     end;
  685.   except
  686.     on e:exception do
  687.       raise EDive.Create( 'Blitter error '+e.message );
  688.   end;
  689. end;
  690.  
  691. function tDiveWindow.BeginUpdate: Integer;
  692. var
  693.   ulScanLineBytes:ULONG;
  694.   ulScanLines:ULONG;
  695. begin
  696.   mtx_Update.Request;
  697.  
  698.   Result := DiveBeginImageBufferAccess (  // <> 0 = error
  699.               hDive,
  700.               fImage,
  701.               Pointer( fDisplayBuf ),
  702.               ulScanLineBytes,
  703.               ulScanLines );
  704.  
  705.   if Result <> 0 then
  706.     if Result = Dive_Err_No_Direct_Access then
  707.       raise EDive.Create( 'Display or graphics driver does not support direct video access' )
  708.     else
  709.       raise EDive.CreateFmt( 'Cannot access image buffer; rc = %d', [Result] );
  710. end;
  711.  
  712. procedure tDiveWindow.EndUpdate;
  713. begin
  714.   DiveEndImageBufferAccess ( hDive, fImage );
  715.   mtx_Update.Release;
  716. end;
  717.  
  718. function PaletteThread( P: Pointer ): Longint;
  719. var
  720.   MyDive : tDiveWindow;
  721.   i,j    : Integer;
  722.  
  723. begin
  724.   MyDive := tDiveWindow( P );
  725.  
  726.   With MyDive do
  727.     While not Stopping do
  728.       begin
  729.         If pChanged then
  730.           While pChanged do
  731.             begin
  732.               mtx_Palette.Request;
  733.  
  734.               i := 0;
  735.               While not (i in PaletteChanged) do
  736.                 Inc(i);
  737.               j := succ(i);
  738.               While (j in PaletteChanged) do
  739.                 Inc(j);
  740.  
  741.               PaletteChanged := PaletteChanged - [i..j-1];
  742.               mtx_Palette.Release;
  743.  
  744.               DiveSetSourcePalette ( hDive,
  745.                                      i,
  746.                                      j-i,
  747.                                      @(p_rgbxpal8(pPalette)^[i]) );
  748.  
  749.               pChanged := PaletteChanged <> [];
  750.               DosSleep(0);
  751.             end
  752.         else
  753.           DosSleep( 50 );
  754.       end;
  755. end;
  756.  
  757. procedure tDiveWindow.SetRGBColor( Num: Word; red,green,blue: byte );
  758. var
  759.   col: Longint;
  760. begin
  761.   mtx_Palette.Request;
  762.  
  763.   with p_rgbxpal8(pPalette)^[ Num ] do
  764.     begin
  765.       r := red;
  766.       g := green;
  767.       b := blue;
  768.     end;
  769.   PaletteChanged := PaletteChanged + [Num];
  770.   pChanged := True;
  771.   ImageChanged := True;
  772.   AllChanged;
  773.   mtx_Palette.Release;
  774. end;
  775.  
  776. constructor tDiveWindow.Create( SizeX, SizeY: Longint; ColorBits: Byte );
  777. begin
  778.   CreateRes( SizeX, SizeY, ColorBits, 0, 0 );
  779. end;
  780.  
  781. Procedure tDiveWindow.SetPaletteArray;
  782. const
  783.   EGAColors: array[0..15] of t_rgbx =
  784.      (                                     {NAME       COLOR}
  785.      (b:$00; g:$00; r:$00; x:pc_Reserved ),{Black      EGA  0}
  786.      (b:$FC; g:$00; r:$00; x:pc_Reserved  ),{Blue       EGA  1}
  787.      (b:$24; g:$FC; r:$24; x:pc_Reserved  ),{Green      EGA  2}
  788.      (b:$FC; g:$FC; r:$00; x:pc_Reserved  ),{Cyan       EGA  3}
  789.      (b:$14; g:$14; r:$FC; x:pc_Reserved  ),{Red        EGA  4}
  790.      (b:$FC; g:$00; r:$B0; x:pc_Reserved  ),{Magenta    EGA  5}
  791.      (b:$00; g:$48; r:$70; x:pc_Reserved  ),{Brown      EGA 20}
  792.      (b:$C4; g:$C4; r:$C4; x:pc_Reserved  ),{White      EGA  7}
  793. //   (b:$34; g:$34; r:$34; x:pc_Reserved  ),{Gray       EGA 56}
  794. //   (b:$70; g:$00; r:$00; x:pc_Reserved  ),{Lt Blue    EGA 57}
  795.      (b:$54; g:$54; r:$54; x:pc_Reserved  ),{Gray       EGA 56}
  796.      (b:$A0; g:$00; r:$00; x:pc_Reserved  ),{Lt Blue    EGA 57}
  797.      (b:$00; g:$70; r:$00; x:pc_Reserved  ),{Lt Green   EGA 58}
  798.      (b:$70; g:$70; r:$00; x:pc_Reserved  ),{Lt Cyan    EGA 59}
  799.      (b:$00; g:$00; r:$70; x:pc_Reserved  ),{Lt Red     EGA 60}
  800.      (b:$70; g:$00; r:$70; x:pc_Reserved  ),{Lt Magenta EGA 61}
  801.      (b:$24; g:$FC; r:$FC; x:pc_Reserved  ),{Yellow     EGA 62}
  802.      (b:$FC; g:$FC; r:$FC; x:pc_Reserved  ) {Br. White  EGA 63}
  803.      );
  804.  
  805. const
  806.   start = 0;
  807.  
  808. var
  809.   i,j:longint;
  810.   rgbxpal:p_rgbxpal8;
  811.  
  812. begin
  813.   GetMem(pPalette,256*sizeof(ULONG));
  814.  
  815.   rgbxpal:=pPalette;
  816.   FillChar(rgbxpal^,sizeof(rgbxpal^),#0);
  817.  
  818.   for i:=0 to 255 do
  819.     rgbxpal^[i] := EGAColors[i mod 16];
  820.  
  821.   for i:=16+Start to 31+Start do
  822.     with rgbxpal^[i] do
  823.       begin
  824.         r := (i-15-Start)*16-1;
  825.         g := (i-15-Start)*16-1;
  826.         b := (i-15-Start)*16-1;
  827.         x := pc_Reserved;
  828.       end;
  829.  
  830.   for i:=32+Start to 47+Start do
  831.     with rgbxpal^[i] do
  832.       begin
  833.         j := 15+i-32-Start;
  834.         if j <= 7 then
  835.           b := (7-j)*16
  836.         else
  837.           b := 0;
  838.         if j <= 7 then
  839.           g := 0
  840.         else
  841.           g := (j-15)*16;
  842.  
  843.         if j <= 15 then
  844.           r := (j-15)*16
  845.         else
  846.           r := (31-j)*16;
  847.         x := pc_Reserved;
  848.       end;
  849. end;
  850.  
  851. constructor tDiveWindow.CreateRes( SizeX, SizeY: Longint; ColorBits: Byte; ResType, ResID: Longint );
  852. var
  853.   NullPtr: Pointer;
  854.   ScanLineBytes: Longint;
  855.   ScanLines: Longint;
  856.   Buffer: Pointer;
  857.   h_mq : HMq;
  858.   rc: Bool;
  859.  
  860. begin
  861.   If not (ColorBits in [8,16,24]) then
  862.     Raise EDive.Create( 'Only colour depths of 8, 16 or 24 is allowed' );
  863.  
  864.   fColorBits := ColorBits;
  865.   NullPtr := nil;
  866.   if DiveOpen ( hDive, FALSE, NullPtr ) <> 0 then
  867.     Raise EDive.Create( 'Cannot open DIVE engine' );
  868.  
  869.   fSizeX := SizeX;
  870.   fSizeY := SizeY;
  871.   fLineSize := 0;
  872.   Case ColorBits of
  873.      8 : FccColorFormat := FourCC_LUT8;
  874.     16 : FccColorFormat := FourCC_R565;
  875.     24 : FccColorFormat := FourCC_BGR4;
  876.   end;
  877.   if DiveAllocImageBuffer( hDive,             // Dive Handle
  878.                            fImage,            // Image handle number
  879.                            fccColorFormat,    // Color depth
  880.                            fSizeX,            // X size
  881.                            fSizeY,            // Y size
  882.                            fLineSize,
  883.                            nil ) <> 0 then
  884.     Raise EDive.Create( 'Failed to allocate DIVE image buffer' );
  885.  
  886.   if DiveBeginImageBufferAccess( hDive,      // Dive Handle
  887.                                  fImage,
  888.                                  Buffer,
  889.                                  ScanLineBytes,
  890.                                  ScanLines ) <> 0 then
  891.     begin
  892.       DiveFreeImageBuffer( hDive, fImage );
  893.       Raise EDive.Create( 'Failed to access DIVE image buffer' );
  894.     end;
  895.  
  896.   Fillchar( Buffer^, fSizeX*fSizeY, 0 );
  897.  
  898.   DiveEndImageBufferAccess ( hDive, fImage );
  899.  
  900.   SetPaletteArray;  // Set up default palette
  901.   ScreenX := WinQuerySysValue ( HWND_DESKTOP, SV_CXSCREEN );
  902.   ScreenY := WinQuerySysValue ( HWND_DESKTOP, SV_CYSCREEN );
  903.  
  904.   h_ab := WinInitialize ( 0 );
  905.   h_mq := WinCreateMsgQueue ( h_ab, 0 );
  906.  
  907.   InitWindow( ResType, ResId );
  908.  
  909.   rc := WinSetWindowULong( hwndClient, 0, Longint(Self) );
  910.  
  911.   if rc then
  912.     WinSetVisibleRegionNotify ( hwndClient, TRUE );
  913.  
  914.   if rc then
  915.     rc := WinPostMsg ( hwndFrame, WM_VRNENABLED, 0, 0 );
  916.  
  917.   if not rc then
  918.     Raise EDive.CreateFmt( 'Error initialising frame window; rc = %d', [rc] );
  919.  
  920.   Stopping := False;
  921.   LineMode := False;
  922.   PauseDisplay := False;
  923.   UpdateBuffer := nil;
  924.   MessageHandler := nil;
  925.   pChanged := False;
  926.   PaletteChanged := [];
  927.   fChanged := True;
  928.   Linethickness := 1;
  929.   LinePattern := $FFFFFFFF;
  930.   FillColor := 15;
  931.   FillBkColor := 0;
  932.   With fVP do
  933.     begin
  934.       x1 := 0; y1 := 0;
  935.       x2 := xsize-1; y2 := ysize-1;
  936.     end;
  937.   VPClip := True;
  938.   FastBlit := FastBlitSupported;
  939.   mtx_Update := tMutexSem.Create;
  940.   mtx_Rect := tMutexSem.Create;
  941.   mtx_Palette := tMutexSem.Create;
  942.   DosCreateEventSem( nil, TimerEvent, 0, False );
  943.   AllChanged;
  944.  
  945.   // Blitter thread
  946.   tidBlitThread := VPBeginThread ( BlitterThread, 4*16384, Self );
  947.   DosSetPriority ( prtys_Thread, prtyc_Regular, 10, tidBlitThread );
  948.  
  949.   // Palette thread
  950.   tidPaletteThread := VPBeginThread ( PaletteThread, 4*16384, Self );
  951.   DosSetPriority ( prtys_Thread, prtyc_IdleTime, 0, tidPaletteThread );
  952.  
  953.   // Timer thread
  954.   tidTimerThread := VPBeginThread ( TimerThread, 16384, Self );
  955.   DosSetPriority ( prtys_Thread, prtyc_TimeCritical, 0, tidTimerThread );
  956. end; // Create
  957.  
  958. procedure tDiveWindow.InitWindow( ResType, ResID: Longint );
  959. var
  960.   flCreate: Longint;
  961.   WinPosX : Longint;
  962.   WinPosY : Longint;
  963. begin
  964.   WinRegisterClass ( h_ab, pszMyWindow, MyWindowProc, 0, sizeof(ULONG) );
  965.  
  966.   flCreate := FCF_TASKLIST or FCF_SYSMENU or FCF_TITLEBAR or
  967.               FCF_SIZEBORDER or FCF_MINMAX or FCF_SCREENALIGN
  968.               or ResType;
  969.  
  970.   hwndFrame := WinCreateStdWindow ( HWND_DESKTOP,
  971.                                     WS_VISIBLE, flCreate,
  972.                                     pszMyWindow,
  973.                                     nil, // pszTitleText,
  974.                                     WS_SYNCPAINT or WS_VISIBLE,
  975.                                     0,
  976.                                     ResId,
  977.                                     @hwndClient);
  978.   if hwndFrame = 0 then
  979.     Raise EDive.Create( 'Failed to create frame window' );
  980.  
  981.   WinPosX := ScreenX div 2 - ( GetSnapWidth(fSizeX) div 2 );
  982.   WinPosY := ScreenY div 2 - ( GetSnapHeight(fSizeY) div 2 );
  983.  
  984.   WinSetWindowPos ( hwndFrame, HWND_TOP,
  985.                                WinPosX, WinPosY,
  986.                                GetSnapWidth( fSizeX ),
  987.                                GetSnapHeight( fSizeY ),
  988.                                SWP_MOVE or SWP_SIZE or SWP_ACTIVATE or SWP_SHOW );
  989. end; // InitWindow
  990.  
  991. function tDiveWindow.GetColours: Longint;
  992. begin
  993.   GetColours := 1 shl fColorBits;
  994. end;
  995.  
  996. destructor tDiveWindow.Destroy;
  997. begin
  998.   Stopping := True;
  999.   DosWaitThread ( tidBlitThread, DCWW_WAIT );
  1000.  
  1001.   WinSetVisibleRegionNotify ( hwndClient, FALSE );
  1002.  
  1003.   DiveFreeImageBuffer( hDive, fImage );
  1004.   DiveClose( hDive );
  1005.  
  1006.   WinDestroyWindow ( hwndFrame );
  1007.  
  1008.   FreeMem(pPalette,256*sizeof(ULONG));
  1009. end; // Destroy
  1010.  
  1011. procedure tDiveWindow.Run;
  1012. var
  1013.   q_msg : QMSG;
  1014. begin
  1015.   while WinGetMsg ( h_ab, q_msg, 0, 0, 0 ) do
  1016.     WinDispatchMsg ( h_ab, q_msg );
  1017. end;
  1018.  
  1019. // Transform native x,y to coordinates within ViewPort.
  1020. // Returns TRUE, if coordinates are displayable.
  1021. function tDiveWindow.VPTransformXY( var x, y: Integer ): Boolean;
  1022. begin
  1023.   with ViewPort do
  1024.     begin
  1025.       inc( x, x1 );
  1026.       inc( y, y1 );
  1027.       Result := ( ( x >= 0 ) and ( x < xSize ) and
  1028.                 ( y >= 0 ) and ( y < ySize ) ) and
  1029.  
  1030.                 ( not VPClip or
  1031.                   ( ( x >= x1 ) and ( x <= x2 ) and
  1032.                     ( y >= y1 ) and ( y <= y2 ) ) );
  1033.     end;
  1034. end;
  1035.  
  1036. // Transform native (x1,y) and (x2,y) to coordinates within ViewPort.
  1037. procedure tDiveWindow.VPTransformXXY( var xa, xb, y: Integer );
  1038. begin
  1039.   with ViewPort do
  1040.     begin
  1041.       inc( xa, x1 );
  1042.       inc( xb, x1 );
  1043.       inc( y, y1 );
  1044.     end;
  1045. end;
  1046.  
  1047. // Transform native (x1,y) and (x2,y) to coordinates within ViewPort.
  1048. procedure tDiveWindow.VPTransformXYXY( var xa, ya, xb, yb: Integer );
  1049. begin
  1050.   with ViewPort do
  1051.     begin
  1052.       inc( xa, x1 );
  1053.       inc( xb, x1 );
  1054.       inc( ya, y1 );
  1055.       inc( yb, y1 );
  1056.     end;
  1057. end;
  1058.  
  1059. // Return buffer address based on native coordinates
  1060. function tDiveWindow.VPBufAdr( x,y: Integer ): Integer;
  1061. begin
  1062.   With ViewPort do
  1063.     Result := x+x1+(y+y1)*xSize;
  1064. end;
  1065.  
  1066. // Takes x,y within VP
  1067. function tDiveWindow.GetPix(x,y: Longint): Longint;
  1068. begin
  1069.   if VPTransformXY( x, y ) then
  1070.     Result := DisplayBuffer^[ x+y*xSize ]
  1071.   else
  1072.     Result := -1;
  1073. end;
  1074.  
  1075. // Takes x,y within VP
  1076. procedure tDiveWindow.SetPix(x,y: Longint; Value: Longint);
  1077. var
  1078.   BufOfs: Integer;
  1079. begin
  1080.   If VPTransformXY( x, y ) then
  1081.     begin
  1082.       BufOfs := x+y*xSize;
  1083.       case LinePutMode of
  1084.         0: DisplayBuffer^[ BufOfs ] := Value;
  1085.         1: DisplayBuffer^[ BufOfs ] := DisplayBuffer^[ BufOfs ] xor Value;
  1086.         2: DisplayBuffer^[ BufOfs ] := DisplayBuffer^[ BufOfs ] or Value;
  1087.         3: DisplayBuffer^[ BufOfs ] := DisplayBuffer^[ BufOfs ] and Value;
  1088.         4: DisplayBuffer^[ BufOfs ] := not Value;
  1089.       end;
  1090.  
  1091.       PixelChanged( x, y );
  1092.     end;
  1093. end;
  1094.  
  1095. // Takes x,y in world coordinates
  1096. function tDiveWindow.GetWinPix(x,y: Longint): Longint;
  1097. begin
  1098.   Result := DisplayBuffer^[ x+y*xSize ];
  1099. end;
  1100.  
  1101. // Takes x,y in world coordinates
  1102. procedure tDiveWindow.SetWinPix(x,y, Value: Longint );
  1103. var
  1104.   Disp: ^Byte;
  1105. begin
  1106.   With ViewPort do
  1107.     if ( ( x >= 0 ) and ( x < xSize ) and
  1108.          ( y >= 0 ) and ( y < ySize ) ) and  // Within screen
  1109.        ( ( ( x >= x1 ) and ( x <= x2 ) and
  1110.            ( y >= y1 ) and ( y <= y2 ) ) or  // Within Clip
  1111.            not VPClip ) then                 // Not clipped
  1112.       begin
  1113.         Disp := Ptr( longint(DisplayBuffer) + x+y*xSize );
  1114.         if not odd(LinePattern shr (PatternInx mod 32)) then
  1115.           Value := 0;
  1116.         case LinePutMode of
  1117.           0: Disp^ := Value;
  1118.           1: Disp^ := Disp^ xor Value;
  1119.           2: Disp^ := Disp^ or Value;
  1120.           3: Disp^ := Disp^ and Value;
  1121.           4: Disp^ := Disp^ and not Value;
  1122.         end;
  1123.         inc( PatternInx );
  1124.       end;
  1125. end;
  1126.  
  1127. {$Frame-} {$Uses none}
  1128. procedure SwapLong( var a,b: Longint );
  1129. asm
  1130.   mov eax,a
  1131.   mov edx,b
  1132.   mov ecx,[eax]     // Value of a
  1133.   xchg ecx,[edx]    // Swap with value of b
  1134.   mov [eax],ecx
  1135. end;
  1136.  
  1137. {$Frame-} {$Uses none}
  1138. procedure SwapQW( var a,b );
  1139. asm
  1140.   mov eax,a
  1141.   mov edx,b
  1142.   mov ecx,[eax]     // Value of a
  1143.   xchg ecx,[edx]    // Swap with value of b
  1144.   mov [eax],ecx
  1145.  
  1146.   add eax,4         // High dwords
  1147.   add edx,4
  1148.   mov ecx,[eax]
  1149.   xchg ecx,[edx]
  1150.   mov [eax],ecx
  1151. end;
  1152.  
  1153. procedure Swap( var a,b; size: Longint );
  1154. var
  1155.   temp : array[1..100] of byte;  { Max size to swap }
  1156. begin
  1157.   move( a, temp, size );
  1158.   move( b, a, size );
  1159.   move( temp, a, size );
  1160. end;
  1161.  
  1162. type
  1163.  fix = record case boolean of            (* 32Bit Fixed-Point number *)
  1164.           true:(fix:longint);
  1165.           false:(f:SmallWord;i:SmallInt);
  1166.         end;
  1167.  
  1168. // Coordinates within viewport passed
  1169. procedure tDiveWindow.DrawFillLine( x1,x2,y: Integer );
  1170. const
  1171.   mask_3 : ARRAY [0..15] OF WORD= ($8000,$4000,$2000,$1000,$800,$400,$200,
  1172.                                    $100,$80,$40,$20,$10,$8,$4,$2,$1);
  1173. var
  1174.   i: integer;
  1175.   BufInx: Integer;
  1176.  
  1177. begin
  1178.   VPTransformXXY( x1, x2, y );
  1179.   if x1 > x2 then SwapLong( x1, x2 );
  1180.   if y < 0 then exit;
  1181.  
  1182.   If VPClip then
  1183.     begin
  1184.       // Clip to viewport
  1185.       x1 := max( x1, ViewPort.x1 );
  1186.       x2 := min( x2, VPXMax );
  1187.       if ( y > ViewPort.y2 ) or ( y < ViewPort.y1 ) then
  1188.         exit;
  1189.     end
  1190.   else
  1191.     begin
  1192.       x1 := max( 0, x1 );
  1193.       x2 := min( VPWidth, x2 );
  1194.       if y > ySize then
  1195.         exit;
  1196.     end;
  1197.  
  1198.   BufInx := x1+y*xSize;
  1199.   for i := x1 to x2 do
  1200.     begin
  1201.       if ( FillPattern[y AND 15] and mask_3[i and 15] )<> 0 then
  1202.         DisplayBuffer^[BufInx] := FillColor
  1203.       else
  1204.         DisplayBuffer^[BufInx] := FillBkColor;
  1205.       Inc( BufInx );
  1206.     end;
  1207. end;
  1208.  
  1209. function tDiveWindow.FillPatternColor( x, y: Integer ): Integer;
  1210. const
  1211.   mask_3 : ARRAY [0..15] OF WORD= ($8000,$4000,$2000,$1000,$800,$400,$200,
  1212.                                    $100,$80,$40,$20,$10,$8,$4,$2,$1);
  1213. var
  1214.   Dummy: Integer;
  1215.  
  1216. begin
  1217.   VPTransformXXY( x, Dummy, y );
  1218.   if y < 0 then exit;
  1219.  
  1220.   If VPClip then
  1221.     begin
  1222.       // Clip to viewport
  1223.       x := max( x, ViewPort.x1 );
  1224.       if ( y > ViewPort.y2 ) or ( y < ViewPort.y1 ) then
  1225.         exit;
  1226.     end
  1227.   else
  1228.     begin
  1229.       x := max( 0, x );
  1230.       if y > ySize then
  1231.         exit;
  1232.     end;
  1233.  
  1234.   if ( FillPattern[y AND 15] and mask_3[x and 15] ) <> 0 then
  1235.     Result := FillColor
  1236.   else
  1237.     Result := FillBkColor;
  1238. end;
  1239.  
  1240. // Optimised horizontal line routine for xxxPut modes
  1241. procedure tDiveWindow.FillLine( x1,x2,y,c: Longint );
  1242. var
  1243.   Disp: ^Byte;
  1244.   i: Integer;
  1245.   col: Integer;
  1246.  
  1247. begin
  1248.   Disp := Ptr( Longint(DisplayBuffer) + x1+y*xSize );
  1249.  
  1250.   case LinePutMode of
  1251.     10: // NormalPut
  1252.       for i := x1 to x2 do
  1253.         begin
  1254.           if odd(LinePattern shr ((i+y) mod 32)) then
  1255.             col := c
  1256.           else
  1257.             col := 0;
  1258.           Disp^ := col;
  1259.           Inc( Disp );
  1260.         end;
  1261.     1 : // XorPut
  1262.       for i := x1 to x2 do
  1263.         begin
  1264.           if odd(LinePattern shr ((i+y) mod 32)) then
  1265.             col := c
  1266.           else
  1267.             col := 0;
  1268.           Disp^ := Disp^ xor col;
  1269.           Inc( Disp );
  1270.         end;
  1271.     2 : // OrPut
  1272.       for i := x1 to x2 do
  1273.         begin
  1274.           if odd(LinePattern shr ((i+y) mod 32)) then
  1275.             col := c
  1276.           else
  1277.             col := 0;
  1278.           Disp^ := Disp^ or col;
  1279.           Inc( Disp );
  1280.         end;
  1281.     3 : // AndPut
  1282.       for i := x1 to x2 do
  1283.         begin
  1284.           if odd(LinePattern shr ((i+y) mod 32)) then
  1285.             col := c
  1286.           else
  1287.             col := 0;
  1288.           Disp^ := Disp^ and col;
  1289.           Inc( Disp );
  1290.         end;
  1291.     4 : // NotPut
  1292.       for i := x1 to x2 do
  1293.         begin
  1294.           if odd(LinePattern shr ((i+y) mod 32)) then
  1295.             col := c
  1296.           else
  1297.             col := 0;
  1298.           Disp^ := Disp^ and not col;
  1299.           Inc( Disp );
  1300.         end;
  1301.   end;
  1302. end;
  1303.  
  1304. // Coordinates within viewport passed
  1305. procedure tDiveWindow.DrawLine( x1,y1, x2,y2, c: Longint );
  1306. var
  1307.   dyDdx,dxDdy,sy,sx:fix;
  1308.   dy,dx,h: integer;
  1309.   s: String;
  1310.   i, it: integer;
  1311.   x,y: Integer;
  1312.   ltd2 : Integer;
  1313.   xa,ya: Integer;
  1314.  
  1315.   procedure ThickLineX( x,y: Integer);
  1316.   begin
  1317.     if LineThickness = 3 then
  1318.       begin
  1319.         Dec( PatternInx );
  1320.         SetWinPix( pred(x), y, c );
  1321.         Dec( PatternInx );
  1322.         SetWinPix( succ(x), y, c );
  1323.       end;
  1324.   end;
  1325.  
  1326.   procedure ThickLineY( x,y: Integer );
  1327.   begin
  1328.     if LineThickness = 3 then
  1329.       begin
  1330.         Dec( PatternInx );
  1331.         SetWinPix( x, pred(y), c );
  1332.         Dec( PatternInx );
  1333.         SetWinPix( x, succ(y), c );
  1334.       end;
  1335.   end;
  1336.  
  1337. begin
  1338.   dY := Abs( y2-y1 );
  1339.   dX := Abs( x2-x1 );
  1340.  
  1341.   // Transform to global coordinates
  1342.   VPTransformXYXY( x1, y1, x2, y2 );
  1343.   ltd2 := Linethickness div 2;
  1344.  
  1345.   if dY = 0 then
  1346.     begin  // Horizontal line
  1347.       if x2 < x1 then
  1348.         SwapLong( x1, x2 );
  1349.       If VPClip then
  1350.         begin
  1351.           // Clip to viewport
  1352.           x1 := max( x1, ViewPort.x1 );
  1353.           x2 := min( x2, VPXMax );
  1354.           if y2-ltd2 > ViewPort.y2 then
  1355.             exit;
  1356.           if y1+ltd2 < 0 then
  1357.             exit;
  1358.           y1 := max( ViewPort.y1, min( y1+ltd2, ViewPort.y2-ltd2 ) );
  1359.         end
  1360.       else
  1361.         begin
  1362.           x1 := max( 0, x1 );
  1363.           x2 := min( xSize-1, x2 );
  1364.           if y2-ltd2 > ysize-1 then
  1365.             exit;
  1366.           if y1+ltd2 < 0 then
  1367.             exit;
  1368.           y1 := min( y1+ltd2, ySize-1-ltd2 );
  1369.         end;
  1370.       x1 := min( x1, x2 );
  1371.  
  1372.       for it := -ltd2 to ltd2 do
  1373.         if ( LinePutMode = 0 ) and ( LinePattern = $FFFFFFFF ) then
  1374.           Fillchar( DisplayBuffer^[(y1+it)*xSize+x1], x2-x1+1, c)
  1375.         else
  1376.           // Apply linestyle and put-mode (xor, or, etc) on line
  1377.           FillLine( x1, x2, y1+it, c );
  1378.     end
  1379.   else
  1380.     begin
  1381.       if dX > dY then
  1382.         begin
  1383.           if x2 < x1 then
  1384.             begin
  1385.               SwapLong( x1, x2 );
  1386.               SwapLong( y1, y2 );
  1387.             end;
  1388.  
  1389.           SetWinPix( x1, y1, c );
  1390.           ThickLineY( x1, y1 );
  1391.           if dX <> 0 then
  1392.             begin
  1393.               sy.i := y1;
  1394.               sy.f := $8000;
  1395.               dyDdx.i := y2-y1;
  1396.               dyDdx.f := 0;
  1397.               dyDdx.fix := dyDdx.fix div dX;
  1398.               x := x1;
  1399.               while x < x2-1 do
  1400.                 begin
  1401.                   inc( x );
  1402.                   inc( sy.fix, dyDdx.fix );
  1403.                   SetWinPix( x, sy.i, c );
  1404.                   ThickLineY( x, sy.i );
  1405.                  end;
  1406.             end;
  1407.           SetWinPix( x2, y2, c );
  1408.           ThickLineY( x2, y2 );
  1409.         end // dX > dY
  1410.       else
  1411.         begin
  1412.           if y2 < y1 then
  1413.             begin
  1414.               SwapLong( x1, x2 );
  1415.               SwapLong( y1, y2 );
  1416.             end;
  1417.           SetWinPix( x1, y1, c );
  1418.           ThickLineX( x1, y1 );
  1419.           if dY <> 0 then
  1420.             begin
  1421.               sx.i:= x1;
  1422.               sx.f:= $8000;
  1423.               dxDdy.i := x2-x1;
  1424.               dxDdy.f := 0;
  1425.               dxDdy.fix := dxDdy.fix div dY;
  1426.               y := y1;
  1427.               while y < y2-1 do
  1428.                 begin
  1429.                   Inc( y );
  1430.                   Inc( sx.fix, dxDdy.fix );
  1431.                   SetWinPix( sx.i, y, c );
  1432.                   ThickLineX( sx.i, y );
  1433.                 end;
  1434.             end;
  1435.           SetWinPix( x2, y2, c );
  1436.           ThickLineX( x2, y2 );
  1437.         end; // dY > dX
  1438.     end; // dY <> 0
  1439.   RectChanged( x1-ltd2,y1-ltd2, x2+ltd2,y2+ltd2 );
  1440. end; // DrawLine
  1441.  
  1442. procedure tDiveWindow.DrawFillRect( x1,y1, x2,y2, c: Longint );
  1443. var
  1444.   y: Integer;
  1445. begin
  1446.   if (x1 > x2) then SwapLong( x1, x2 );
  1447.   if (y1 > y2) then SwapLong( y1, y2 );
  1448.   for y := y1 to y2 do
  1449.     DrawFillLine( x1, x2, y );
  1450.  
  1451.   DrawBox( x1,y1, x2,y2, c );
  1452. end;
  1453.  
  1454. procedure tDiveWindow.DrawBox( x1,y1, x2,y2, c: Longint );
  1455. var
  1456.   p1, p2, p3, p4 : Pixel;
  1457. begin
  1458.   p1.x := x1; p1.y := y1;
  1459.   p2.x := x2; p2.y := y2;
  1460.   p3.x := x1; p3.y := y2;
  1461.   p4.x := x2; p4.y := y1;
  1462.   DrawQuad( p1, p2, p3, p4, c );
  1463. end; // Drawbox
  1464.  
  1465. procedure tDiveWindow.DrawTriangle(p1,p2,p3:pixel;c:integer);
  1466.  
  1467. var x21,x31,x32,
  1468.     y21,y31,y32:integer;
  1469.     ex,
  1470.     e1x,
  1471.     edx,
  1472.     e1dx:fix;
  1473.     N: longint;
  1474.  
  1475. begin
  1476.   if LineMode then
  1477.     begin
  1478.       DrawLine( p1.x, p1.y, p2.x, p2.y, c); // Only edges
  1479.       DrawLine( p2.x, p2.y, p3.x, p3.y, c);
  1480.       DrawLine( p3.x, p3.y, p1.x, p1.y, c);
  1481.     end
  1482.   else
  1483.     begin
  1484.       // Make sure p1y <= p2y <= p3y
  1485.       if p1.y > p2.y then SwapQW( p1, p2 );
  1486.       if p1.y > p3.y then SwapQW( p1, p3 );
  1487.       if p2.y > p3.y then SwapQW( p2, p3 );
  1488.  
  1489.       y31 := p3.y - p1.y;                         // Length of longest edge
  1490.       if y31 <> 0 then
  1491.         begin                                     // No horizontal line?
  1492.           y21 := p2.y - p1.y;                     // Short edges
  1493.           x21 := p2.x - p1.x;
  1494.           x31 := p3.x - p1.x;
  1495.           N := y21*x31 - y31*x21;
  1496.           SetPix( p1.x, p1.y, c );                // Uppermost pixel
  1497.           Inc( p1.y );
  1498.           ex.i := p1.x; ex.f := $8000;            // Start value for x
  1499.           edx.i := x31; edx.f := 0;
  1500.           edx.fix := edx.fix div y31;
  1501.           if y21 <> 0 then
  1502.             begin                                 // p1-p2 not horizontal
  1503.               e1x.fix := ex.fix;
  1504.               e1dx.i := x21; e1dx.f := 0;
  1505.               e1dx.fix := e1dx.fix div y21;
  1506.               while p1.y < p2.y do
  1507.                 begin                             // All lines between p1y and p2y
  1508.                   Inc( ex.fix,edx.fix);
  1509.                   Inc( e1x.fix,e1dx.fix);
  1510.                   DrawLine( ex.i, p1.y, e1x.i, p1.y, c);
  1511.                   Inc( p1.y );
  1512.                 end;
  1513.               Inc( ex.fix, edx.fix );
  1514.             end; // y21 <> 0
  1515.  
  1516.           p1.y := p2.y;
  1517.  
  1518.           SetPix( ex.i, p1.y, c );
  1519.           SetPix( p2.x, p2.y, c );
  1520.  
  1521.           DrawLine( ex.i, p1.y, p2.x, p1.y, c );
  1522.           Inc( p1.y );
  1523.  
  1524.           y32 := p3.y - p2.y;
  1525.           if y32 <> 0 then
  1526.             begin
  1527.               x32 := p3.x - p2.x;
  1528.               e1x.i := p2.x; e1x.f := $8000;
  1529.               e1dx.i := x32; e1dx.f := 0;
  1530.               e1dx.fix := e1dx.fix div y32;
  1531.               while p1.y < p3.y do
  1532.                 begin
  1533.                   Inc( ex.fix, edx.fix );
  1534.                   Inc( e1x.fix, e1dx.fix );
  1535.                   DrawLine( ex.i, p1.y, e1x.i, p1.y, c );
  1536.                   Inc(p1.y);
  1537.                 end;
  1538.             end; // y32 <> 0
  1539.           SetPix( p3.x, p3.y, c );
  1540.  
  1541.         end // y31 <> 0
  1542.       else
  1543.         DrawLine( p1.x, p1.y, p3.x, p3.y, c );
  1544.     end; // Not linemode
  1545. end; // DrawTriangle
  1546.  
  1547. procedure tDiveWindow.DrawQuad( p1,p2,p3,p4: Pixel; c: Longint );
  1548. var
  1549.   l1,l2,l1dx,l2dx:fix;
  1550.   under1,under2:boolean;
  1551.  
  1552.   Procedure AssignLine(var p1,p2:pixel;var l,ldx:fix);
  1553.   var
  1554.     dX,dY: Integer;
  1555.   begin
  1556.     dX := p2.x-p1.x;
  1557.     dY := p2.y-p1.y;
  1558.     l.i := p1.x;
  1559.     l.f := $8000;
  1560.     ldx.i := dX;
  1561.     ldx.f := 0;
  1562.     ldx.fix := ldx.fix div dY;
  1563.   end;
  1564.  
  1565.   Procedure FillBetweenLines(y,ymax:integer);
  1566.   begin
  1567.     while y<=ymax do
  1568.       begin
  1569.         inc( l1.fix, l1dx.fix );
  1570.         inc( l2.fix, l2dx.fix );
  1571.         DrawLine( l1.i,y, l2.i,y, c );
  1572.         Inc( y );
  1573.       end;
  1574.   end;
  1575.  
  1576. begin
  1577.   // Make sure that p1y<=p2y<=p3y<=p4y
  1578.   if p1.y > p2.y then SwapQW( p1, p2 );
  1579.   if p1.y > p3.y then SwapQW( p1, p3 );
  1580.   if p1.y > p4.y then SwapQW( p1, p4 );
  1581.   if p2.y > p3.y then SwapQW( p2, p3 );
  1582.   if p2.y > p4.y then SwapQW( p2, p4 );
  1583.   if p3.y > p4.y then SwapQW( p3, p4 );
  1584.  
  1585.   if p4.y <> p1.y then
  1586.     begin
  1587.       if p3.y <> p1.y then
  1588.         begin
  1589.           if p1.x = p3.x then
  1590.             begin
  1591.               under1 := p2.x < p1.x;
  1592.               under2 := p4.x < p1.x;
  1593.             end
  1594.           else
  1595.             begin
  1596.               under1:=p3.y-p2.y<(longint(p3.x-p2.x)*(p3.y-p1.y)) div (p3.x-p1.x);
  1597.               under2:=p3.y-p4.y<(longint(p3.x-p4.x)*(p3.y-p1.y)) div (p3.x-p1.x);
  1598.             end;
  1599.  
  1600.           SetPix( p1.x, p1.y, c );
  1601.           if under1 xor under2 then
  1602.             begin
  1603.               if LineMode then
  1604.                 begin
  1605.                   DrawLine( p1.x, p1.y, p2.x, p2.y, c );
  1606.                   DrawLine( p2.x, p2.y, p3.x, p3.y, c );
  1607.                   DrawLine( p3.x, p3.y, p4.x, p4.y, c );
  1608.                   DrawLine( p4.x, p4.y, p1.x, p1.y, c );
  1609.                 end
  1610.               else
  1611.                 begin
  1612.                   AssignLine( p1, p4, l1, l1dx );
  1613.                   if p1.y = p2.y then
  1614.                     DrawLine( p1.x, p1.y, p2.x, p1.y, c)
  1615.                   else
  1616.                     begin
  1617.                       AssignLine( p1, p2, l2, l2dx );
  1618.                       FillBetweenLines( p1.y+1, p2.y );
  1619.                     end;
  1620.                   if p2.y <> p3.y then
  1621.                     begin
  1622.                       AssignLine( p2, p3, l2, l2dx );
  1623.                       FillBetweenLines( p2.y+1, p3.y );
  1624.                     end;
  1625.                   if p3.y <> p4.y then
  1626.                     begin
  1627.                       AssignLine( p3, p4, l2, l2dx );
  1628.                       FillBetweenLines( p3.y+1, p4.y );
  1629.                     end;
  1630.                 end;
  1631.             end
  1632.           else
  1633.             begin
  1634.               if LineMode then
  1635.                 begin
  1636.                   DrawLine( p1.x, p1.y, p2.x, p2.y, c );
  1637.                   DrawLine( p2.x, p2.y, p4.x, p4.y, c );
  1638.                   DrawLine( p4.x, p4.y, p3.x, p3.y, c );
  1639.                   DrawLine( p3.x, p3.y, p1.x, p1.y, c );
  1640.                 end
  1641.               else
  1642.                 begin
  1643.                   AssignLine(p1,p3,l1,l1dx);
  1644.                   if p1.y = p2.y then
  1645.                     DrawLine( p1.x, p1.y, p2.x, p1.y, c)
  1646.                   else
  1647.                     begin
  1648.                       AssignLine( p1, p2, l2, l2dx );
  1649.                       FillBetweenLines( p1.y+1, p2.y );
  1650.                     end;
  1651.                   if p2.y <> p4.y then
  1652.                     begin
  1653.                       AssignLine( p2, p4, l2, l2dx );
  1654.                       if p2.y <> p3.y then
  1655.                         FillBetweenLines( p2.y+1, p3.y );
  1656.                       if p3.y <> p4.y then
  1657.                         begin
  1658.                           AssignLine( p3, p4, l1, l1dx );
  1659.                           FillBetweenLines( p3.y+1, p4.y );
  1660.                         end;
  1661.                     end;
  1662.                 end;
  1663.             end;
  1664.         end
  1665.       else
  1666.         begin
  1667.           DrawLine( p1.x, p1.y, p2.x, p1.y, c );
  1668.           DrawLine( p1.x, p1.y, p3.x, p1.y, c );
  1669.           AssignLine( p2, p4, l1, l1dx );
  1670.           AssignLine( p3, p4, l2, l2dx );
  1671.           FillBetweenLines( p3.y+1, p4.y );
  1672.         end;
  1673.     end
  1674.   else
  1675.     begin
  1676.       DrawLine(p1.x, p1.y, p2.x, p1.y, c);
  1677.       DrawLine(p1.x, p1.y, p3.x, p1.y, c);
  1678.       DrawLine(p1.x, p1.y, p4.x, p1.y, c);
  1679.     end;
  1680. end;  // DrawQuad
  1681.  
  1682. const
  1683.   Font8x8:array[0..$7FF] of byte = (
  1684.       $00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$7E ,$81 ,$A5 ,$81 ,$BD ,$99 ,$81 ,$7E
  1685.      ,$7E ,$FF ,$DB ,$FF ,$C3 ,$E7 ,$FF ,$7E ,$6C ,$FE ,$FE ,$FE ,$7C ,$38 ,$10 ,$00
  1686.      ,$10 ,$38 ,$7C ,$FE ,$7C ,$38 ,$10 ,$00 ,$38 ,$7C ,$38 ,$FE ,$FE ,$7C ,$38 ,$7C
  1687.      ,$10 ,$10 ,$38 ,$7C ,$FE ,$7C ,$38 ,$7C ,$00 ,$00 ,$18 ,$3C ,$3C ,$18 ,$00 ,$00
  1688.      ,$FF ,$FF ,$E7 ,$C3 ,$C3 ,$E7 ,$FF ,$FF ,$00 ,$3C ,$66 ,$42 ,$42 ,$66 ,$3C ,$00
  1689.      ,$FF ,$C3 ,$99 ,$BD ,$BD ,$99 ,$C3 ,$FF ,$0F ,$07 ,$0F ,$7D ,$CC ,$CC ,$CC ,$78
  1690.      ,$3C ,$66 ,$66 ,$66 ,$3C ,$18 ,$7E ,$18 ,$3F ,$33 ,$3F ,$30 ,$30 ,$70 ,$F0 ,$E0
  1691.      ,$7F ,$63 ,$7F ,$63 ,$63 ,$67 ,$E6 ,$C0 ,$99 ,$5A ,$3C ,$E7 ,$E7 ,$3C ,$5A ,$99
  1692.      ,$80 ,$E0 ,$F8 ,$FE ,$F8 ,$E0 ,$80 ,$00 ,$02 ,$0E ,$3E ,$FE ,$3E ,$0E ,$02 ,$00
  1693.      ,$18 ,$3C ,$7E ,$18 ,$18 ,$7E ,$3C ,$18 ,$66 ,$66 ,$66 ,$66 ,$66 ,$00 ,$66 ,$00
  1694.      ,$7F ,$DB ,$DB ,$7B ,$1B ,$1B ,$1B ,$00 ,$3E ,$63 ,$38 ,$6C ,$6C ,$38 ,$CC ,$78
  1695.      ,$00 ,$00 ,$00 ,$00 ,$7E ,$7E ,$7E ,$00 ,$18 ,$3C ,$7E ,$18 ,$7E ,$3C ,$18 ,$FF
  1696.      ,$18 ,$3C ,$7E ,$18 ,$18 ,$18 ,$18 ,$00 ,$18 ,$18 ,$18 ,$18 ,$7E ,$3C ,$18 ,$00
  1697.      ,$00 ,$18 ,$0C ,$FE ,$0C ,$18 ,$00 ,$00 ,$00 ,$30 ,$60 ,$FE ,$60 ,$30 ,$00 ,$00
  1698.      ,$00 ,$00 ,$C0 ,$C0 ,$C0 ,$FE ,$00 ,$00 ,$00 ,$24 ,$66 ,$FF ,$66 ,$24 ,$00 ,$00
  1699.      ,$00 ,$18 ,$3C ,$7E ,$FF ,$FF ,$00 ,$00 ,$00 ,$FF ,$FF ,$7E ,$3C ,$18 ,$00 ,$00
  1700.      ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$30 ,$78 ,$78 ,$78 ,$30 ,$00 ,$30 ,$00
  1701.      ,$6C ,$6C ,$6C ,$00 ,$00 ,$00 ,$00 ,$00 ,$6C ,$6C ,$FE ,$6C ,$FE ,$6C ,$6C ,$00
  1702.      ,$30 ,$7C ,$C0 ,$78 ,$0C ,$F8 ,$30 ,$00 ,$00 ,$C6 ,$CC ,$18 ,$30 ,$66 ,$C6 ,$00
  1703.      ,$38 ,$6C ,$38 ,$76 ,$DC ,$CC ,$76 ,$00 ,$60 ,$60 ,$C0 ,$00 ,$00 ,$00 ,$00 ,$00
  1704.      ,$18 ,$30 ,$60 ,$60 ,$60 ,$30 ,$18 ,$00 ,$60 ,$30 ,$18 ,$18 ,$18 ,$30 ,$60 ,$00
  1705.      ,$00 ,$66 ,$3C ,$FF ,$3C ,$66 ,$00 ,$00 ,$00 ,$30 ,$30 ,$FC ,$30 ,$30 ,$00 ,$00
  1706.      ,$00 ,$00 ,$00 ,$00 ,$00 ,$30 ,$30 ,$60 ,$00 ,$00 ,$00 ,$FC ,$00 ,$00 ,$00 ,$00
  1707.      ,$00 ,$00 ,$00 ,$00 ,$00 ,$30 ,$30 ,$00 ,$06 ,$0C ,$18 ,$30 ,$60 ,$C0 ,$80 ,$00
  1708.      ,$7C ,$C6 ,$CE ,$DE ,$F6 ,$E6 ,$7C ,$00 ,$30 ,$70 ,$30 ,$30 ,$30 ,$30 ,$FC ,$00
  1709.      ,$78 ,$CC ,$0C ,$38 ,$60 ,$CC ,$FC ,$00 ,$78 ,$CC ,$0C ,$38 ,$0C ,$CC ,$78 ,$00
  1710.      ,$1C ,$3C ,$6C ,$CC ,$FE ,$0C ,$1E ,$00 ,$FC ,$C0 ,$F8 ,$0C ,$0C ,$CC ,$78 ,$00
  1711.      ,$38 ,$60 ,$C0 ,$F8 ,$CC ,$CC ,$78 ,$00 ,$FC ,$CC ,$0C ,$18 ,$30 ,$30 ,$30 ,$00
  1712.      ,$78 ,$CC ,$CC ,$78 ,$CC ,$CC ,$78 ,$00 ,$78 ,$CC ,$CC ,$7C ,$0C ,$18 ,$70 ,$00
  1713.      ,$00 ,$30 ,$30 ,$00 ,$00 ,$30 ,$30 ,$00 ,$00 ,$30 ,$30 ,$00 ,$00 ,$30 ,$30 ,$60
  1714.      ,$18 ,$30 ,$60 ,$C0 ,$60 ,$30 ,$18 ,$00 ,$00 ,$00 ,$FC ,$00 ,$00 ,$FC ,$00 ,$00
  1715.      ,$60 ,$30 ,$18 ,$0C ,$18 ,$30 ,$60 ,$00 ,$78 ,$CC ,$0C ,$18 ,$30 ,$00 ,$30 ,$00
  1716.      ,$7C ,$C6 ,$DE ,$DE ,$DE ,$C0 ,$78 ,$00 ,$30 ,$78 ,$CC ,$CC ,$FC ,$CC ,$CC ,$00
  1717.      ,$FC ,$66 ,$66 ,$7C ,$66 ,$66 ,$FC ,$00 ,$3C ,$66 ,$C0 ,$C0 ,$C0 ,$66 ,$3C ,$00
  1718.      ,$F8 ,$6C ,$66 ,$66 ,$66 ,$6C ,$F8 ,$00 ,$7E ,$60 ,$60 ,$78 ,$60 ,$60 ,$7E ,$00
  1719.      ,$7E ,$60 ,$60 ,$78 ,$60 ,$60 ,$60 ,$00 ,$3C ,$66 ,$C0 ,$C0 ,$CE ,$66 ,$3E ,$00
  1720.      ,$CC ,$CC ,$CC ,$FC ,$CC ,$CC ,$CC ,$00 ,$78 ,$30 ,$30 ,$30 ,$30 ,$30 ,$78 ,$00
  1721.      ,$1E ,$0C ,$0C ,$0C ,$CC ,$CC ,$78 ,$00 ,$E6 ,$66 ,$6C ,$78 ,$6C ,$66 ,$E6 ,$00
  1722.      ,$60 ,$60 ,$60 ,$60 ,$60 ,$60 ,$7E ,$00 ,$C6 ,$EE ,$FE ,$FE ,$D6 ,$C6 ,$C6 ,$00
  1723.      ,$C6 ,$E6 ,$F6 ,$DE ,$CE ,$C6 ,$C6 ,$00 ,$38 ,$6C ,$C6 ,$C6 ,$C6 ,$6C ,$38 ,$00
  1724.      ,$FC ,$66 ,$66 ,$7C ,$60 ,$60 ,$F0 ,$00 ,$78 ,$CC ,$CC ,$CC ,$DC ,$78 ,$1C ,$00
  1725.      ,$FC ,$66 ,$66 ,$7C ,$6C ,$66 ,$E6 ,$00 ,$78 ,$CC ,$E0 ,$70 ,$1C ,$CC ,$78 ,$00
  1726.      ,$FC ,$30 ,$30 ,$30 ,$30 ,$30 ,$30 ,$00 ,$CC ,$CC ,$CC ,$CC ,$CC ,$CC ,$FC ,$00
  1727.      ,$CC ,$CC ,$CC ,$CC ,$CC ,$78 ,$30 ,$00 ,$C6 ,$C6 ,$C6 ,$D6 ,$FE ,$EE ,$C6 ,$00
  1728.      ,$C6 ,$C6 ,$6C ,$38 ,$38 ,$6C ,$C6 ,$00 ,$CC ,$CC ,$CC ,$78 ,$30 ,$30 ,$78 ,$00
  1729.      ,$FE ,$06 ,$0C ,$18 ,$30 ,$60 ,$FE ,$00 ,$78 ,$60 ,$60 ,$60 ,$60 ,$60 ,$78 ,$00
  1730.      ,$C0 ,$60 ,$30 ,$18 ,$0C ,$06 ,$02 ,$00 ,$78 ,$18 ,$18 ,$18 ,$18 ,$18 ,$78 ,$00
  1731.      ,$10 ,$38 ,$6C ,$C6 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$FF
  1732.      ,$30 ,$30 ,$18 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$78 ,$0C ,$7C ,$CC ,$76 ,$00
  1733.      ,$E0 ,$60 ,$60 ,$7C ,$66 ,$66 ,$DC ,$00 ,$00 ,$00 ,$78 ,$CC ,$C0 ,$CC ,$78 ,$00
  1734.      ,$1C ,$0C ,$0C ,$7C ,$CC ,$CC ,$76 ,$00 ,$00 ,$00 ,$78 ,$CC ,$FC ,$C0 ,$78 ,$00
  1735.      ,$38 ,$6C ,$60 ,$F0 ,$60 ,$60 ,$F0 ,$00 ,$00 ,$00 ,$76 ,$CC ,$CC ,$7C ,$0C ,$F8
  1736.      ,$E0 ,$60 ,$6C ,$76 ,$66 ,$66 ,$E6 ,$00 ,$30 ,$00 ,$70 ,$30 ,$30 ,$30 ,$78 ,$00
  1737.      ,$0C ,$00 ,$0C ,$0C ,$0C ,$CC ,$CC ,$78 ,$E0 ,$60 ,$66 ,$6C ,$78 ,$6C ,$E6 ,$00
  1738.      ,$70 ,$30 ,$30 ,$30 ,$30 ,$30 ,$78 ,$00 ,$00 ,$00 ,$CC ,$FE ,$FE ,$D6 ,$C6 ,$00
  1739.      ,$00 ,$00 ,$F8 ,$CC ,$CC ,$CC ,$CC ,$00 ,$00 ,$00 ,$78 ,$CC ,$CC ,$CC ,$78 ,$00
  1740.      ,$00 ,$00 ,$DC ,$66 ,$66 ,$7C ,$60 ,$F0 ,$00 ,$00 ,$76 ,$CC ,$CC ,$7C ,$0C ,$1E
  1741.      ,$00 ,$00 ,$DC ,$76 ,$66 ,$60 ,$F0 ,$00 ,$00 ,$00 ,$7C ,$C0 ,$78 ,$0C ,$F8 ,$00
  1742.      ,$10 ,$30 ,$7C ,$30 ,$30 ,$34 ,$18 ,$00 ,$00 ,$00 ,$CC ,$CC ,$CC ,$CC ,$76 ,$00
  1743.      ,$00 ,$00 ,$CC ,$CC ,$CC ,$78 ,$30 ,$00 ,$00 ,$00 ,$C6 ,$D6 ,$FE ,$FE ,$6C ,$00
  1744.      ,$00 ,$00 ,$C6 ,$6C ,$38 ,$6C ,$C6 ,$00 ,$00 ,$00 ,$CC ,$CC ,$CC ,$7C ,$0C ,$F8
  1745.      ,$00 ,$00 ,$FC ,$98 ,$30 ,$64 ,$FC ,$00 ,$1C ,$30 ,$30 ,$E0 ,$30 ,$30 ,$1C ,$00
  1746.      ,$18 ,$18 ,$18 ,$00 ,$18 ,$18 ,$18 ,$00 ,$E0 ,$30 ,$30 ,$1C ,$30 ,$30 ,$E0 ,$00
  1747.      ,$76 ,$DC ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$10 ,$38 ,$6C ,$C6 ,$C6 ,$FE ,$00
  1748.      ,$78 ,$CC ,$C0 ,$CC ,$78 ,$18 ,$0C ,$78 ,$00 ,$CC ,$00 ,$CC ,$CC ,$CC ,$7E ,$00
  1749.      ,$1C ,$00 ,$78 ,$CC ,$FC ,$C0 ,$78 ,$00 ,$7E ,$C3 ,$3C ,$06 ,$3E ,$66 ,$3F ,$00
  1750.      ,$CC ,$00 ,$78 ,$0C ,$7C ,$CC ,$7E ,$00 ,$E0 ,$00 ,$78 ,$0C ,$7C ,$CC ,$7E ,$00
  1751.      ,$30 ,$30 ,$78 ,$0C ,$7C ,$CC ,$7E ,$00 ,$00 ,$00 ,$78 ,$C0 ,$C0 ,$78 ,$0C ,$38
  1752.      ,$7E ,$C3 ,$3C ,$66 ,$7E ,$60 ,$3C ,$00 ,$CC ,$00 ,$78 ,$CC ,$FC ,$C0 ,$78 ,$00
  1753.      ,$E0 ,$00 ,$78 ,$CC ,$FC ,$C0 ,$78 ,$00 ,$CC ,$00 ,$70 ,$30 ,$30 ,$30 ,$78 ,$00
  1754.      ,$7C ,$C6 ,$38 ,$18 ,$18 ,$18 ,$3C ,$00 ,$E0 ,$00 ,$70 ,$30 ,$30 ,$30 ,$78 ,$00
  1755.      ,$C6 ,$38 ,$6C ,$C6 ,$FE ,$C6 ,$C6 ,$00 ,$30 ,$30 ,$00 ,$78 ,$CC ,$FC ,$CC ,$00
  1756.      ,$1C ,$00 ,$FC ,$60 ,$78 ,$60 ,$FC ,$00 ,$00 ,$00 ,$7F ,$0C ,$7F ,$CC ,$7F ,$00
  1757.      ,$3E ,$6C ,$CC ,$FE ,$CC ,$CC ,$CE ,$00 ,$78 ,$CC ,$00 ,$78 ,$CC ,$CC ,$78 ,$00
  1758.      ,$00 ,$CC ,$00 ,$78 ,$CC ,$CC ,$78 ,$00 ,$00 ,$E0 ,$00 ,$78 ,$CC ,$CC ,$78 ,$00
  1759.      ,$78 ,$CC ,$00 ,$CC ,$CC ,$CC ,$7E ,$00 ,$00 ,$E0 ,$00 ,$CC ,$CC ,$CC ,$7E ,$00
  1760.      ,$00 ,$CC ,$00 ,$CC ,$CC ,$7C ,$0C ,$F8 ,$C3 ,$18 ,$3C ,$66 ,$66 ,$3C ,$18 ,$00
  1761.      ,$CC ,$00 ,$CC ,$CC ,$CC ,$CC ,$78 ,$00 ,$18 ,$18 ,$7E ,$C0 ,$C0 ,$7E ,$18 ,$18
  1762.      ,$38 ,$6C ,$64 ,$F0 ,$60 ,$E6 ,$FC ,$00 ,$CC ,$CC ,$78 ,$FC ,$30 ,$FC ,$30 ,$30
  1763.      ,$F8 ,$CC ,$CC ,$FA ,$C6 ,$CF ,$C6 ,$C7 ,$0E ,$1B ,$18 ,$3C ,$18 ,$18 ,$D8 ,$70
  1764.      ,$1C ,$00 ,$78 ,$0C ,$7C ,$CC ,$7E ,$00 ,$38 ,$00 ,$70 ,$30 ,$30 ,$30 ,$78 ,$00
  1765.      ,$00 ,$1C ,$00 ,$78 ,$CC ,$CC ,$78 ,$00 ,$00 ,$1C ,$00 ,$CC ,$CC ,$CC ,$7E ,$00
  1766.      ,$00 ,$F8 ,$00 ,$F8 ,$CC ,$CC ,$CC ,$00 ,$FC ,$00 ,$CC ,$EC ,$FC ,$DC ,$CC ,$00
  1767.      ,$3C ,$6C ,$6C ,$3E ,$00 ,$7E ,$00 ,$00 ,$38 ,$6C ,$6C ,$38 ,$00 ,$7C ,$00 ,$00
  1768.      ,$30 ,$00 ,$30 ,$60 ,$C0 ,$CC ,$78 ,$00 ,$00 ,$00 ,$00 ,$FC ,$C0 ,$C0 ,$00 ,$00
  1769.      ,$00 ,$00 ,$00 ,$FC ,$0C ,$0C ,$00 ,$00 ,$C3 ,$C6 ,$CC ,$DE ,$33 ,$66 ,$CC ,$0F
  1770.      ,$C3 ,$C6 ,$CC ,$DB ,$37 ,$6F ,$CF ,$03 ,$18 ,$18 ,$00 ,$18 ,$18 ,$18 ,$18 ,$00
  1771.      ,$00 ,$33 ,$66 ,$CC ,$66 ,$33 ,$00 ,$00 ,$00 ,$CC ,$66 ,$33 ,$66 ,$CC ,$00 ,$00
  1772.      ,$22 ,$88 ,$22 ,$88 ,$22 ,$88 ,$22 ,$88 ,$55 ,$AA ,$55 ,$AA ,$55 ,$AA ,$55 ,$AA
  1773.      ,$DB ,$77 ,$DB ,$EE ,$DB ,$77 ,$DB ,$EE ,$18 ,$18 ,$18 ,$18 ,$18 ,$18 ,$18 ,$18
  1774.      ,$18 ,$18 ,$18 ,$18 ,$F8 ,$18 ,$18 ,$18 ,$18 ,$18 ,$F8 ,$18 ,$F8 ,$18 ,$18 ,$18
  1775.      ,$36 ,$36 ,$36 ,$36 ,$F6 ,$36 ,$36 ,$36 ,$00 ,$00 ,$00 ,$00 ,$FE ,$36 ,$36 ,$36
  1776.      ,$00 ,$00 ,$F8 ,$18 ,$F8 ,$18 ,$18 ,$18 ,$36 ,$36 ,$F6 ,$06 ,$F6 ,$36 ,$36 ,$36
  1777.      ,$36 ,$36 ,$36 ,$36 ,$36 ,$36 ,$36 ,$36 ,$00 ,$00 ,$FE ,$06 ,$F6 ,$36 ,$36 ,$36
  1778.      ,$36 ,$36 ,$F6 ,$06 ,$FE ,$00 ,$00 ,$00 ,$36 ,$36 ,$36 ,$36 ,$FE ,$00 ,$00 ,$00
  1779.      ,$18 ,$18 ,$F8 ,$18 ,$F8 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$F8 ,$18 ,$18 ,$18
  1780.      ,$18 ,$18 ,$18 ,$18 ,$1F ,$00 ,$00 ,$00 ,$18 ,$18 ,$18 ,$18 ,$FF ,$00 ,$00 ,$00
  1781.      ,$00 ,$00 ,$00 ,$00 ,$FF ,$18 ,$18 ,$18 ,$18 ,$18 ,$18 ,$18 ,$1F ,$18 ,$18 ,$18
  1782.      ,$00 ,$00 ,$00 ,$00 ,$FF ,$00 ,$00 ,$00 ,$18 ,$18 ,$18 ,$18 ,$FF ,$18 ,$18 ,$18
  1783.      ,$18 ,$18 ,$1F ,$18 ,$1F ,$18 ,$18 ,$18 ,$36 ,$36 ,$36 ,$36 ,$37 ,$36 ,$36 ,$36
  1784.      ,$36 ,$36 ,$37 ,$30 ,$3F ,$00 ,$00 ,$00 ,$00 ,$00 ,$3F ,$30 ,$37 ,$36 ,$36 ,$36
  1785.      ,$36 ,$36 ,$F7 ,$00 ,$FF ,$00 ,$00 ,$00 ,$00 ,$00 ,$FF ,$00 ,$F7 ,$36 ,$36 ,$36
  1786.      ,$36 ,$36 ,$37 ,$30 ,$37 ,$36 ,$36 ,$36 ,$00 ,$00 ,$FF ,$00 ,$FF ,$00 ,$00 ,$00
  1787.      ,$36 ,$36 ,$F7 ,$00 ,$F7 ,$36 ,$36 ,$36 ,$18 ,$18 ,$FF ,$00 ,$FF ,$00 ,$00 ,$00
  1788.      ,$36 ,$36 ,$36 ,$36 ,$FF ,$00 ,$00 ,$00 ,$00 ,$00 ,$FF ,$00 ,$FF ,$18 ,$18 ,$18
  1789.      ,$00 ,$00 ,$00 ,$00 ,$FF ,$36 ,$36 ,$36 ,$36 ,$36 ,$36 ,$36 ,$3F ,$00 ,$00 ,$00
  1790.      ,$18 ,$18 ,$1F ,$18 ,$1F ,$00 ,$00 ,$00 ,$00 ,$00 ,$1F ,$18 ,$1F ,$18 ,$18 ,$18
  1791.      ,$00 ,$00 ,$00 ,$00 ,$3F ,$36 ,$36 ,$36 ,$36 ,$36 ,$36 ,$36 ,$FF ,$36 ,$36 ,$36
  1792.      ,$18 ,$18 ,$FF ,$18 ,$FF ,$18 ,$18 ,$18 ,$18 ,$18 ,$18 ,$18 ,$F8 ,$00 ,$00 ,$00
  1793.      ,$00 ,$00 ,$00 ,$00 ,$1F ,$18 ,$18 ,$18 ,$FF ,$FF ,$FF ,$FF ,$FF ,$FF ,$FF ,$FF
  1794.      ,$00 ,$00 ,$00 ,$00 ,$FF ,$FF ,$FF ,$FF ,$F0 ,$F0 ,$F0 ,$F0 ,$F0 ,$F0 ,$F0 ,$F0
  1795.      ,$0F ,$0F ,$0F ,$0F ,$0F ,$0F ,$0F ,$0F ,$FF ,$FF ,$FF ,$FF ,$00 ,$00 ,$00 ,$00
  1796.      ,$00 ,$00 ,$76 ,$DC ,$C8 ,$DC ,$76 ,$00 ,$00 ,$78 ,$CC ,$F8 ,$CC ,$F8 ,$C0 ,$C0
  1797.      ,$00 ,$FC ,$CC ,$C0 ,$C0 ,$C0 ,$C0 ,$00 ,$00 ,$FE ,$6C ,$6C ,$6C ,$6C ,$6C ,$00
  1798.      ,$FC ,$CC ,$60 ,$30 ,$60 ,$CC ,$FC ,$00 ,$00 ,$00 ,$7E ,$D8 ,$D8 ,$D8 ,$70 ,$00
  1799.      ,$00 ,$66 ,$66 ,$66 ,$66 ,$7C ,$60 ,$C0 ,$00 ,$76 ,$DC ,$18 ,$18 ,$18 ,$18 ,$00
  1800.      ,$FC ,$30 ,$78 ,$CC ,$CC ,$78 ,$30 ,$FC ,$38 ,$6C ,$C6 ,$FE ,$C6 ,$6C ,$38 ,$00
  1801.      ,$38 ,$6C ,$C6 ,$C6 ,$6C ,$6C ,$EE ,$00 ,$1C ,$30 ,$18 ,$7C ,$CC ,$CC ,$78 ,$00
  1802.      ,$00 ,$00 ,$7E ,$DB ,$DB ,$7E ,$00 ,$00 ,$06 ,$0C ,$7E ,$DB ,$DB ,$7E ,$60 ,$C0
  1803.      ,$38 ,$60 ,$C0 ,$F8 ,$C0 ,$60 ,$38 ,$00 ,$78 ,$CC ,$CC ,$CC ,$CC ,$CC ,$CC ,$00
  1804.      ,$00 ,$FC ,$00 ,$FC ,$00 ,$FC ,$00 ,$00 ,$30 ,$30 ,$FC ,$30 ,$30 ,$00 ,$FC ,$00
  1805.      ,$60 ,$30 ,$18 ,$30 ,$60 ,$00 ,$FC ,$00 ,$18 ,$30 ,$60 ,$30 ,$18 ,$00 ,$FC ,$00
  1806.      ,$0E ,$1B ,$1B ,$18 ,$18 ,$18 ,$18 ,$18 ,$18 ,$18 ,$18 ,$18 ,$18 ,$D8 ,$D8 ,$70
  1807.      ,$30 ,$30 ,$00 ,$FC ,$00 ,$30 ,$30 ,$00 ,$00 ,$76 ,$DC ,$00 ,$76 ,$DC ,$00 ,$00
  1808.      ,$38 ,$6C ,$6C ,$38 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$18 ,$18 ,$00 ,$00 ,$00
  1809.      ,$00 ,$00 ,$00 ,$00 ,$18 ,$00 ,$00 ,$00 ,$0F ,$0C ,$0C ,$0C ,$EC ,$6C ,$3C ,$1C
  1810.      ,$78 ,$6C ,$6C ,$6C ,$6C ,$00 ,$00 ,$00 ,$70 ,$18 ,$30 ,$60 ,$78 ,$00 ,$00 ,$00
  1811.      ,$00 ,$00 ,$3C ,$3C ,$3C ,$3C ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00 ,$00
  1812.      );
  1813.  
  1814. Procedure tDiveWindow.DrawStr( x, y, col, BackCol: Integer; s: String );
  1815. type
  1816.   Fontbuff = array[0..32000] of byte;
  1817. var
  1818.   line,spos,bit,bpos:integer;
  1819.   b: Integer;
  1820.   LineBuffer : array[0..640] of byte;
  1821.   ScrAddr:integer;
  1822.   MaxbPos: Integer;
  1823.  
  1824. begin
  1825.   VPTransformXY( x, y );
  1826.   ScrAddr:=y*xSize+x;
  1827.   MaxbPos := ySize*xSize;
  1828.   for Line := 0 to 7 do
  1829.     begin
  1830.       bpos := ScrAddr;
  1831.       for spos := 1 to length(s) do
  1832.         begin
  1833.           b := ord(s[spos]) shl 3+line;
  1834.           for bit := 7 downto 0 do
  1835.             begin
  1836.               if bPos > MaxbPos then
  1837.                 bPos := bPos
  1838.               else
  1839.                 if Boolean((Font8x8[b] shr bit) and 1) then
  1840.                   DisplayBuffer^[bpos] := Col
  1841.                 else
  1842.                   if BackCol >= 0 then
  1843.                     DisplayBuffer^[bpos] := backCol;
  1844.               inc(bpos);
  1845.             end;
  1846.         end;
  1847.       Inc(ScrAddr,xSize);
  1848.     end;
  1849.   RectChanged( x,y,x+8*length(s),y+8 );
  1850. end; // DrawStr
  1851.  
  1852. Procedure tDiveWindow.DrawArc( Center: Pixel; Rad, StAngle, EndAngle, Col: Integer );
  1853. begin
  1854.   DrawEllipse( Center, Rad, Rad, StAngle, EndAngle, Col );
  1855. end; // DrawArc
  1856.  
  1857. Procedure tDiveWindow.DrawEllipse( Center: Pixel; XRad, YRad, StAngle, EndAngle, Col: Integer );
  1858. var
  1859.   i : Integer;
  1860.   x,y: Integer;
  1861.   x1,y1,x2,y2: Integer;
  1862.   v: Integer;
  1863.   Multiply, Divide: Integer;
  1864. begin
  1865.   If StAngle > EndAngle then SwapLong( StAngle, EndAngle );
  1866.   // Modify according to aspect ratio
  1867.   YRad := ( YRad * xAspect ) div yAspect;
  1868.   PatternInx := 0;
  1869.   Multiply := 4;
  1870.   If yRad*LineThickness > 300 then
  1871.     Multiply := 1
  1872.   else
  1873.     if yRad*LineThickness > 150 then
  1874.       Multiply := 2;
  1875.   Divide := 4 div Multiply;
  1876.  
  1877.   x2 := (XRad*tCos[StAngle*4]) div 1024;
  1878.   y2 := (YRad*tSin[StAngle*4]) div 1024;
  1879.   LastArc.xStart := Center.x + x2;
  1880.   LastArc.yStart := Center.y - y2;
  1881.   for v := (StAngle+1)*Divide to EndAngle*Divide do
  1882.     begin
  1883.       y1 := y2;
  1884.       x1 := x2;
  1885.       x2 := (XRad*tCos[v*Multiply]) div 1024;
  1886.       y2 := (YRad*tSin[v*Multiply]) div 1024;
  1887.       DrawLine( Center.x+x2, Center.y-y2, Center.x+x1, Center.y-y1, Col );
  1888.     end;
  1889.   LastArc.x      := Center.x;
  1890.   LastArc.y      := Center.y;
  1891.   LastArc.xEnd   := Center.x+x2;
  1892.   LastArc.yEnd   := Center.y-y2;
  1893. end; // DrawEllipse
  1894.  
  1895. Procedure tDiveWindow.DrawPieSlice( Center: Pixel; Rad, StAngle, EndAngle, Col: Integer );
  1896. var
  1897.   i : Integer;
  1898.   x,y: Integer;
  1899.   sx,cx: Integer;
  1900.   x1,y1,x2,y2: Integer;
  1901.   l2dy: Double;
  1902.   l1dy: Double;
  1903.   a1, a2: Integer;
  1904. begin
  1905.   If StAngle <> 360 then
  1906.     StAngle := StAngle mod 360;
  1907.   If EndAngle <> 360 then
  1908.     EndAngle := EndAngle mod 360;
  1909.   If StAngle > EndAngle then SwapLong( StAngle, EndAngle );
  1910.   If LineMode then
  1911.     // Outline
  1912.     For i := StAngle*4 to EndAngle*4 do
  1913.       begin
  1914.         y := Center.y+(tSin[i]*Rad) div 1024;
  1915.         x := Center.x+(tCos[i]*Rad) div 1024;
  1916.         If (i<>StAngle*4) and (i<>EndAngle*4) then
  1917.           SetPix( x, y, Col )
  1918.         else
  1919.           DrawLine( Center.x, Center.y, x, y, Col )
  1920.       end
  1921.   else
  1922.     // Fill slice
  1923.     begin
  1924.       // Divide into one call per quadrant
  1925.       for i := 0 to 3 do
  1926.         if ( StAngle < i*90 ) and ( EndAngle > i*90 ) then
  1927.           begin
  1928.             DrawPieSlice( Center, Rad, StAngle, i*90, Col );
  1929.             DrawPieSlice( Center, Rad, i*90, EndAngle, Col );
  1930.             Exit;
  1931.           end;
  1932.       x1 := tCos[StAngle*4];  y1 := tSin[StAngle*4];
  1933.       x2 := tCos[EndAngle*4]; y2 := tSin[EndAngle*4];
  1934.       If StAngle = EndAngle then
  1935.         begin
  1936.           DrawLine( Center.x, Center.y,
  1937.                     Center.x+(x1*Rad) div 1024, Center.y+(y1*Rad) div 1024, Col );
  1938.           Exit;
  1939.         end;
  1940.       if y2 <> 0 then
  1941.         l2dy := x2/y2
  1942.       else l2dy := 0;
  1943.       if y1 <> 0 then
  1944.         l1dy := x1/y1
  1945.       else l1dy := 0;
  1946.       For i := StAngle*4 to EndAngle*4 do
  1947.         begin
  1948.           x := Center.x+(tCos[i]*Rad) div 1024;
  1949.           y := Center.y+(tSin[i]*Rad) div 1024;
  1950.           if ( l2dy >= 0 ) and ( l1dy >= 0 ) then
  1951.             begin
  1952.               // 1st, 3rd Quadrant
  1953.               sx := Round(l2dy*(y-Center.y)+Center.x);
  1954.               DrawLine( sx, y, x, y, Col );
  1955.             end
  1956.           else
  1957.             begin
  1958.               // 2nd, 4th Quadrant
  1959.               cx := Round(l1dy*(y-Center.y)+Center.x);
  1960.               DrawLine( x, y, cx, y, Col );
  1961.             end;
  1962.         end;
  1963.       If ( l1dy >= 0 ) and ( l2dy >= 0 ) then
  1964.         begin
  1965.           a2 := StAngle*4;
  1966.           If StAngle < 90 then
  1967.             a1 := 0       // 1st Quadrant
  1968.           else
  1969.             a1 := 180*4;  // 3rd Quadrant
  1970.         end
  1971.       else
  1972.         begin
  1973.           a1 := EndAngle*4;
  1974.           If StAngle <= 180 then
  1975.             a2 := 180*4   // 2nd Quadrant
  1976.           else
  1977.             a2 := 360*4;  // 4rd Quadrant
  1978.         end;
  1979.  
  1980.       For i := a1 to a2 do
  1981.         begin
  1982.           y := Center.y+(tSin[i]*Rad) div 1024;
  1983.           x := Center.x+(tCos[i]*Rad) div 1024;
  1984.           sx := Round(l2dy*(y-Center.y)+Center.x);
  1985.           cx := Round(l1dy*(y-Center.y)+Center.x);
  1986.           DrawLine( sx, y, cx, y, Col );
  1987.         end;
  1988.     end;
  1989. end; // DrawPieSlice
  1990.  
  1991. Procedure tDiveWindow.Flip( Steps: Longint );
  1992. var
  1993.   Lines: Integer;
  1994.   CopyLine: Double;
  1995.   LinesLeft: Integer;
  1996.   CurrLine: Integer;
  1997.   BankNum : Integer;
  1998.   Half: Integer;
  1999.   Step: Double;
  2000.   Buffer: Pointer;
  2001.   p: Pointer;
  2002.   Shrink,v: Double;
  2003.  
  2004. begin
  2005.   GetMem( Buffer, xSize*ySize );
  2006.   try
  2007.     BankNum := 0;
  2008.     DiveSwitchBank( hDive, BankNum );
  2009.     p := DisplayBuffer;
  2010.     for Lines := 0 to ySize-1 do
  2011.       begin
  2012.         move( p^, (Pchar( Buffer ) + Lines*xSize)^, xSize );
  2013.         Inc( pChar(p), xSize );
  2014.       end;
  2015.     Inc( BankNum );
  2016.     DiveSwitchBank( hDive, BankNum );
  2017.  
  2018.     Half := ySize div 2;
  2019.     Step := 3.14/Steps;
  2020.     v := 0;
  2021.     Repeat
  2022.       if v+Step < 3.14 then
  2023.         Shrink := 1/cos(v)
  2024.       else
  2025.         Shrink := -1;
  2026.       BankNum := 0;
  2027.       DiveSwitchBank( hDive, BankNum );
  2028.       p := DisplayBuffer;
  2029.       CurrLine := Half;
  2030.       LinesLeft := ySize;
  2031.       For Lines := 0 to ySize-1 do
  2032.         begin
  2033.           CopyLine := Half - CurrLine*Shrink;
  2034.           If ( CopyLine >= 0 ) and ( CopyLine < ySize ) then
  2035.             move( (pChar(Buffer) + Round(CopyLine)*xSize)^, p^, xSize )
  2036.           else
  2037.             FillChar( p^, xSize, 0 );
  2038.           Dec( CurrLine );
  2039.           Inc( pChar(p), xSize );
  2040.           Dec( LinesLeft );
  2041.           If LinesLeft = 0 then
  2042.             begin
  2043.               LinesLeft := ySize;
  2044.               p := DisplayBuffer;
  2045.               Inc( BankNum );
  2046.               DiveSwitchBank( hDive, BankNum );
  2047.               DiveBlitImage ( hDive,
  2048.                               fImage,
  2049.                               Dive_Buffer_Screen );
  2050.             end;
  2051.         end;
  2052.  
  2053.       v := v + Step;
  2054.     Until v > 3.14;
  2055.   finally
  2056.     FreeMem( Buffer, xSize*ySize );
  2057.   end;
  2058. end;
  2059.  
  2060. procedure tDiveWindow.Clear( Col: Longint );
  2061. begin
  2062.   FillChar( DisplayBuffer^, xSize*ySize, Col );
  2063.   AllChanged;
  2064. end;
  2065.  
  2066. procedure tDiveWindow.PixelChanged( x,y: Integer );
  2067. begin
  2068.   if not FastBlit then
  2069.   begin
  2070.     ImageChanged := True;
  2071.     Exit;
  2072.   end;
  2073.   mtx_Rect.Request;
  2074.  
  2075.   With fChangedRect do
  2076.     begin
  2077.       if x < xLeft then
  2078.         xLeft := x;
  2079.       if x > xRight then
  2080.         xRight := x;
  2081.  
  2082.       if y > yTop then
  2083.         yTop := y;
  2084.       if y < yBottom then
  2085.         yBottom := y;
  2086.       xLeft   := max( 0, xLeft );
  2087.       xRight  := min( xRight, xSize-1 );
  2088.       yBottom := max( 0, yBottom );
  2089.       yTop    := min( yTop, ySize-1 );
  2090.     end;
  2091.   ImageChanged := True;
  2092.   mtx_Rect.Release;
  2093. end;
  2094.  
  2095. procedure tDiveWindow.RectChanged( x1,y1, x2,y2: Integer );
  2096.   procedure PixChanged( x,y: Integer );
  2097.   begin
  2098.     With fChangedRect do
  2099.       begin
  2100.         if x < xLeft then
  2101.           xLeft := x;
  2102.         if x > xRight then
  2103.           xRight := x;
  2104.  
  2105.         if y > yTop then
  2106.           yTop := y;
  2107.         if y < yBottom then
  2108.           yBottom := y;
  2109.         xLeft   := max( 0, xLeft );
  2110.         xRight  := min( xRight, xSize-1 );
  2111.         yBottom := max( 0, yBottom );
  2112.         yTop    := min( yTop, ySize-1 );
  2113.       end;
  2114.     ImageChanged := True;
  2115.   end;
  2116. begin
  2117.   if not FastBlit then
  2118.   begin
  2119.     ImageChanged := True;
  2120.     Exit;
  2121.   end;
  2122.   mtx_rect.Request;
  2123.  
  2124.   PixChanged( x1, y1 );
  2125.   PixChanged( x2, y2 );
  2126.   mtx_Rect.Release;
  2127. end;
  2128.  
  2129. procedure tDiveWindow.AllChanged;
  2130. begin
  2131.   RectChanged( 0,0, xsize-1,ysize-1);
  2132. end;
  2133.  
  2134. procedure tDiveWindow.WaitDraw;
  2135. begin
  2136.   While fChanged or pChanged do
  2137.     DosSleep(31);
  2138. end;
  2139.  
  2140. procedure tDiveWindow.SetLineThickness( Thickness: Word );
  2141. begin
  2142.   LineThickness := ThickNess;
  2143. end;
  2144.  
  2145. function tDiveWindow.VPWidth: Integer;
  2146. begin
  2147.   with ViewPort do
  2148.     Result := x2-x1;
  2149. end;
  2150.  
  2151. function tDiveWindow.VPHeight: Integer;
  2152. begin
  2153.   with ViewPort do
  2154.     Result := y2-y1;
  2155. end;
  2156.  
  2157. function tDiveWindow.VPXMax: Integer;
  2158. begin
  2159.   with ViewPort do
  2160.     Result := x1+x2;
  2161. end;
  2162.  
  2163. function tDiveWindow.VPYMax: Integer;
  2164. begin
  2165.   with ViewPort do
  2166.     Result := y2+y1;
  2167. end;
  2168.  
  2169. procedure tDiveWindow.SetViewPort( xa, ya, xb, yb: Integer );
  2170. begin
  2171.   With fVP do
  2172.     begin
  2173.       x1 := xa;
  2174.       x2 := xb;
  2175.       y1 := ya;
  2176.       y2 := yb;
  2177.     end;
  2178. end;
  2179.  
  2180. procedure tDiveWindow.SetLinePattern( Pattern: Word );
  2181. begin
  2182.   LinePattern := Pattern;
  2183.   PatternInx := 0;
  2184. end;
  2185.  
  2186. {&R SysUtils.Res}
  2187.  
  2188. procedure DisplayPMMsg( Hdr, Txt: PChar );
  2189. begin
  2190.   if SuppressMessages then
  2191.     Exit;
  2192.  
  2193.   WinCreateMsgQueue(WinInitialize(0), 0);
  2194.   WinMessageBox(hwnd_Desktop, hwnd_Desktop, Txt, Hdr, 0, mb_Information+mb_Moveable);
  2195. end;
  2196.  
  2197. // Make checks to see if DIVE is installed and if it is
  2198. // the buggy version from Warp or a newer one
  2199. procedure VerifyDiveVersion;
  2200. const
  2201.   initErr: pChar = 'GRAPH initialization error';
  2202. var
  2203.   rc: Longint;
  2204.   Buffer: array[0..259] of Char;
  2205.   dll_Dive: Longint;
  2206.   s: String;
  2207.   Age: Longint;
  2208.   Date: TDateTime;
  2209.   Year, Month, Day: SmallWord;
  2210.  
  2211. begin
  2212.   rc := DosLoadModule(Buffer, SizeOf(Buffer), 'DIVE', dll_Dive);
  2213.   if rc <> 0 then
  2214.     raise EDive.Create( 'Dive not installed on system. Application terminated' );
  2215.  
  2216.   rc := DosQueryModuleName( dll_Dive, Sizeof(Buffer), Buffer );
  2217.   if rc <> 0 then
  2218.     raise EDive.CreateFmt( 'Cannot load DIVE.DLL; rc = %d. Application terminated', [rc] );
  2219.  
  2220.   Age := FileAge( StrPas( Buffer ) );
  2221.   Date := FileDateToDateTime( Age );
  2222.   DecodeDate(Date, Year, Month, Day);
  2223.  
  2224.   If Year < 1995 then
  2225.     raise EDive.Create( 'DIVE installed is very outdated and cannot be used' );
  2226.  
  2227.   if ( Year = 1995 ) and ( Month <= 2 ) then
  2228.     begin
  2229.       // DIVE is from Warp, and does not support FastBlit
  2230.       Os2Dive.FastBlitSupported := False;
  2231.       DisplayPMMsg( 'GRAPH warning message',
  2232.         'The version of DIVE found does not support optimised screen output. '+
  2233.         'Because of this, screen updates using GRAPH/VP will be very slow.  For better '+
  2234.         'performance, apply the latest Warp Fixpak or upgrade to OS/2 Merlin' );
  2235.     end
  2236.   else
  2237.     DisplayPMMsg( 'BGI Graphics for VP/2',
  2238.       'Thank you for using Graph for Virtual Pascal with your program.  Note, that '+
  2239.       'this software is BETA level and is used at your own risk' );
  2240.  
  2241.   DosFreeModule( dll_Dive );
  2242. end;
  2243.  
  2244. var
  2245.   i : Integer;
  2246.  
  2247. initialization  // Set up Sine and Cosine tables
  2248.   if IsConsole then
  2249.     begin
  2250.       Writeln( 'OS2DIVE can only be used in a PM Application' );
  2251.       halt(2);
  2252.     end;
  2253.   for i := 0 to 4*360 do
  2254.     begin
  2255.       tSin[i] := Round(Sin(i*pi/(4*180.0))*1024);
  2256.       tCos[i] := Round(Cos(i*pi/(4*180.0))*1024);
  2257.     end;
  2258. {$IFDEF DEBUG}
  2259.   assign(logfile,'log.txt');
  2260.   rewrite(logfile);
  2261.   writeln(logfile,'Start Log');
  2262.   doscreatemutexsem( nil, mtx_log, 0, False );
  2263. {$ENDIF}
  2264.   VerifyDiveVersion;
  2265. end.
  2266.