{ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ}
{Û                                                       Û}
{Û      Virtual Pascal Examples  Version 2.1             Û}
{Û      DIVE Class - Beta version                        Û}
{Û      ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÛ}
{Û      Copyright (C) 1996-2000 vpascal.com              Û}
{Û      Written May 1996 by Allan Mertner                Û}
{Û      Inspired by DIVERace by Michael Mrosowski        Û}
{Û                                                       Û}
{ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}

{$Delphi+}

unit Os2Dive;

{$IFDEF VER10}
  !! This unit requires a version of Virtual Pascal later than 1.00
{$ENDIF}

interface

uses
  Os2Def, Os2Base, Os2MM, Os2PmApi,  // OS/2 API definitions
  VPUtils, SysUtils;                 // Utility libraries

const
  // Standard menu commands handled by default msg handler
  ID_DIVEMENU = 1000;
  ID_NEWTEXT  = 1001;
  ID_SNAP     = 1002;
  ID_SNAP2    = 1003;
  ID_SNAPFULL = 1004;
  ID_EXIT     = 1005;
  ID_PAUSE    = 1006;

const
  // Maximum display size
  xmax = 1279;
  ymax = 1023;

type
  Pixel = Record
    x,y: SmallInt;
  end;

type
  DisplayBufferArray = Array[ 0..(ymax+1)*(xmax+1)-1 ] of Byte;
  pDisplayBufferArray = ^DisplayBufferArray;
  tDiveWindow = class;
  tUpdateFunc = Procedure( Dive: tDiveWindow );

  EDive = class(Exception);
  EDiveDraw = class(EDive);

  tDiveWindow = class
  private
    ScreenX: LongInt;
    ScreenY: LongInt;
    hDive: HDive;
    fImage: Longint;
    fSizeX: Longint;
    fSizeY: Longint;
    fccColorFormat : Longint;
    fLineSize: Longint;
    hwndClient: HWnd;
    hwndFrame: HWnd;
    fColorBits: Byte;
    TimerEvent: hEv;
    BlitEvent: hEv;
    tidTimer: tid;
    tidBlitThread: tid;
    tidMain: tid;
    fTimer: Longint;
    fStopping: Boolean;
    DisplayBuf: pDisplayBufferArray;
    fUpdateBuffer: tUpdateFunc;
    fMessageHandler: fnWP;
    fLineMode: Boolean;
    fStatistics: Boolean;
    fPauseDisplay: Boolean;
    Procedure SetMainWindowTitle( s: string );
  protected
    function GetColours: Longint;
    procedure SetStatistics( b: Boolean);
    procedure InitWindow( ResType, ResID: Longint ); virtual;
    function GetPixel(x,y: Longint): Longint;
    procedure SetPixel(x,y: Longint; Value: Longint);
    function BeginUpdate: Integer;
    procedure EndUpdate;
  public
    // Constructors and destructors
    constructor Create( SizeX, SizeY: Longint; ColorBits: Byte );
    constructor CreateRes( SizeX, SizeY: Longint; ColorBits: Byte; ResType, ResID: Longint );
    destructor Destroy; override;

    // Message handling loop
    procedure run; virtual;

    // Properties of the window as a whole
    property Colours: Longint read GetColours;
    property Stopping: Boolean read fStopping write fStopping;
    property Statistics: Boolean read fStatistics write SetStatistics;
    property xSize: Longint read fSizeX;
    property ySize: Longint read fSizeY;
    property PauseDisplay: Boolean read fPauseDisplay write fPauseDisplay;

    // User hooks
    property UpdateBuffer: tUpdateFunc read fUpdateBuffer write fUpdateBuffer;
    property MessageHandler: FNWp read fMessageHandler write fMessageHandler;

    // Drawing primitives
    property LineMode: Boolean read fLineMode write fLineMode;
    property Pixels[x,y:Longint]: longint read GetPixel write SetPixel; default;
    procedure DrawLine( x1,y1, x2,y2, c: Longint );
    procedure DrawBox( x1,y1, x2,y2, c: Longint );
    procedure DrawTriangle( p1,p2,p3: Pixel; c: Longint );
    procedure DrawQuad( p1,p2,p3,p4: Pixel; c: Longint );
    Procedure DrawStr( x, y, col, BackCol: Integer; s: String );
    Procedure DrawArc( Center: Pixel; Rad, StAngle, EndAngle, Col: Integer );
    Procedure DrawPieSlice( Center: Pixel; Rad, StAngle, EndAngle, Col: Integer );
    Procedure Flip( Steps: Longint );
  end;

const
  coltranslate:boolean = TRUE;           // Translate 256 Colors for Dive ?

implementation

const
  FourCC_LUT8 = ord('L')+(ord('U') shl 8)+(ord('T') shl 16)+(ord('8') shl 24);
  FourCC_R565 = ord('R')+(ord('5') shl 8)+(ord('6') shl 16)+(ord('5') shl 24);
  FourCC_BGR4 = ord('B')+(ord('G') shl 8)+(ord('R') shl 16)+(ord('4') shl 24);
  FourCC_SCRN = 0;

  pszMyWindow:Pchar = 'DiveWindow';
  pszTitleText:Pchar = 'Dive Window';

var
  h_dc : hDC;
  h_ab : Longint;
  h_pal:HPAL;
  pPalette: Pointer;
  tSin,tCos : array[0..4*360] of Integer;

var achTitle: array[0..255] of char;
Procedure tDiveWindow.SetMainWindowTitle(s:string);
begin
  StrPCopy( @achTitle, s );
  WinPostMsg ( hwndFrame, WM_COMMAND, ID_NEWTEXT, longint(@achTitle));
