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