end;

Function GetSnapHeight(ulHeight:ULONG):ULONG;
begin
  Inc( ulHeight, WinQuerySysValue ( HWND_DESKTOP, SV_CYSIZEBORDER ) * 2);
  Inc( ulHeight, WinQuerySysValue ( HWND_DESKTOP, SV_CYBORDER ) * 2);
  Inc( ulHeight, WinQuerySysValue ( HWND_DESKTOP, SV_CYMENU ) );
  Inc( ulHeight, WinQuerySysValue ( HWND_DESKTOP, SV_CYTITLEBAR ) );
  GetSnapHeight:=ulHeight;
end;

Function GetSnapWidth(ulWidth:ULONG):ULONG;
begin
  Inc( ulWidth, WinQuerySysValue ( HWND_DESKTOP, SV_CXSIZEBORDER ) * 2);
  GetSnapWidth:=ulWidth;
end;

function MyWindowProc(Window: HWnd; Msg: ULong; Mp1,Mp2: MParam): MResult;cdecl;
var
  point_l     :POINTL;               (* Point to offset from Desktop         *)
  swpos       :SWP;                  (* Window position                      *)
  h_rgn       :HRGN;                 (* Region handle                        *)
  h_ps        :HPS;                  (* Presentation Space handle            *)
  h_psPal     :HPS;                  (* Presentation Space handle            *)
  rcls        :array[0..49] of RECTL;(* Rectangle coordinates                *)
  rgnCtl      :RGNRECT;              (* Processing control structure         *)
  Dive        :tDiveWindow;
  SetupBlitter:SETUP_BLITTER;        (* structure for DiveSetupBlitter       *)
  pPal        :PLONG;

  NoRectl     :PRECTL;
  PaletteColors:ULONG;

  sizl:SIZEL;

  rc:Ulong;

begin
  NoRectl:=Nil;
  Dive:= tDiveWindow(WinQueryWindowULong (Window, 0));
  // Run user's message handler first
  If ( Dive <> nil ) and Assigned( Dive.MessageHandler ) then
    begin
      Result := Dive.MessageHandler( Window, Msg, mp1, mp2 );
      If Result <> 0 then
        // Message handled by user
        Exit;
    end;

  if (Dive <> nil) or (msg=WM_CREATE) then begin
    case msg of
      WM_CREATE:
        begin
          // Set Up the physical palette
          sizl.cx := 0;
          sizl.cy := 0;
          h_DC := WinOpenWindowDC(Window);
          h_psPal := GpiCreatePS(h_ab,h_dc,sizl,
                       PU_PELS or GPIF_DEFAULT or GPIT_MICRO or GPIA_ASSOC);

          h_pal := GpiCreatePalette( h_ab,
                                     LCOL_PURECOLOR,
                                     LCOLF_CONSECRGB,
                                     200,
                                     ULONG(pPalette^));
          rc := GpiSelectPalette(h_psPal,h_pal);

          WinRealizePalette( Window, h_psPal, PaletteColors );
        end;
      WM_COMMAND:
        case USHORT(mp1) of
          ID_SNAP:
            // Snap Window to Dive Buffer Size
            WinSetWindowPos ( Dive.hwndFrame, HWND_TOP,
                              0, 0,  // Ignored
                              GetSnapWidth( Dive.xsize ),
                              GetSnapHeight( Dive.ySize ),
                              SWP_SIZE or SWP_ACTIVATE or SWP_SHOW );

          ID_SNAP2:
            // Snap Window to Size & height * 2
            WinSetWindowPos ( Dive.hwndFrame, HWND_TOP,
                              0, 0, // Ignored
                              GetSnapWidth( Dive.xSize*2 ),
                              GetSnapHeight( Dive.ySize*2 ),
                              SWP_SIZE or SWP_ACTIVATE or SWP_SHOW );

          ID_SNAPFULL:
            // Snap to Full Size but retain (approx) aspect ratio
            With Dive do
              WinSetWindowPos ( hwndFrame, HWND_TOP,
                                0,
                                screeny div 2-((fSizeY*ScreenX) div fSizeX) div 2,
                                ScreenX,
                                (fSizeY*ScreenX) div fSizeX,
                                SWP_MOVE or SWP_SIZE or SWP_ACTIVATE or SWP_SHOW );

          ID_EXIT:
            // Post to quit the dispatch message loop.
            WinPostMsg ( Window, WM_QUIT, 0, 0 );

          ID_PAUSE:
            // Pause by stopping timer thread
            with Dive do
              begin
                PauseDisplay := not PauseDisplay;
                If PauseDisplay then
                  SetMainWindowTitle('PAUSED')
                else
                  SetMainWindowTitle('Resumed');
              end;

          ID_NEWTEXT:
            // Write new text string to the title bar
            WinSetWindowText ( Dive.hwndFrame, PCHAR(mp2) );
          else
            begin
              // Let PM handle this message.
              MyWindowProc := WinDefWindowProc ( Window, msg, mp1, mp2 );
              exit;
            end;
        end;

      WM_VRNDISABLED:
        DiveSetupBlitter ( Dive.hDive, nil );

      WM_VRNENABLED:
        begin
          h_ps := WinGetPS ( Window );
          if h_ps<>0 then begin
            h_rgn := GpiCreateRegion ( h_ps, 0, NoRectl );
            if h_rgn<>0 then begin
              WinQueryVisibleRegion ( Window, h_rgn );
              rgnCtl.ircStart     := 0;
              rgnCtl.crc          := 50;
              rgnCtl.ulDirection  := 1;

              // Get the all ORed rectangles
              if GpiQueryRegionRects ( h_ps, h_rgn, NoRectl, rgnCtl, rcls[0]) then
                begin
                  // Now find the window position and size, relative to parent.
                  WinQueryWindowPos ( Dive.hwndClient, swpos );

                  // Convert the point to offset from desktop lower left.
                  point_l.x := swpos.x;
                  point_l.y := swpos.y;
                  WinMapWindowPoints ( Dive.hwndFrame,
                                       HWND_DESKTOP, point_l, 1 );

                  // Tell DIVE about the new settings.
                  With SetupBlitter do
                    begin
                      ulStructLen := sizeof ( SETUP_BLITTER );
                      fccSrcColorFormat := Dive.fccColorFormat;
                      ulSrcWidth := Dive.fSizeX;
                      ulSrcHeight := Dive.fSizeY(* shr 1*);
                      ulSrcPosX := 0;
                      ulSrcPosY := 0;
                      fInvert := FALSE (*TRUE*);
                      ulDitherType := 0;

                      if coltranslate then
                        fccDstColorFormat := FOURCC_SCRN
                      else
                        fccDstColorFormat := FOURCC_LUT8;

                      ulDstWidth := swpos.cx;
                      ulDstHeight := swpos.cy(*shr 1*);

                      lDstPosX := 0;
                      lDstPosY := 0;
                      lScreenPosX := point_l.x;
                      lScreenPosY := point_l.y;
                      ulNumDstRects := rgnCtl.crcReturned;
                      pVisDstRects := @rcls;
                    end; // With

                  rc := DiveSetupBlitter ( Dive.hDive, @SetupBlitter );
                end
              else
                DiveSetupBlitter ( Dive.hDive, nil );

              GpiDestroyRegion( h_ps, h_rgn );
            end;
          end;
        end; // WM_VRNENABLED

      WM_REALIZEPALETTE:
        begin
          h_ps := WinBeginPaint ( Dive.hwndFrame, 0 , Nil);

          GetMem(pPal,sizeof(LONG) * Dive.Colours );

          GpiQueryRealColors ( h_ps, 0, 0, Dive.Colours, pPal^ );

          if coltranslate then
            DiveSetDestinationPalette ( Dive.hDive, 0,
                                        Dive.Colours,
                                        Pointer(pPal));
          FreeMem(pPal,sizeof(LONG) * Dive.Colours);

          WinEndPaint ( h_ps );
         end;

      WM_CHAR :
        // Handle default hotkeys
        if (CharMsgMp1(Mp1).fs and kc_KeyUp) = 0 then { Key is Down }
          case uShort(mp2 shr 16) of
            VK_F3 : WinPostMsg ( Window, WM_QUIT, 0, 0 );
            VK_F1 : WinPostMsg ( Window, WM_COMMAND, ID_SNAP, 0 );
            VK_F2 : WinPostMsg ( Window, WM_COMMAND, ID_SNAP2, 0 );
            VK_F4 : WinPostMsg ( Window, WM_COMMAND, ID_SNAPFULL, 0 );
            VK_F5 : WinPostMsg ( Window, WM_COMMAND, ID_PAUSE, 0 );
          end;

      WM_CLOSE:
      begin
        // Post to quit the dispatch message loop.
        GpiSelectPalette(h_psPal,0);
        GpiDeletePalette(h_pal);
        GpiDestroyPS(h_psPal);

        WinPostMsg ( Window, WM_QUIT, 0, 0 );
      end;
    else
      begin
        // Let PM handle this message.
        MyWindowProc := WinDefWindowProc ( Window, msg, mp1, mp2 );
        exit;
      end;
    end; { Case msg }
  end
  else
    begin
      // Let PM handle this message.
      MyWindowProc := WinDefWindowProc ( Window, msg, mp1, mp2 );
      exit;
    end;
  MyWindowProc:=0;
end;

Function TimerThread( P: Pointer ): Longint;
var
  rc : longint;
begin
  With tDiveWindow(p) do
    begin
      fTimer:=0;
      while not Stopping do begin
        rc := DosPostEventSem(TimerEvent);
        if rc = 6 then
          exit;
        DosSleep(55);
        if not PauseDisplay then
          Inc( fTimer );
      end;
    end;
end;

Function BlitterThread( P: Pointer ): Longint;
var
  Dive  : tDiveWindow;
  First : Boolean;
  Frames: Longint;        // Frame counter

  StartTimer:Longint;
  rc: ApiRet;
  PostCount:Longint;

begin
  Dive := tDiveWindow( P );
  First := False;
  Frames:=0;

  StartTimer := Dive.fTimer;
  With Dive do
    While not Stopping do
      begin
        // Wait until it is time to blit
        repeat
          rc := DosWaitEventSem( BlitEvent, 500 );
          if rc=6 then exit;
          DosResetEventSem( BlitEvent, PostCount );
        until ( rc <> 640 ) or Stopping;  // 640 = timeout

        // Set up colour palette
        if First then
          begin
            if ColTranslate then
              DiveSetSourcePalette ( Dive.hDive,
                                     0,
                                     Dive.Colours,
                                     pPalette );
            First := False;
          end;

        if BeginUpdate <> 0 then Exit;

        // Call user function to update buffer content
        If Assigned( UpdateBuffer ) then
          UpdateBuffer( Dive );

        EndUpdate;

        // Make image appear in window
        DiveBlitImage ( hDive,
                        fImage,
                        DIVE_BUFFER_SCREEN );
        inc(frames);

        // Update Statistics if required
        if Statistics and (fTimer-StartTimer >= 10) then
          begin
            SetMainWindowTitle( Format( '%2.6g Fps', [(frames*18)/(fTimer-StartTimer) ] ));
            Frames := 0;
            StartTimer := fTimer;
          end;
    end;
end;

function tDiveWindow.BeginUpdate: Integer;
var
  ulScanLineBytes:ULONG;
  ulScanLines:ULONG;
begin
  Result := DiveBeginImageBufferAccess (  // <> 0 = error
              hDive,
              fImage,
              Pointer( DisplayBuf ),
              ulScanLineBytes,
              ulScanLines );
end;

procedure tDiveWindow.EndUpdate;
begin
  DiveEndImageBufferAccess ( hDive, fImage );
end;

Function MainThread( P: Pointer ) : Longint;
var
  Dive: tDiveWindow;
  rc: ApiRet;
  PostCount: Longint;

begin
  Dive := tDiveWindow(P);

  rc := DosResetEventSem( Dive.TimerEvent, PostCount );
  PostCount := 0;

  With Dive do
    While not Stopping do
      begin
        Dec( PostCount );
        if PostCount <= 0 then
          begin
            // Wait a little
            rc := DosWaitEventSem( TimerEvent, 200 );
            if rc = 6 then  // Invalid handle error
              exit;
            DosResetEventSem( TimerEvent, PostCount );
          end;

        If PauseDisplay then
          begin
            While PauseDisplay Do
              DosSleep(100);
            DosResetEventSem(TimerEvent,Postcount);
            PostCount:=1;
          end;

        // Tell Blitter thread to update screen
        DosPostEventSem( BlitEvent );
      end;
end;

constructor tDiveWindow.Create( SizeX, SizeY: Longint; ColorBits: Byte );
begin
  CreateRes( SizeX, SizeY, ColorBits, 0, 0 );
end;

constructor tDiveWindow.CreateRes( SizeX, SizeY: Longint; ColorBits: Byte; ResType, ResID: Longint );
var
  NullPtr: Pointer;
  ScanLineBytes: Longint;
  ScanLines: Longint;
  Buffer: Pointer;
  h_mq : HMq;

begin
  If not (ColorBits in [8,16,24]) then
    Raise EDive.Create( 'Only colour depths of 8, 16 or 24 is allowed' );

  fColorBits := ColorBits;
  NullPtr := nil;
  if DiveOpen ( hDive, FALSE, NullPtr ) <> 0 then
    Raise EDive.Create( 'Cannot open DIVE engine' );

  fSizeX := SizeX;
  fSizeY := SizeY;
  fLineSize := 0;
  Case ColorBits of
     8 : FccColorFormat := FourCC_LUT8;
    16 : FccColorFormat := FourCC_R565;
    24 : FccColorFormat := FourCC_BGR4;
  end;
  if DiveAllocImageBuffer( hDive,             // Dive Handle
                           fImage,            // Image handle number
                           fccColorFormat,    // Color depth
                           fSizeX,            // X size
                           fSizeY,            // Y size
                           fLineSize,
                           nil ) <> 0 then
    Raise EDive.Create( 'Failed to allocate DIVE image buffer' );

  if DiveBeginImageBufferAccess( hDive,      // Dive Handle
                                 fImage,
                                 Buffer,
                                 ScanLineBytes,
                                 ScanLines ) <> 0 then
    begin
      DiveFreeImageBuffer( hDive, fImage );
      Raise EDive.Create( 'Failed to access DIVE image buffer' );
    end;

  Fillchar( Buffer^, fSizeX*fSizeY, 0 );

  DiveEndImageBufferAccess ( hDive, fImage );

  ScreenX := WinQuerySysValue ( HWND_DESKTOP, SV_CXSCREEN );
  ScreenY := WinQuerySysValue ( HWND_DESKTOP, SV_CYSCREEN );

  h_ab := WinInitialize ( 0 );
  h_mq := WinCreateMsgQueue ( h_ab, 0 );

  InitWindow( ResType, ResId );

  WinSetWindowULong( hwndClient, 0, Longint(Self) );

  WinSetVisibleRegionNotify ( hwndClient, TRUE );

  WinPostMsg ( hwndFrame, WM_VRNENABLED, 0, 0 );

  Stopping := False;
  Statistics := False;
  LineMode := False;
  PauseDisplay := False;
  UpdateBuffer := nil;
  MessageHandler := nil;
  // Create semahores and threads to handle the window
  DosCreateEventSem( PCHAR(0), TimerEvent, DC_SEM_SHARED, FALSE );
  DosCreateEventSem( PCHAR(0), BlitEvent, DC_SEM_SHARED, FALSE );

  // Timer thread
  tidTimer := VPBeginThread( TimerThread, 8192, Self );
  DosSetPriority ( prtys_Thread, prtyc_TimeCritical, -1, tidTimer );

  // Blitter thread
  tidBlitThread := VPBeginThread ( BlitterThread, 16384, Self );
  DosSetPriority ( prtys_Thread, prtyc_IdleTime, 20, tidBlitThread );

  // Main thread
  tidMain := VPBeginThread( MainThread, 8192, Self );
  DosSetPriority ( prtys_Thread, prtyc_Regular, 0, tidMain );
end; // Create

procedure tDiveWindow.InitWindow( ResType, ResID: Longint );
var
  flCreate: Longint;
  WinPosX : Longint;
  WinPosY : Longint;
begin
  WinRegisterClass ( h_ab, pszMyWindow, MyWindowProc, 0, sizeof(ULONG) );

  flCreate := FCF_TASKLIST or FCF_SYSMENU or FCF_TITLEBAR or
              FCF_SIZEBORDER or FCF_MINMAX or FCF_SCREENALIGN
              or ResType;

  hwndFrame := WinCreateStdWindow ( HWND_DESKTOP,
                                    WS_VISIBLE, flCreate,
                                    pszMyWindow,
                                    pszTitleText,
                                    WS_SYNCPAINT or WS_VISIBLE,
                                    0,
                                    ResId,
                                    @hwndClient);
  if hwndFrame = 0 then
    Raise EDive.Create( 'Failed to create frame window' );

  WinPosX := ScreenX div 2 - ( GetSnapWidth(fSizeX) div 2 );
  WinPosY := ScreenY div 2 - ( GetSnapHeight(fSizeY) div 2 );

  WinSetWindowPos ( hwndFrame, HWND_TOP,
                               WinPosX, WinPosY,
                               GetSnapWidth( fSizeX ),
                               GetSnapHeight( fSizeY ),
                               SWP_MOVE or SWP_SIZE or SWP_ACTIVATE or SWP_SHOW );
end; // InitWindow

function tDiveWindow.GetColours: Longint;
begin
  GetColours := 1 shl fColorBits;
end;

destructor tDiveWindow.Destroy;
begin
  Stopping := True;
  DosWaitThread ( tidBlitThread, DCWW_WAIT );

  WinSetVisibleRegionNotify ( hwndClient, FALSE );

  DiveFreeImageBuffer( hDive, fImage );
  DiveClose( hDive );

  DosWaitThread ( tidTimer, DCWW_WAIT );
  DosCloseEventSem( TimerEvent );
  WinDestroyWindow ( hwndFrame );
end; // Destroy

procedure tDiveWindow.Run;
var
  q_msg : QMSG;
begin
  while WinGetMsg ( h_ab, q_msg, 0, 0, 0 ) do
    WinDispatchMsg ( h_ab, q_msg );
end;

procedure tDiveWindow.SetStatistics( b: Boolean);
begin
  if b and not fStatistics then
    // Save current window title
    ;
  if not b and Statistics then
    // Restore window title
    ;
  fStatistics := b;
end;

function tDiveWindow.GetPixel(x,y: Longint): Longint;
begin
  {$IFOPT R+}
  if ( x < 0 ) or ( x >= xSize ) or
     ( y < 0 ) or ( y >= ySize ) then
    raise EDive.Create( 'Pixel coordinates out of range' );
  {$ENDIF}
  Result := DisplayBuf^[x+y*xSize];
end;

procedure tDiveWindow.SetPixel(x,y: Longint; Value: Longint);
begin
  if ( x < 0 ) or ( x >= xSize ) or
     ( y < 0 ) or ( y >= ySize ) then
  {$IFOPT R+}
    raise EDive.Create( 'Pixel coordinates out of range' );
  {$ELSE}
    Exit;  // Just ignore error
  {$ENDIF}
  DisplayBuf^[x+y*xSize] := Value;
end;

{$Frame-} {$Uses ebx}
procedure Swap( var a,b: Longint );
{var
  h : Longint;
begin
  h := a;
  a := b;
  b := h;}
asm
  mov eax,a
  mov ebx,b
  mov ecx,[eax]     // Value of a
  mov edx,[ebx]     // Value of b
  mov [eax],edx
  mov [ebx],ecx
end;

type
 fix = record case boolean of            (* 32Bit Fixed-Point number *)
          true:(fix:longint);
          false:(f:SmallWord;i:SmallInt);
        end;

procedure tDiveWindow.DrawLine( x1,y1, x2,y2, c: Longint );
var
  dyDdx,dxDdy,sy,sx:fix;
  dy,dx,h: integer;
  s: String;

begin
  dY := Abs( y2-y1 );
  dX := Abs( x2-x1 );
  if dY = 0 then
    begin  // Horizontal line
      if x2 < x1 then
        Swap( x1, x2 );
      x1 := min( xsize-1, max( x1, 0 ) );
      x2 := max( 0, min( x2, xSize-1 ) );
      If ( y1 < 0 ) or ( y1 >= ySize ) then
      {$IFOPT R+}
        Raise EDiveDraw.Create( 'Invalid Y specified to DrawLine' );
      {$ELSE}
        Exit;  // Ignore error
      {$ENDIF}
      Fillchar( DisplayBuf^[y1*xSize+x1],x2-x1+1,c)
    end
  else
    if dX > dY then
      begin
        if x2 < x1 then
          begin
            Swap( x1, x2 );
            Swap( y1, y2 );
          end;
        Pixels[ x1, y1 ] := c;
        if dX <> 0 then
          begin
            sy.i := y1;
            sy.f := $8000;
            dyDdx.i := y2-y1;
            dyDdx.f := 0;
            dyDdx.fix := dyDdx.fix div dX;
            while x1 < x2-1 do
              begin
                Inc( x1 );
                Inc( sy.fix, dyDdx.fix );
                Pixels[ x1, sy.i ] := c;
              end;
            Pixels[ x2, y2 ] := c;
          end;
      end // dX > dY
    else
      begin
        if y2<y1 then
          begin
            Swap( x1, x2 );
            Swap( y1, y2 );
          end;
        Pixels[ x1, y1 ] := c;
        if dY <> 0 then
          begin
            sx.i:= x1;
            sx.f:= $8000;
            dxDdy.i := x2-x1;
            dxDdy.f := 0;
            dxDdy.fix := dxDdy.fix div dY;
            while y1 < y2-1 do
              begin
                Inc( y1 );
                Inc( sx.fix, dxDdy.fix );
                Pixels[ sx.i, y1 ] := c;
              end;
            Pixels[ x2, y2 ] := c;
          end; { Ende mehr als ein Punkt }
      end; // dY > dX
end; // DrawLine

procedure tDiveWindow.DrawBox( x1,y1, x2,y2, c: Longint );
var
  p1, p2, p3, p4 : Pixel;
begin
  p1.x := x1; p1.y := y1;
  p2.x := x2; p2.y := y2;
  p3.x := x1; p3.y := y2;
  p4.x := x2; p4.y := y1;
  DrawQuad( p1, p2, p3, p4, c );
end; // Drawbox

procedure tDiveWindow.DrawTriangle(p1,p2,p3:pixel;c:integer);

var x21,x31,x32,
    y21,y31,y32:integer;
    ex,
    e1x,
    edx,
    e1dx:fix;
    N: longint;

begin
  if LineMode then
    begin
      DrawLine( p1.x, p1.y, p2.x, p2.y, c); // Only edges
      DrawLine( p2.x, p2.y, p3.x, p3.y, c);
      DrawLine( p3.x, p3.y, p1.x, p1.y, c);
    end
  else
    begin
      // Make sure p1y <= p2y <= p3y
      if p1.y > p2.y then Swap( longint(p1), longint(p2) );
      if p1.y > p3.y then Swap( longint(p1), longint(p3) );
      if p2.y > p3.y then Swap( longint(p2), longint(p3) );

      y31 := p3.y - p1.y;                         // Length of longest edge
      if y31 <> 0 then
        begin                                     // No horizontal line?
          y21 := p2.y - p1.y;                     // Short edges
          x21 := p2.x - p1.x;
          x31 := p3.x - p1.x;
          N := y21*x31 - y31*x21;
          Pixels[ p1.x, p1.y ] := c;              // Uppermost pixel
          Inc( p1.y );
          ex.i := p1.x; ex.f := $8000;            // Start value for x
          edx.i := x31; edx.f := 0;
          edx.fix := edx.fix div y31;
          if y21 <> 0 then
            begin                                 // p1-p2 not horizontal
              e1x.fix := ex.fix;
              e1dx.i := x21; e1dx.f := 0;
              e1dx.fix := e1dx.fix div y21;
              while p1.y < p2.y do
                begin                             // All lines between p1y and p2y
                  Inc( ex.fix,edx.fix);
                  Inc( e1x.fix,e1dx.fix);
                  DrawLine( ex.i, p1.y, e1x.i, p1.y, c);
                  Inc( p1.y );
                end;
              Inc( ex.fix, edx.fix );
            end; // y21 <> 0

          p1.y := p2.y;

          Pixels[ ex.i, p1.y ] := c;
          Pixels[ p2.x, p2.y ] := c;

          DrawLine( ex.i, p1.y, p2.x, p1.y, c );
          Inc( p1.y );

          y32 := p3.y - p2.y;
          if y32 <> 0 then
            begin
              x32 := p3.x - p2.x;
              e1x.i := p2.x; e1x.f := $8000;
              e1dx.i := x32; e1dx.f := 0;
              e1dx.fix := e1dx.fix div y32;
              while p1.y < p3.y do
                begin
                  Inc( ex.fix, edx.fix );
                  Inc( e1x.fix, e1dx.fix );
                  DrawLine( ex.i, p1.y, e1x.i, p1.y, c );
                  Inc(p1.y);
                end;
            end; // y32 <> 0
          Pixels[ p3.x, p3.y ] := c;

        end // y31 <> 0
      else
        DrawLine( p1.x, p1.y, p3.x, p3.y, c );
    end; // Not linemode
end; // DrawTriangle

procedure tDiveWindow.DrawQuad( p1,p2,p3,p4: Pixel; c: Longint );
var
  l1,l2,l1dx,l2dx:fix;
  under1,under2:boolean;

  Procedure AssignLine(var p1,p2:pixel;var l,ldx:fix);
  var
    dX,dY: Integer;
  begin
    dX := p2.x-p1.x;
    dY := p2.y-p1.y;
    l.i := p1.x;
    l.f := $8000;
    ldx.i := dX;
    ldx.f := 0;
    ldx.fix := ldx.fix div dY;
  end;

  Procedure FillBetweenLines(y,ymax:integer);
  begin
    while y<=ymax do
      begin
        inc( l1.fix, l1dx.fix );
        inc( l2.fix, l2dx.fix );
        DrawLine( l1.i,y, l2.i,y, c );
        Inc( y );
      end;
  end;

begin
  // Make sure that p1y<=p2y<=p3y<=p4y
  if p1.y > p2.y then Swap( Longint( p1 ), Longint( p2 ) );
  if p1.y > p3.y then Swap( Longint( p1 ), Longint( p3 ) );
  if p1.y > p4.y then Swap( Longint( p1 ), Longint( p4 ) );
  if p2.y > p3.y then Swap( Longint( p2 ), Longint( p3 ) );
  if p2.y > p4.y then Swap( Longint( p2 ), Longint( p4 ) );
  if p3.y > p4.y then Swap( Longint( p3 ), Longint( p4 ) );

  if p4.y <> p1.y then
    begin
      if p3.y <> p1.y then
        begin
          if p1.x = p3.x then
            begin
              under1 := p2.x < p1.x;
              under2 := p4.x < p1.x;
            end
          else
            begin
              under1:=p3.y-p2.y<(longint(p3.x-p2.x)*(p3.y-p1.y)) div (p3.x-p1.x);
              under2:=p3.y-p4.y<(longint(p3.x-p4.x)*(p3.y-p1.y)) div (p3.x-p1.x);
            end;

          Pixels[ p1.x, p1.y ] := c;
          if under1 xor under2 then
            begin
              if LineMode then
                begin
                  DrawLine( p1.x, p1.y, p2.x, p2.y, c );
                  DrawLine( p2.x, p2.y, p3.x, p3.y, c );
                  DrawLine( p3.x, p3.y, p4.x, p4.y, c );
                  DrawLine( p4.x, p4.y, p1.x, p1.y, c );
                end
              else
                begin
                  AssignLine( p1, p4, l1, l1dx );
                  if p1.y = p2.y then
                    DrawLine( p1.x, p1.y, p2.x, p1.y, c)
                  else
                    begin
                      AssignLine( p1, p2, l2, l2dx );
                      FillBetweenLines( p1.y+1, p2.y );
                    end;
                  if p2.y <> p3.y then
                    begin
                      AssignLine( p2, p3, l2, l2dx );
                      FillBetweenLines( p2.y+1, p3.y );
                    end;
                  if p3.y <> p4.y then
                    begin
                      AssignLine( p3, p4, l2, l2dx );
                      FillBetweenLines( p3.y+1, p4.y );
                    end;
                end;
            end
          else
            begin
              if LineMode then
                begin
                  DrawLine( p1.x, p1.y, p2.x, p2.y, c );
                  DrawLine( p2.x, p2.y, p4.x, p4.y, c );
                  DrawLine( p4.x, p4.y, p3.x, p3.y, c );
                  DrawLine( p3.x, p3.y, p1.x, p1.y, c );
                end
              else
                begin
                  AssignLine(p1,p3,l1,l1dx);
                  if p1.y = p2.y then
                    DrawLine( p1.x, p1.y, p2.x, p1.y, c)
                  else
                    begin
                      AssignLine( p1, p2, l2, l2dx );
                      FillBetweenLines( p1.y+1, p2.y );
                    end;
                  if p2.y <> p4.y then
                    begin
                      AssignLine( p2, p4, l2, l2dx );
                      if p2.y <> p3.y then
                        FillBetweenLines( p2.y+1, p3.y );
                      if p3.y <> p4.y then
                        begin
                          AssignLine( p3, p4, l1, l1dx );
                          FillBetweenLines( p3.y+1, p4.y );
                        end;
                    end;
                end;
            end;
        end
      else
        begin
          DrawLine( p1.x, p1.y, p2.x, p1.y, c );
          DrawLine( p1.x, p1.y, p3.x, p1.y, c );
          AssignLine( p2, p4, l1, l1dx );
          AssignLine( p3, p4, l2, l2dx );
          FillBetweenLines( p3.y+1, p4.y );
        end;
    end
  else
    begin
      DrawLine(p1.x, p1.y, p2.x, p1.y, c);
      DrawLine(p1.x, p1.y, p3.x, p1.y, c);
      DrawLine(p1.x, p1.y, p4.x, p1.y, c);
    end;
end;  // DrawQuad

{$I FONT8x8.PAS}   // Contains simple 8x8 bitmapped font

Procedure tDiveWindow.DrawStr( x, y, col, BackCol: Integer; s: String );
type
  Fontbuff = array[0..32000] of byte;
var
  line,spos,bit,bpos:integer;
  b: Integer;
  LineBuffer : array[0..640] of byte;
  ScrAddr:integer;

begin
  ScrAddr:=y*xSize+x;
  for Line := 0 to 7 do
    begin
      bpos := ScrAddr;
      for spos := 1 to length(s) do
        begin
          b := ord(s[spos]) shl 3+line;
          for bit := 7 downto 0 do
            begin
              if Boolean((Font8x8[b] shr bit) and 1) then
                DisplayBuf^[bpos] := Col
              else
                if BackCol >= 0 then
                  DisplayBuf^[bpos] := backCol;
              inc(bpos);
            end;
        end;
      Inc(ScrAddr,xSize);
    end;
end; // DrawStr

Procedure tDiveWindow.DrawArc( Center: Pixel; Rad, StAngle, EndAngle, Col: Integer );
var
  i : Integer;
  x,y: Integer;
begin
  If StAngle > EndAngle then Swap( StAngle, EndAngle );
  If LineMode or ( StAngle <> 0 ) or (EndAngle <> 360 ) then
    For i := StAngle*4 to EndAngle*4 do
      Pixels[ Center.x+(tCos[i]*Rad) div 1024, Center.y+(tSin[i]*Rad) div 1024] := Col
  else
    begin
      // Draw full filled circle
      For i := 90*4 to 270*4 do
        begin
          y := Center.y+(tSin[i]*Rad) div 1024;
          x := (tCos[i]*Rad) div 1024;
          DrawLine( Center.x-x, y, Center.x+x, y, Col );
        end;
    end;
end; // DrawArc

Procedure tDiveWindow.DrawPieSlice( Center: Pixel; Rad, StAngle, EndAngle, Col: Integer );
var
  i : Integer;
  x,y: Integer;
  sx,cx: Integer;
  x1,y1,x2,y2: Integer;
  l2dy: Double;
  l1dy: Double;
  a1, a2: Integer;
begin
  If StAngle <> 360 then
    StAngle := StAngle mod 360;
  If EndAngle <> 360 then
    EndAngle := EndAngle mod 360;
  If StAngle > EndAngle then Swap( StAngle, EndAngle );
  If LineMode then
    // Outline
    For i := StAngle*4 to EndAngle*4 do
      begin
        y := Center.y+(tSin[i]*Rad) div 1024;
        x := Center.x+(tCos[i]*Rad) div 1024;
        If (i<>StAngle*4) and (i<>EndAngle*4) then
          Pixels[ x, y ] := Col
        else
          DrawLine( Center.x, Center.y, x, y, Col )
      end
  else
    // Fill slice
    begin
      // Divide into one call per quadrant
      for i := 0 to 3 do
        if ( StAngle < i*90 ) and ( EndAngle > i*90 ) then
          begin
            DrawPieSlice( Center, Rad, StAngle, i*90, Col );
            DrawPieSlice( Center, Rad, i*90, EndAngle, Col );
            Exit;
          end;
      x1 := tCos[StAngle*4];  y1 := tSin[StAngle*4];
      x2 := tCos[EndAngle*4]; y2 := tSin[EndAngle*4];
      If StAngle = EndAngle then
        begin
          DrawLine( Center.x, Center.y,
                    Center.x+(x1*Rad) div 1024, Center.y+(y1*Rad) div 1024, Col );
          Exit;
        end;
      if y2 <> 0 then
        l2dy := x2/y2
      else l2dy := 0;
      if y1 <> 0 then
        l1dy := x1/y1
      else l1dy := 0;
      For i := StAngle*4 to EndAngle*4 do
        begin
          x := Center.x+(tCos[i]*Rad) div 1024;
          y := Center.y+(tSin[i]*Rad) div 1024;
          if ( l2dy >= 0 ) and ( l1dy >= 0 ) then
            begin
              // 1st, 3rd Quadrant
              sx := Round(l2dy*(y-Center.y)+Center.x);
              DrawLine( sx, y, x, y, Col );
            end
          else
            begin
              // 2nd, 4th Quadrant
              cx := Round(l1dy*(y-Center.y)+Center.x);
              DrawLine( x, y, cx, y, Col );
            end;
        end;
      If ( l1dy >= 0 ) and ( l2dy >= 0 ) then
        begin
          a2 := StAngle*4;
          If StAngle < 90 then
            a1 := 0       // 1st Quadrant
          else
            a1 := 180*4;  // 3rd Quadrant
        end
      else
        begin
          a1 := EndAngle*4;
          If StAngle <= 180 then
            a2 := 180*4   // 2nd Quadrant
          else
            a2 := 360*4;  // 4rd Quadrant
        end;

      For i := a1 to a2 do
        begin
          y := Center.y+(tSin[i]*Rad) div 1024;
          x := Center.x+(tCos[i]*Rad) div 1024;
          sx := Round(l2dy*(y-Center.y)+Center.x);
          cx := Round(l1dy*(y-Center.y)+Center.x);
          DrawLine( sx, y, cx, y, Col );
        end;
    end;
end; // DrawPieSlice

Procedure tDiveWindow.Flip( Steps: Longint );
var
  Lines: Integer;
  CopyLine: Double;
  LinesLeft: Integer;
  CurrLine: Integer;
  BankNum : Integer;
  Half: Integer;
  Step: Double;
  Buffer: Pointer;
  p: Pointer;
  Shrink,v: Double;

begin
  GetMem( Buffer, xSize*ySize );
  try
    BankNum := 0;
    DiveSwitchBank( hDive, BankNum );
    p := DisplayBuf;
    for Lines := 0 to ySize-1 do
      begin
        move( p^, (Pchar( Buffer ) + Lines*xSize)^, xSize );
        Inc( pChar(p), xSize );
      end;
    Inc( BankNum );
    DiveSwitchBank( hDive, BankNum );

    Half := ySize div 2;
    Step := 3.14/Steps;
    v := 0;
    Repeat
      if v+Step < 3.14 then
        Shrink := 1/cos(v)
      else
        Shrink := -1;
      BankNum := 0;
      DiveSwitchBank( hDive, BankNum );
      p := DisplayBuf;
      CurrLine := Half;
      LinesLeft := ySize;
      For Lines := 0 to ySize-1 do
        begin
          CopyLine := Half - CurrLine*Shrink;
          If ( CopyLine >= 0 ) and ( CopyLine < ySize ) then
            move( (pChar(Buffer) + Round(CopyLine)*xSize)^, p^, xSize )
          else
            FillChar( p^, xSize, 0 );
          Dec( CurrLine );
          Inc( pChar(p), xSize );
          Dec( LinesLeft );
          If LinesLeft = 0 then
            begin
              LinesLeft := ySize;
              p := DisplayBuf;
              Inc( BankNum );
              DiveSwitchBank( hDive, BankNum );
              DiveBlitImage ( hDive,
                              fImage,
                              Dive_Buffer_Screen );
            end;
        end;

      v := v + Step;
    Until v > 3.14;
  finally
    FreeMem( Buffer, xSize*ySize );
  end;
end;

var
  i : Integer;

initialization  // Set up Sine and Cosine tables
  for i := 0 to 4*360 do
    begin
      tSin[i] := Round(Sin(i*pi/(4*180.0))*1024);
      tCos[i] := Round(Cos(i*pi/(4*180.0))*1024);
    end;
end.
