home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vpbgib2.zip / DGRAPH.PAS < prev    next >
Pascal/Delphi Source File  |  1996-11-02  |  67KB  |  2,456 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Run-time Library v1.1             █}
  4. {█      BGI Graphics unit for PM applications            █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1996 fPrint UK Ltd                 █}
  7. {█      Written May-July 1996 by Allan Mertner           █}
  8. {█        Inspired by DIVERace by Michael Mrosowski      █}
  9. {█                                                       █}
  10. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  11.  
  12. Unit dGraph;
  13.  
  14. Interface
  15.  
  16. {$Delphi+}
  17.  
  18. Uses
  19.   Use32, Os2Def, Os2Base, Os2PmApi, Strings, SysUtils, VPUtils;
  20.  
  21. type
  22.   EGraph = class(Exception);
  23.   Str12 = String[12];
  24.  
  25. Const
  26.   x_Size : Longint = 640;
  27.   y_Size : Longint = 480;
  28.   WindowTitle : string = 'BGI Window';
  29.  
  30.   grOk                =  0;  // error status values reported by graphresult }
  31.   grNoInitGraph       = -1;  // BGI graphics not installed
  32.   grNotDetected       = -2;  // Graphics hardware not detected
  33.   grFileNotFound      = -3;  // Device driver file not found
  34.   grInvalidDriver     = -4;  // Invalid device driver file
  35.   grNoLoadMem         = -5;  // Not enough memory to load driver
  36.   grNoScanMem         = -6;  // Out of memory in scan fill
  37.   grNoFloodMem        = -7;  // Out of memory in flood fill
  38.   grFontNotFound      = -8;  // Font file not found
  39.   grNoFontMem         = -9;  // Not enough memory to load font
  40.   grInvalidMode       = -10; // Invalid graphics mode for selected driver
  41.   grError             = -11; // Graphics error (generic error)
  42.   grIOerror           = -12; // Graphics I/O error
  43.   grInvalidFont       = -13; // Invalid font file
  44.   grInvalidFontNum    = -14; // Invalid font number
  45.  
  46.   Detect              = 0;
  47.   Black               = 0;       { Colour values }
  48.   Blue                = 1;
  49.   Green               = 2;
  50.   Cyan                = 3;
  51.   Red                 = 4;
  52.   Magenta             = 5;
  53.   Brown               = 6;
  54.   LightGray           = 7;
  55.   DarkGray            = 8;
  56.   LightBlue           = 9;
  57.   LightGreen          = 10;
  58.   LightCyan           = 11;
  59.   LightRed            = 12;
  60.   LightMagenta        = 13;
  61.   Yellow              = 14;
  62.   White               = 15;
  63.   EGA_Black           = 0;        { different than DOS BGI values }
  64.   EGA_Blue            = 1;
  65.   EGA_Green           = 2;
  66.   EGA_Cyan            = 3;
  67.   EGA_Red             = 4;
  68.   EGA_Magenta         = 5;
  69.   EGA_Brown           = 6;
  70.   EGA_LightGray       = 7;
  71.   EGA_DarkGray        = 8;
  72.   EGA_LightBlue       = 9;
  73.   EGA_LightGreen      = 10;
  74.   EGA_LightCyan       = 11;
  75.   EGA_LightRed        = 12;
  76.   EGA_LightMagenta    = 13;
  77.   EGA_Yello           = 14;
  78.   EGA_White           = 15;
  79.  
  80.   NormWidth           = 1;         { constants for line thickness }
  81.   ThickWidth          = 3;
  82.  
  83.   SolidLn             = 0;         { constants for line patterns }
  84.   DottedLn            = 1;
  85.   CenterLn            = 2;
  86.   DashedLn            = 3;
  87.   UserBitLn           = 4;
  88.  
  89.   DefaultFont         = 0;         { font constants for settextstyle }
  90.   TriplexFont         = 1;
  91.   SmallFont           = 2;
  92.   SansSerifFont       = 3;
  93.   GothicFont          = 4;
  94.   ScriptFont          = 5;
  95.   SimplexFont         = 6;
  96.   TriplexScrFont      = 7;
  97.   ComplexFont         = 8;
  98.   EuropeanFont        = 9;
  99.   BoldFont            = 10;
  100.   FontNames : Array[0..10] of Str12
  101.             = ( 'Default', 'TRIP.CHR', 'LITT.CHR', 'SANS.CHR', 'GOTH.CHR', 'SCRI.CHR',
  102.                 'SIMP.CHR', 'TSCR.CHR', 'LCOM.CHR', 'EURO.CHR', 'BOLD.CHR' );
  103.  
  104.   HorizDir            =  0;
  105.   VertDir             =  90;
  106.   UserCharSize        =  0;
  107.  
  108.   ClipOn              =  True;
  109.   ClipOff             =  False;
  110.  
  111.   TopOn               =  True;
  112.   TopOff              =  False;
  113.  
  114.   EmptyFill           = 0;         { fill patterns }
  115.   SolidFill           = 1;
  116.   LineFill            = 2;
  117.   LtSlashFill         = 3;
  118.   SlashFill           = 4;
  119.   BkSlashFill         = 5;
  120.   LtBkSlashFill       = 6;
  121.   HatchFill           = 7;
  122.   XHatchFill          = 8;
  123.   InterleaveFill      = 9;
  124.   WideDotFill         = 10;
  125.   CloseDotFill        = 11;
  126.   UserFill            = 12;
  127.  
  128.   NormalPut           = 0;      { operators for image blits and setwritemode }
  129.   CopyPut             = 0;
  130.   XORPut              = 1;
  131.   OrPut               = 2;
  132.   AndPut              = 3;
  133.   NotPut              = 4;
  134.  
  135.   LeftText            = 0;      { text justification constants }
  136.   CenterText          = 1;
  137.   RightText           = 2;
  138.   BottomText          = 0;
  139.   TopText             = 2;
  140.  
  141.   MaxColors           = 255;    // Different from DOS
  142.  
  143.   LinePatterns        : Array[0..3] of Word
  144.                       = ( $FFFFFFFF, $33333333, $3CCF3CCF, $0F0F0F0F );
  145.  
  146. type
  147.   str4 = String[4];
  148.   FillPatternType       = array [1..8] of Byte;
  149.   NewPatternType        = array [0..15] of SmallWord;
  150.   IntArray              = array [0..65000] of Integer;
  151.  
  152.   PaletteType           = record
  153.                             Size    : word;
  154.                             Colors  : array[0..MaxColors] of Byte;
  155.                           end;
  156.  
  157.   LineSettingsType      = record
  158.                             LineStyle : Word;
  159.                             Pattern   : Word;
  160.                             Thickness : Word;
  161.                           end;
  162.  
  163.   TextSettingsType      = record
  164.                             Font      : Word;
  165.                             Direction : Word;
  166.                             CharSize  : Integer;      { different than DOS BGI }
  167.                             Horiz     : Word;
  168.                             Vert      : Word;
  169.                             userxscale: double;
  170.                             useryscale: double;
  171.                           end;
  172.  
  173.   FillSettingsType      = record
  174.                             Pattern   : Word;
  175.                             Color     : Word;
  176.                           end;
  177.  
  178.   PointType             = record
  179.                             X         : Integer;
  180.                             Y         : Integer;
  181.                           end;
  182.   PointArray = Array[0..65000] of PointType;
  183.  
  184.   ViewPortType          = record
  185.                             X1        : Integer;
  186.                             Y1        : Integer;
  187.                             X2        : Integer;
  188.                             Y2        : Integer;
  189.                             Clip      : Boolean;
  190.                           end;
  191.  
  192.   ArcCoordsType         = record
  193.                             X         : Integer;
  194.                             Y         : Integer;
  195.                             Xstart    : Integer;
  196.                             Ystart    : Integer;
  197.                             Xend      : Integer;
  198.                             Yend      : Integer;
  199.                           end;
  200.  
  201.   MouseEventT =
  202.     ( mb1Click, mb1DblClick, mb1BeginDrag, mb1EndDrag, mb1Down, mb1Up,
  203.       mb2Click, mb2DblClick, mb2BeginDrag, mb2EndDrag, mb2Down, mb2Up );
  204.  
  205.   MouseEventRecT = record
  206.     Event : MouseEventT;
  207.     X,Y   : Word;
  208.   end;
  209.  
  210. // VP replacement routines for Crt
  211. procedure Delay(MS: Longint);
  212. function  KeyPressed: Boolean;
  213. function  ReadKey: Char;
  214. function  AltPressed: Boolean;
  215. function  ShiftPressed: Boolean;
  216. function  CtrlPressed: Boolean;
  217. procedure WaitDraw;
  218.  
  219. // VP mouse functions
  220. procedure GetMousePos( var x,y: Word );
  221. function  ReadKeyOrMouse( TimeOut: Word; var Mouse: Boolean;
  222.   var Key: Char; var MEvent: MouseEventT; var mx, my: Word ): Boolean;
  223. function MouseClicked: Boolean;
  224. procedure GetMouseEvent( var M: MouseEventRecT );
  225.  
  226. { BGI Function Prototypes }
  227.  
  228. Procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  229. Procedure Bar(X1, Y1, X2, Y2: Integer);
  230. Procedure Bar3D(X1, Y1, X2, Y2: Integer; Depth: Word; Top: Boolean);
  231. Procedure Circle(X, Y: Integer; Radius: Word);
  232. Procedure ClearDevice;
  233. Procedure ClearViewport;
  234. Procedure CloseGraph;
  235. procedure DetectGraph(var GraphDriver, GraphMode: Integer);
  236. Procedure DrawPoly(NumPoints: Word; var PolyPoints);
  237. Procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius: Word);
  238. Procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  239. Procedure FillPoly(NumPoints: Word; var PolyPoints);
  240. Procedure FloodFill(X, Y: Integer; Border: Word);
  241. Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  242. Procedure GetAspectRatio(var Xasp, Yasp: Word);
  243. Function  GetBkColor: Word;
  244. Function  GetColor: Word;
  245. Procedure GetDefaultPalette(var Palette: PaletteType);
  246. Function  GetDriverName: string;
  247. Procedure GetFillPattern(var FillPattern: FillPatternType);
  248. Procedure GetFillSettings(var FillInfo: FillSettingsType);
  249. function  GetGraphMode: Integer;
  250. procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
  251. Procedure GetLineSettings(var LineInfo: LineSettingsType);
  252. Function  GetMaxColor: Word;
  253. Function  GetMaxX: Word;
  254. Function  GetMaxY: Word;
  255. Function  GetModeName(ModeNumber: Integer): string;
  256. Procedure GetPalette(var Palette: PaletteType);
  257. Function  GetPaletteSize: Integer;
  258. Function  GetPixel(X,Y: Integer): Word;
  259. Procedure GetTextSettings(var TextInfo: TextSettingsType);
  260. Procedure GetViewSettings(var ThisViewPort: ViewPortType);
  261. Function  GetX: Integer;
  262. Function  GetY: Integer;
  263. Procedure GraphDefaults;
  264. Function  GraphErrorMsg(ErrorCode: Integer): String;
  265. Function  GraphResult: Integer;
  266. function  ImageSize(x1, y1, x2, y2: Integer): Word;
  267. procedure InitGraph(var GraphDriver:Integer; var GraphMode: Integer;
  268.     PathToDriver: string);
  269. Function  InstallUserFont(FontFileName: string) : Integer;
  270. Procedure Line(X1, Y1, X2, Y2: Integer);
  271. Procedure LineRel(Dx, Dy: Integer);
  272. Procedure LineTo(X, Y: Integer);
  273. Procedure MoveRel(Dx, Dy: Integer);
  274. Procedure MoveTo(X, Y: Integer);
  275. Procedure OutText(TextString: string);
  276. Procedure OutTextXY(X, Y: Integer; TextString: string);
  277. Procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  278. procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
  279. Procedure PutPixel(X, Y: Integer; Color: Word);
  280. Procedure Rectangle(X1, Y1, X2, Y2: Integer);
  281. Procedure RegisterBGIFont(FontID: Integer; Font: Pointer);
  282. Procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
  283. Procedure SetAllPalette(var Palette: PaletteType);
  284. Procedure SetAspectRatio(Xasp, Yasp: Word);
  285. Procedure SetBkColor(ColorNum: Word);
  286. Procedure SetColor(Color: Word);
  287. Procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
  288. Procedure SetFillStyle(Pattern: Word; Color: Word);
  289. Procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
  290. Procedure SetPalette(ColorNum: Word; Color: Byte);
  291. Procedure SetRGBPalette(ColorNum: Word; Red, Green, Blue: Byte);
  292. Procedure SetTextJustify(Horiz, Vert: Word);
  293. Procedure SetTextStyle(Font, Direction, CharSize: Integer);
  294. Procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
  295. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  296. Procedure SetWriteMode(WriteMode: Integer);
  297. Function  TextHeight(TextString: string): Word;
  298. Function  TextWidth(TextString: string): Word;
  299.  
  300. // VP additional BGI functions
  301. procedure SetWideFillPattern(Pattern: NewPatternType; Color: Word);
  302. procedure VPInitGraph( xRes, yRes: Integer; PathToDriver: string);
  303.  
  304. // Blitter control functions
  305. procedure SuspendRefresh;   // Suspend refreshing of screen
  306. procedure EnableRefresh;    // Enable refreshing of screen
  307. procedure AcceleratedBlit;  // Enable faster blitting routine (Only updated DIVE.DLL)
  308. procedure SlowBlit;         // Enable slow blitting routine
  309.  
  310. // Constants modifying behavious of Graph
  311. const
  312.   WaitKeypressed : Boolean = True;  // Delay() when calling keypressed
  313.   CurrentMouseX  : Word = 0;
  314.   CurrentMouseY  : Word = 0;
  315.   MouseMoved     : Boolean = False;
  316.  
  317. {$IFDEF DEBUG}
  318. procedure log( s: String );
  319. {$ENDIF}
  320.  
  321. Implementation
  322.  
  323. uses
  324.   Os2Dive, Mutex;
  325.  
  326. {$IFDEF DEBUG}
  327. procedure log( s: String );
  328. begin
  329.   os2dive.log(s);
  330. end;
  331. {$ENDIF}
  332.  
  333. const
  334.   MaxFonts = 20;
  335.   FontScale: Array[ 1..10 ] of Double
  336.            = ( 0.60, 0.66, 0.75, 1.0, 1.33, 1.66, 2.0, 2.5, 3.0, 4.0);
  337.  
  338. type
  339.   tFont = record
  340.     FirstChar: Char;
  341.     Chars: Byte;
  342.     LastChar: Char;
  343.     Org_To_Top : smallint;
  344.     Org_To_Base : smallint;
  345.     Org_To_Dec  : smallint;
  346.     CharIndex: Array[0..255] of SmallWord;
  347.     CharWidth: Array[0..255] of Byte;
  348.     ChDataMem: Integer;
  349.     CharData: Pointer;
  350.     FontName: String;
  351.     Linked: Boolean;
  352.   end;
  353.   tGraphWindow = class( tDiveWindow )
  354.   private
  355.     Position  : PointType;    // Current position
  356.     FgColor   : Longint;      // Background color
  357.     BkColor   : Longint;      // Background color
  358.     TxtHoriz  : Byte;         // Horizontal text alignment
  359.     TxtVert   : Byte;         // Vertical text alignment
  360.     TxtDir    : Integer;      // Txt angle
  361.     FntSel    : Integer;      // Currently selected font
  362.     xScale    : Double;       // Txt Scaling factor
  363.     yScale    : Double;       // Txt Scaling factor
  364.     UserxScale: Double;       // User Txt Scaling factor (CharSz = 0)
  365.     UseryScale: Double;       // User Txt Scaling factor (CharSz = 0)
  366.     CharSz    : Integer;
  367.     PalInfo   : PaletteType;
  368.     LineInfo  : LineSettingsType;
  369.     FillInfo  : FillSettingsType;
  370.     WriteMode : Integer;      // Write mode (or, xor, etc)
  371.   public
  372.     constructor Create( SizeX, SizeY: Longint; ColorBits: Byte; WindowTitle:string );
  373.   end;
  374.  
  375.   tBGI = record
  376.     Fonts: 0..MaxFonts;
  377.     Font: Array[0..MaxFonts] of tFont;
  378.     PathToFont: String[80];
  379.     LastError : Longint;      // Last error
  380.     DW : tGraphWindow;
  381.   end;
  382.  
  383. // State variables
  384. var
  385.   BGI : tBGI;
  386.   GrStatus: Integer;
  387.   SaveExit: Pointer;     // After InitGraph, contains ExitProc
  388.   tidMessage : Integer;  // Thread ID of message handling loop
  389.   mtx_Mou : tMutexSem;
  390.   mtx_Kbd : tMutexSem;
  391.  
  392. constructor tGraphWindow.Create( SizeX, SizeY: Longint; ColorBits: Byte ;WindowTitle:String);
  393. begin
  394.   Inherited Create( SizeX, SizeY, ColorBits{, WindowTitle});
  395.   VPClip := False;
  396.   inherited SetViewPort( 0, 0, SizeX-1, SizeY-1 );
  397.   FgColor := White;
  398.   BkColor := Black;
  399.   xScale := 1;
  400.   yScale := 1;
  401.   UserxScale := 1;
  402.   UseryScale := 1;
  403.   CharSz := 1;
  404.   TxtDir := 0;
  405.   TxtHoriz := LeftText;
  406.   TxtVert := TopText;
  407.   FntSel := DefaultFont;
  408.   PalInfo.Size := Colours;  // Ask DIVE for color count
  409.   GetDefaultPalette( PalInfo );
  410.   LineInfo.LineStyle := SolidLn;
  411.   LineInfo.Thickness := NormWidth;
  412.   LineInfo.Pattern := $FFFF;
  413.   FillInfo.Color:=White;
  414.   FillInfo.Pattern:= SolidFill;
  415.   SetLineThickness( LineInfo.Thickness );
  416.   xAspect := 10000;
  417.   yAspect := xAspect;  // Default 1:1 aspect ratio
  418.   WriteMode := NormalPut;
  419. end;
  420.  
  421. Procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  422. Var
  423.   Center: Pixel;
  424. begin
  425.   If Assigned( BGI.DW ) then
  426.     With BGI.DW do
  427.       begin
  428.         Center.x := x;
  429.         Center.y := y;
  430.         LineMode := True;
  431.         BeginUpdate;
  432.         DrawArc( Center, Radius, StAngle, EndAngle, FgColor );
  433.         EndUpdate;
  434.       end;
  435. end;
  436.  
  437. Procedure Bar(X1, Y1, X2, Y2: Integer);
  438. begin
  439.   If Assigned( BGI.DW ) then
  440.     with BGI.DW do
  441.     begin
  442.       BeginUpdate;
  443.       DrawFillRect( x1,y1, x2,y2, FgColor );
  444.       EndUpdate;
  445.     end;
  446. end;
  447.  
  448. Procedure Bar3D(X1, Y1, X2, Y2: Integer; Depth: Word; Top: Boolean );
  449. var
  450.   dy: Integer;
  451.   Poly: Array[1..5] of PointType;
  452. begin
  453.   If Assigned( BGI.DW ) then
  454.     with BGI.DW do
  455.       begin
  456.         BeginUpdate;
  457.         LineMode := True;
  458.         DrawFillRect( x1,y1, x2,y2, FgColor );
  459.         if Depth <> 0 then
  460.           begin
  461.             dy := (Depth*3) div 4;
  462.             DrawLine( x2,y2, x2+depth,y2-dy, FgColor );
  463.             DrawLine( x2+depth,y2-dy, x2+depth, y1-dy, FgColor );
  464.  
  465.             if top then
  466.               begin
  467.                 DrawLine( x1,y1, x1+depth,y1-dy, FgColor );
  468.                 DrawLine( x1+depth,y1-dy, x2+Depth,y1-dy, FgColor );
  469.                 DrawLine( x2+Depth,y1-dy, x2,y1, FgColor );
  470.               end;
  471.           end;
  472.         EndUpdate;
  473.       end;
  474. end;
  475.  
  476. Procedure Circle(X, Y: Integer; Radius: Word);
  477. Var
  478.   Center: Pixel;
  479. begin
  480.   If Assigned( BGI.DW ) then
  481.     with BGI.DW, LineInfo do
  482.       begin
  483.         Center.x := x;
  484.         Center.y := y;
  485.         LineMode := True;
  486.         BeginUpdate;
  487.         if LineStyle = UserBitLn then
  488.           SetLinePattern( Pattern )
  489.         else
  490.           SetLinePattern( LinePatterns[LineStyle] );
  491.         SetLineThickness( LineInfo.Thickness );
  492.         LinePutMode := WriteMode;
  493.         DrawArc( Center, Radius, 0, 360, FgColor );
  494.         EndUpdate;
  495.       end;
  496. end;
  497.  
  498. Procedure ClearDevice;
  499. begin
  500.   if Assigned( BGI.DW ) then
  501.     with BGI.DW do
  502.       begin
  503.         BeginUpdate;
  504.         Clear( BkColor );
  505.         EndUpdate;
  506.         Position.X := 0;
  507.         Position.X := 0;
  508.         FillColor := White;
  509.         FillBkColor := Black;
  510.       end;
  511. end;
  512.  
  513. Procedure ClearViewport;
  514. begin
  515.   if Assigned( BGI.DW ) then
  516.     with BGI.DW do
  517.       begin
  518.         BeginUpdate;
  519.         LineMode := False;
  520.         DrawBox( 0, 0, VPWidth, VPHeight, BkColor );
  521.         EndUpdate;
  522.         Position.X := 0;
  523.         Position.X := 0;
  524.         FillColor := White;
  525.         FillBkColor := Black;
  526.       end;
  527. end;
  528.  
  529. Procedure CloseGraph;
  530. var
  531.   timeout: Integer;
  532. begin
  533.   If Assigned( BGI.DW ) then
  534.     begin
  535.       if SaveExit <> nil then
  536.         begin
  537.           ExitProc := SaveExit;
  538.           SaveExit := nil;
  539.         end;
  540.       WinPostMsg( BGI.DW.hwndFrame, WM_CLOSE, 0, 0 );
  541.       WinPostMsg( BGI.DW.hwndFrame, ID_EXIT, 0, 0 );
  542.       timeout := 0;
  543.       if GetThreadID <> tidMessage then  // Msg handling thread should not wait!
  544.         While ( BGI.DW <> nil ) and (timeOut < 50) do
  545.           begin
  546.             DosSleep( 50 );
  547.             Inc(TimeOut );
  548.           end;
  549.     end;
  550. end;
  551.  
  552. procedure DetectGraph(var GraphDriver, GraphMode: Integer);
  553. begin
  554.   GraphDriver := 9;  // 640x480 VGA - not used
  555.   GraphMode := 2;
  556. end;
  557.  
  558. Procedure DrawPoly(NumPoints: Word; var PolyPoints);
  559. var
  560.   i : Integer;
  561.   p,q : ^PointType;
  562. begin
  563.   if Assigned( BGI.DW ) then
  564.     with BGI.DW do
  565.       begin
  566.         LinePutMode := WriteMode;
  567.         p := @PolyPoints;
  568.         q := p;
  569.         inc(q);
  570.         BeginUpdate;
  571.         for i := 0 to NumPoints-2 do
  572.           begin
  573.             DrawLine( p^.x, p^.y, q^.x, q^.y, FgColor );
  574.             inc( p );
  575.             inc( q );
  576.           end;
  577.         Position.x := p^.x;
  578.         Position.y := p^.y;
  579.         LinePutMode := NormalPut;
  580.         EndUpdate;
  581.       end;
  582. end;
  583.  
  584. Procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius: Word);
  585. Var
  586.   Center: Pixel;
  587. begin
  588.   If Assigned( BGI.DW ) then
  589.     with BGI.DW do
  590.       begin
  591.         Center.x := x;
  592.         Center.y := y;
  593.         LineMode := True;
  594.         BeginUpdate;
  595.         DrawEllipse( Center, XRadius, YRadius, StAngle, EndAngle, FgColor );
  596.         EndUpdate;
  597.       end;
  598. end;
  599.  
  600. Procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  601. Var
  602.   Center: Pixel;
  603.   v: Integer;
  604.   y1 : Integer;
  605.   x2,y2 : Integer;
  606.   row: Integer;
  607. begin
  608.   If Assigned( BGI.DW ) then
  609.     with BGI.DW do
  610.       begin
  611.         Center.x := x;
  612.         Center.y := y;
  613.         LineMode := False;
  614.         BeginUpdate;
  615.         y2 := YRadius;
  616.         for v := 90 downto 0 do  // Quarter circle
  617.           begin
  618.             y1 := y2;
  619.             x2 := (XRadius*tCos[v*4]) div 1024;
  620.             y2 := (YRadius*tSin[v*4]) div 1024;
  621.             for row := y2 to y1-1 do
  622.               If FillInfo.Pattern = SolidFill then
  623.                 begin
  624.                   DrawLine( x-x2, y+Row, x+x2, y+Row, FillInfo.Color );
  625.                   DrawLine( x-x2, y-Row, x+x2, y-Row, FillInfo.Color );
  626.                 end
  627.               else
  628.                 begin
  629.                   DrawFillLine( x-x2, x+x2, y+Row );
  630.                   DrawFillLine( x-x2, x+x2, y-Row );
  631.                 end;
  632.           end;
  633.         EndUpdate;
  634.         Ellipse( x,y, 0,360, XRadius, YRadius );
  635.       end;
  636. end;
  637.  
  638. Procedure FillPoly(NumPoints: Word; var PolyPoints);
  639. VAR
  640.   i,j,k      : Integer;
  641.   xi         : ^IntArray;
  642.   PointMem   : Integer;
  643.   InP        : ^PointArray;
  644.   ymin, ymax : Integer;
  645.   Row        : Integer;
  646.   Col        : Integer;
  647.  
  648. BEGIN
  649.   PointMem := NumPoints*Sizeof(Integer);
  650.   GetMem( xi, PointMem );
  651.   fillchar( xi^, PointMem, 0 );
  652.   InP := @PolyPoints;         // Make it easier to address points
  653.   with InP^[0] do
  654.     begin
  655.       ymin := y;
  656.       ymax := y;
  657.       moveto(x, y);
  658.     end;
  659.   for i := 1 to NumPoints-1 do
  660.     with Inp^[i] do
  661.       begin
  662.         ymin := min( y, ymin );
  663.         ymax := max( y, ymax );
  664.       end;
  665.  
  666.   with BGI.DW do
  667.     begin
  668.       BeginUpdate;
  669.       yMax := Max( 0, Min( GetMaxY-1, yMax ) );
  670.       for Row := ymin to ymax do
  671.         begin
  672.           j := 0;
  673.           for i := 1 to NumPoints-1 do
  674.             with Inp^[ pred(i) ] do
  675.               if ( (y < Row) xor ( InP^[i].y < Row ) ) then
  676.                 begin
  677.                   Col := x+(Row-y)*(x-InP^[i].x) div (y-InP^[i].y);
  678.                   k:=0;
  679.                   while ( k<>j ) and ( Col >= xi^[k] ) do
  680.                     Inc( k );
  681.                   IF k < j then
  682.                     move( xi^[k], xi^[succ(k)], (j-k)*sizeof(integer) );
  683.                   xi^[k] := Col;
  684.                   Inc( j );
  685.                 end;
  686.           for i := 0 to j-2 do
  687.             begin
  688.               DrawFillLine( xi^[i], xi^[succ(i)], Row );
  689.               if i < j then
  690.                 Inc( i );
  691.             END;
  692.         end; // For Row
  693.       EndUpdate;
  694.       FreeMem( xi, PointMem );
  695.       DrawPoly( Numpoints, PolyPoints );
  696.     end;
  697. end;
  698.  
  699. type
  700.   TXYBits = class
  701.   protected
  702.     FSizeX: Integer;
  703.     FSizeY: Integer;
  704.     FBits: Pointer;
  705.     FBytes: Integer;
  706.     constructor Create(SizeX,SizeY: Integer);
  707.   public
  708.     destructor Destroy; override;
  709.     procedure SetBits( x1, x2, y: Integer );
  710.     function BitIsSet( x,y: Integer): Boolean;
  711.     function LineHasData( y: Integer ): Boolean;
  712.   end;
  713.  
  714. const
  715.   BitsPerInt = SizeOf(Integer) * 8;
  716.  
  717. type
  718.   ByteArray = Array[0..MaxInt] of Byte;
  719.  
  720. constructor TXYBits.Create( Sizex,Sizey: Integer );
  721. begin
  722.   inherited create;
  723.   FSizeX := ((SizeX div 8)+1)*8;
  724.   FSizeY := SizeY;
  725.   FBytes := ((SizeX*SizeY + BitsPerInt - 1) div BitsPerInt) * SizeOf(Integer);
  726.   GetMem( FBits, FBytes );
  727.   Fillchar( FBits^, FBytes, 0 );
  728. end;
  729.  
  730. destructor TXYBits.Destroy;
  731. begin
  732.   FreeMem( FBits, FBytes );
  733.   inherited Destroy;
  734. end;
  735.  
  736. procedure TXYBits.SetBits( x1, x2, y: Integer ); assembler;
  737. {&USES ebx,esi,edi} {&FRAME-}
  738. const
  739.   FillFirst : Array[0..7] of Byte = ( $FF, $FE, $FC, $F8, $F0, $E0, $C0, $80 );
  740.   FillLast  : Array[0..7] of Byte = ( $01, $03, $07, $0F, $1F, $3F, $7F, $FF );
  741.  
  742. asm
  743.     mov     edx,Self
  744.     mov     edi,y
  745.     imul    edi,[edx].FSizeX
  746.     shr     edi,3                  // edi is byte offset of line #y
  747.     add     edi,[edx].FBits        // edi is address of range
  748.  
  749.     mov     esi,x1
  750.     mov     ebx,esi
  751.     and     ebx,7                  // Partial byte 1
  752.     shr     esi,3                  // Byte 1
  753.     add     edi,esi                // Destination pointer to Byte 1
  754.  
  755.     mov     ecx,x2
  756.     mov     edx,ecx
  757.     and     edx,7                  // Partial byte 2
  758.     shr     ecx,3                  // Byte 2
  759.  
  760.     cmp     ecx,esi                // Byte1 = Byte2?
  761.     je      @fillbit1
  762.     or      ebx,ebx                // Partial byte 1 > 0?
  763.     je      @fillbytes
  764.  
  765.   @fillbit1:
  766.     mov     al,byte ptr [fillfirst+ebx] // Partial byte 1 fill value
  767.     jne     @Notsame
  768.     and     al,byte ptr [FillLast+edx]  // Partial byte 2 fill value
  769.   @notsame:
  770.     or      byte ptr [edi],al     // Fill partial byte 1
  771.     cmp     esi,ecx               // Byte1 = Byte2?
  772.     je      @done                 // All done
  773.     inc     esi                   // go to next byte
  774.     inc     edi
  775.  
  776.   @fillbytes:
  777.     cmp     edx,7                 // Partial byte 2 < 7?
  778.     jl      @partialbyte2
  779.     inc     ecx                   // Include byte 2 in fill
  780.   @partialbyte2:
  781.     cmp     ecx,esi               // Byte2 > Byte1?
  782.     jbe     @fillbit2             // Nope, fill partial byte 2
  783.     cld
  784.     mov     eax,-1                // Fill with FF's
  785.     sub     ecx,esi               // Count = Byte 2 - Byte 1
  786.     push    ecx                   // Fill
  787.     shr     ecx,2
  788.     rep     stosd
  789.     pop     ecx
  790.     and     ecx,3
  791.     rep     stosb
  792.  
  793.     cmp     edx,7
  794.     je      @done
  795.  
  796.   @fillbit2:
  797.     mov     al,byte ptr [FillLast+edx]
  798.     or      [edi],al
  799.  
  800.   @done:
  801. end;
  802.  
  803. function tXYBits.LineHasData( y: Integer ): Boolean;
  804. {&USES edi} {&FRAME-}
  805. asm
  806.     mov     eax,Self
  807.     mov     edx,y
  808.     mov     ecx,[eax].FSizeX
  809.     imul    edx,ecx
  810.     shr     edx,3
  811.     mov     edi,[eax].FBits
  812.     add     edi,edx
  813.  
  814.     shr     ecx,3
  815.     mov     al,0
  816.     repe scasb
  817.     jz      @done
  818.     mov     al,1
  819.   @done:
  820. end;
  821.  
  822. function TXYBits.BitIsSet( x,y: Integer): Boolean;
  823. {&USES None} {&FRAME-}
  824. asm
  825.     mov     eax,Self
  826.     mov     edx,y
  827.     imul    edx,[eax].FSizeX
  828.     add     edx,x
  829.     mov     eax,[eax].FBits
  830.  
  831.     bt      [eax],edx
  832.     sbb     eax,eax
  833.     and     eax,1
  834. end;
  835.  
  836. Procedure FloodFill(X, Y: Integer; Border: Word);
  837.   var
  838.     FilledArray: TXYBits;
  839.     xRightLimit: Longint;
  840.     yBottomLimit: Longint;
  841.     FirstYLine: Longint;
  842.     LastYLine: Longint;
  843.     FirstXRow: Longint;
  844.     LastXRow: Longint;
  845.  
  846.   procedure ScanLeft( var x,y: SmallInt );
  847.   var
  848.     v: Integer;
  849.   begin
  850.     with BGI.DW, FilledArray do
  851.       repeat
  852.         dec(x);
  853.         v := Pixels[ x, y ];
  854.       until (x < 0) or (v = Border) or BitIsSet(x,y);
  855.     inc(x);
  856.   end;
  857.  
  858.   procedure ScanRight( var x,y: SmallInt );
  859.   var
  860.     v: Integer;
  861.   begin
  862.     with BGI.DW, FilledArray do
  863.       repeat
  864.         inc(x);
  865.         v := Pixels[ x, y ];
  866.       until (x >= xRightLimit) or (v = Border) or BitIsSet(x,y);
  867.     dec(x);
  868.   end;
  869.  
  870.   function LineAdjFill( SeedX, SeedY, D, PrevXL, PrevXR: SmallInt ): Integer;
  871.   var
  872.     x,y: SmallInt;
  873.     xl,xr: SmallInt;
  874.     v: SmallInt;
  875.   begin
  876.     if ( SeedY < 0 ) or ( SeedY >= yBottomLimit ) then
  877.       begin
  878.         Result := xr;
  879.         exit;
  880.       end;
  881.  
  882.     y := SeedY;
  883.     xl := SeedX;
  884.     xr := SeedX;
  885.  
  886.     ScanLeft( xl, y );
  887.     ScanRight( xr, y );
  888.  
  889.     with BGI.DW, FilledArray do
  890.       begin
  891.         if y < FirstYLine then
  892.           FirstYLine := y;
  893.         if y > LastYLine then
  894.           LastYLine := y;
  895.         if xl < FirstXRow then
  896.           FirstXRow := xl;
  897.         if xr > LastXRow then
  898.           LastXRow := xr;
  899.         SetBits( xl, xr, y );
  900.  
  901.         // Find and fill adjacent line segments in same direction
  902.         x := xl;
  903.         if (y+D >= 0) and (y+D < yBottomLimit) then
  904.           while ( x <= xr ) do
  905.             begin
  906.               v := Pixels[ x, y+D ];
  907.               if (v <> Border) and not BitIsSet(x,y+D) then
  908.                 x := LineAdjFill( x, y+D, D, xl, xr );
  909.               inc( x );
  910.             end;
  911.  
  912.         // Find and fill adjacent line segments in opposite direction
  913.         if (y-D >= 0) and (y-D < yBottomLimit) then
  914.           begin
  915.             x := xl;
  916.             while x < prevXL do
  917.               begin
  918.                 v := Pixels[ x, y-D ];
  919.                 if (v <> Border) and not BitIsSet(x,y-D) then
  920.                   x := LineAdjFill( x, y-D, -D, xl, xr );
  921.                 inc( x );
  922.               end;
  923.  
  924.             x := prevXR;
  925.             while x < xr do
  926.               begin
  927.                 v := Pixels[ x, y-D ];
  928.                 if (v <> Border) and not BitIsSet(x,y-D) then
  929.                   x := LineAdjFill( x, y-D, -D, xl, xr );
  930.                 inc( x );
  931.               end;
  932.           end;
  933.       end;
  934.     Result := xr;
  935.   end; // LineAdjFill
  936.  
  937.   procedure FillLines;
  938.   var
  939.     x, xl, y: Integer;
  940.  
  941.   begin
  942.     with BGI.DW, FilledArray do
  943.       begin
  944.       for y := FirstYLine to LastYLine do
  945.         begin
  946.           x := FirstxRow;
  947.           repeat
  948.             while ( x < LastxRow ) and not BitIsSet( x, y ) do
  949.               inc( x );
  950.  
  951.             if ( x < LastxRow ) then
  952.               begin
  953.                 xl := x;
  954.                 while ( x < LastxRow ) and BitIsSet( x, y ) do
  955.                   inc( x );
  956.  
  957.                 if FillInfo.Pattern = SolidFill then
  958.                   DrawLine( xl, y, pred(x), y, FillInfo.Color )
  959.                 else
  960.                   DrawFillLine( xl, pred(x), y );
  961.               end;
  962.           until x >= LastXRow;
  963.         end;
  964.       if VPClip then
  965.         with ViewPort do
  966.         begin
  967.           inc( FirstxRow, x1 );
  968.           inc( LastxRow, x1 );
  969.           inc( FirstyLine, y1 );
  970.           inc( LastyLine, y1 );
  971.         end;
  972.       // Notify DIVE about changed region
  973.       RectChanged( FirstxRow, FirstyLine, LastxRow, LastYLine );
  974.     end;
  975.   end;
  976.  
  977. begin
  978.   with BGI.DW do
  979.     begin
  980.       if VPClip then
  981.         with ViewPort do
  982.           begin
  983.             xRightLimit := succ(x2-x1);
  984.             yBottomLimit := succ(y2-y1);
  985.           end
  986.       else
  987.         begin
  988.           xRightLimit := xSize;
  989.           yBottomLimit := ySize;
  990.         end;
  991.  
  992.       // Special case: If seed is border or invalid, do not fill
  993.       if ( x < 0 ) or ( x >= xRightLimit ) or
  994.          ( y < 0 ) or ( y >= yBottomLimit ) or
  995.          ( Pixels[ x,y ] = Border ) then
  996.         Exit;
  997.  
  998.       // Keep track of rectangle changed by fill
  999.       FirstYLine := ySize;
  1000.       LastYLine := 0;
  1001.       FirstXRow := xSize;
  1002.       LastXRow := 0;
  1003.       BeginUpdate;
  1004.  
  1005.       FilledArray := TXYBits.Create( succ(xsize), succ(ysize) );
  1006.  
  1007.       // Calculate the area to fill
  1008.       LineAdjFill( x, y, 1, x, x );
  1009.  
  1010.       // Execute the fill
  1011.       FillLines;
  1012.  
  1013.       FilledArray.Destroy;
  1014.  
  1015.       EndUpdate;
  1016.     end;
  1017. end;
  1018.  
  1019.  
  1020. Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  1021. begin
  1022.   If Assigned( BGI.DW ) then
  1023.     With BGI.DW do
  1024.       begin
  1025.         ArcCoords.x := LastArc.x;
  1026.         ArcCoords.y := LastArc.y;
  1027.         ArcCoords.xStart := LastArc.xStart;
  1028.         ArcCoords.yStart := LastArc.yStart;
  1029.         ArcCoords.xEnd := LastArc.xEnd;
  1030.         ArcCoords.yEnd := LastArc.yEnd;
  1031.       end;
  1032. end;
  1033.  
  1034. Procedure GetAspectRatio(var Xasp, Yasp: Word);
  1035. begin
  1036.   If Assigned( BGI.DW ) then
  1037.     begin
  1038.       XAsp := BGI.DW.XAspect;
  1039.       yAsp := BGI.DW.YAspect;
  1040.     end
  1041.   else
  1042.     begin
  1043.       XAsp := 0;
  1044.       yAsp := 0;
  1045.     end
  1046. end;
  1047.  
  1048. Function  GetBkColor: Word;
  1049. begin
  1050.   if Assigned( BGI.DW ) then
  1051.     Result := BGI.DW.BkColor
  1052.   else
  1053.     Result := 0;
  1054. end;
  1055.  
  1056. Function  GetColor: Word;
  1057. begin
  1058.   if Assigned( BGI.DW ) then
  1059.     Result := BGI.DW.FgColor
  1060.   else
  1061.     Result := 0;
  1062. end;
  1063.  
  1064. Procedure GetDefaultPalette(var Palette: PaletteType);
  1065. var
  1066.   i: Integer;
  1067.  
  1068. begin
  1069.   If Assigned( BGI.DW ) then
  1070.     with BGI.DW.PalInfo do
  1071.       Case Size of
  1072.         2   : Palette.Size := 2;
  1073.         256 : Palette.Size := 256;
  1074.       else    Palette.Size := 16;
  1075.       end
  1076.   else
  1077.     Palette.Size := 256;
  1078.  
  1079.   With Palette do
  1080.     begin
  1081.       For i := 0 to Size-1 do
  1082.         Colors[i] := i{+16;};
  1083.       For i := Size to High(Colors) do
  1084.         Colors[i] := 1;
  1085.     end;
  1086. end;
  1087.  
  1088. Function  GetDriverName: string;
  1089. begin
  1090.   Result := 'VP/2 DIVE VGA emulator';
  1091. end;
  1092.  
  1093. Procedure GetFillPattern(var FillPattern: FillPatternType);
  1094. var
  1095.   i: Integer;
  1096. begin
  1097.   if Assigned( BGI.DW ) then
  1098.     with BGI, DW.FillInfo do
  1099.       for i := 1 to 8 do
  1100.         // Get part of Os2Dive FillPattern
  1101.         FillPattern[ i ] := DW.FillPattern[i] and $FF;
  1102. end;
  1103.  
  1104. function GetGraphMode: Integer;
  1105. begin
  1106.   Result := 3;
  1107. end;
  1108.  
  1109. Procedure GetFillSettings(var FillInfo: FillSettingsType);
  1110. begin
  1111.   if Assigned( BGI.DW ) then
  1112.     FillInfo := BGI.DW.FillInfo
  1113. end;
  1114.  
  1115. procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
  1116. var
  1117.   p: Pchar;
  1118.   y: Integer;
  1119.   x: Integer;
  1120. begin
  1121.   x := x2-x1+1;
  1122.   p := @BitMap;
  1123.   pSmallWord(p)^ := x;
  1124.   inc(p,sizeof(smallword));
  1125.   pSmallWord(p)^ := y2-y1+1;
  1126.   inc(p,sizeof(smallword));
  1127.   pSmallWord(p)^ := 0;  // Reserved
  1128.   inc(p,sizeof(smallword));
  1129.   If assigned( BGI.DW ) then
  1130.     with BGI.DW do
  1131.       begin
  1132.         VPTransformXYXY( x1, y1, x2, y2 );
  1133.         BeginUpdate;
  1134.         for y := y1 to y2 do
  1135.           begin
  1136.             move( DisplayBuffer^[ x1+y*xSize ], p^, x );
  1137.             inc( p, x );
  1138.           end;
  1139.         EndUpdate;
  1140.       end;
  1141. end;
  1142.  
  1143. Procedure GetLineSettings(var LineInfo: LineSettingsType);
  1144. begin
  1145.   If assigned( BGI.DW ) then
  1146.     LineInfo := BGI.DW.LineInfo;
  1147. end;
  1148.  
  1149. Function  GetMaxColor: Word;
  1150. begin
  1151.   if Assigned( BGI.DW ) then
  1152.     Result := BGI.DW.Colours-1;
  1153. end;
  1154.  
  1155. Function  GetMaxX: Word;
  1156. begin
  1157.   if Assigned( BGI.DW ) then
  1158.     Result := BGI.DW.xSize-1;
  1159. end;
  1160.  
  1161. Function  GetMaxY: Word;
  1162. begin
  1163.   if Assigned( BGI.DW ) then
  1164.     Result := BGI.DW.ySize-1;
  1165. end;
  1166.  
  1167. Function  GetModeName(ModeNumber: Integer): string;
  1168. begin
  1169.   Result := Format( 'VP/2 Graph (%dx%d)', [ x_size, y_size ] );
  1170. end;
  1171.  
  1172. Procedure GetPalette(var Palette: PaletteType);
  1173. var
  1174.   i : Integer;
  1175.  
  1176. begin
  1177.   If assigned( BGI.DW ) then
  1178.     with BGI.DW, Palette do
  1179.       begin
  1180.         Size := PalInfo.Size;
  1181.         move( PalInfo.Colors, Colors, Sizeof( Colors ) );
  1182.       end;
  1183. end;
  1184.  
  1185. Function  GetPaletteSize: Integer;
  1186. begin
  1187.   If Assigned( BGI.DW ) then
  1188.     Result := BGI.DW.PalInfo.Size
  1189.   else
  1190.     Result := 0;
  1191. end;
  1192.  
  1193. Function  GetPixel(X,Y: Integer): Word;
  1194. const
  1195.   LastCol : Integer = 0;
  1196. var
  1197.   i: Integer;
  1198.  
  1199. begin
  1200.   if Assigned( BGI.DW ) then
  1201.     with BGI.DW, PalInfo do
  1202.       begin
  1203.         Result := Pixels[ x, y ];
  1204.  
  1205.         // First check if it is identical to the last one
  1206.         if Colors[LastCol] = Result then
  1207.           begin
  1208.             Result := LastCol;
  1209.             Exit;
  1210.           end;
  1211.  
  1212.         for i := 0 to Size-1 do
  1213.           If Colors[i] = Result then
  1214.             begin
  1215.               Result := i;
  1216.               LastCol := i;
  1217.               Exit;
  1218.             end;
  1219.       end;
  1220.     Result := 0;
  1221. end;
  1222.  
  1223. Procedure GetTextSettings(var TextInfo: TextSettingsType);
  1224. begin
  1225.   if assigned( BGI.DW ) then
  1226.     with BGI.DW do
  1227.       begin
  1228.         TextInfo.Font := FntSel;
  1229.         TextInfo.Direction := TxtDir;
  1230.         TextInfo.CharSize := CharSz;
  1231.         TextInfo.Horiz := TxtHoriz;
  1232.         TextInfo.Vert := TxtVert;
  1233.         TextInfo.userxscale := uSerxScale;
  1234.         TextInfo.userYscale := uSerYScale;
  1235.       end;
  1236. end;
  1237.  
  1238. Procedure GetViewSettings(var ThisViewPort: ViewPortType);
  1239. begin
  1240.   If Assigned( BGI.DW ) then
  1241.     with BGI.DW, ThisViewPort do
  1242.       begin
  1243.         x1 := ViewPort.x1;
  1244.         x2 := ViewPort.x2;
  1245.         y1 := ViewPort.y1;
  1246.         y2 := ViewPort.y2;
  1247.         Clip := VPClip;
  1248.       end;
  1249. end;
  1250.  
  1251. Function  GetX: Integer;
  1252. begin
  1253.   If Assigned( BGI.DW ) then
  1254.     Result := BGI.DW.Position.x;
  1255. end;
  1256.  
  1257. Function  GetY: Integer;
  1258. begin
  1259.   If Assigned( BGI.DW ) then
  1260.     Result := BGI.DW.Position.y;
  1261. end;
  1262.  
  1263. Procedure GraphDefaults;
  1264. begin
  1265.   if assigned( BGI.DW ) then
  1266.    with BGI.DW do
  1267.     begin
  1268.     SetViewPort( 0, 0, xSize-1, ySize-1 );
  1269.     FgColor := White;
  1270.     BkColor := Black;
  1271.     xScale := 1;
  1272.     yScale := 1;
  1273.     UserxScale := 1;
  1274.     UseryScale := 1;
  1275.     CharSz := 1;
  1276.     TxtDir := 0;
  1277.     TxtHoriz := LeftText;
  1278.     TxtVert := TopText;
  1279.     FntSel := DefaultFont;
  1280.     PalInfo.Size := Colours;  // Ask DIVE for color count
  1281.     GetDefaultPalette( PalInfo );
  1282.     LineInfo.LineStyle := SolidLn;
  1283.     LineInfo.Thickness := NormWidth;
  1284.     LineInfo.Pattern := $FFFF;
  1285.     FillInfo.Color:=White;
  1286.     FillInfo.Pattern:= SolidFill;
  1287.     SetLineThickness( LineInfo.Thickness );
  1288.     xAspect := 10000;
  1289.     yAspect := xAspect;  // Default 1:1 aspect ratio
  1290.     WriteMode := NormalPut;
  1291.   end;
  1292. end;
  1293.  
  1294. Function  GraphErrorMsg(ErrorCode: Integer): String;
  1295. begin
  1296.   GraphErrorMsg := '';
  1297. end;
  1298.  
  1299. Function  GraphResult: Integer;
  1300. begin
  1301.   If Assigned(BGI.DW) or (BGI.LastError <> grOK) then
  1302.     Result := BGI.LastError
  1303.   else
  1304.     Result := grNoInitGraph;
  1305. end;
  1306.  
  1307. function ImageSize(x1, y1, x2, y2: Integer): Word;
  1308. begin
  1309.   Result := (x2-x1+1)*(y2-y1+1)+6;
  1310. end;
  1311.  
  1312. var
  1313.   _KeyPressed: Longint;
  1314.   DelayCount: Longint;
  1315.  
  1316. const
  1317.   MouCount: Integer = 0;                // Count of event in MouBuffer
  1318.   KeyCount: Integer = 0;                // Count of keys in KeyBuffer
  1319.   CheckBreak: Boolean = True;           // Allow Ctrl-C for break?
  1320.   _Shift: Integer = 0;
  1321.   _Ctrl: Integer = 0;
  1322.   _Alt: Integer = 0;
  1323. var
  1324.   KeyBuffer: array[0..63] of Char;      { Keyboard type-ahead buffer }
  1325.   MouBuffer : array[0..127] of MouseEventRecT; // Mouse input buffer
  1326.  
  1327. { Waits for next timer tick or delays 1ms }
  1328.  
  1329. function DelayLoop(Count: Longint; var StartValue: ULong): Longint;
  1330. var
  1331.   Value: ULong;
  1332. begin
  1333.   repeat
  1334.     DosQuerySysInfo(qsv_Ms_Count,qsv_Ms_Count,Value,SizeOf(Value));
  1335.     Dec(Count);
  1336.   until (Value <> StartValue) or (Count = -1);
  1337.   StartValue := Value;
  1338.   DelayLoop := Count;
  1339. end;
  1340.  
  1341. { Delays a specified number of milliseconds. DosSleep is too inexact on }
  1342. { small time intervals. More over, the least time interval for DosSleep }
  1343. { is 1 timer tick (usually 31ms). That is why for small time intervals  }
  1344. { special delay routine is used. Unfortunately, even this routine cannot}
  1345. { be exact in the multitasking environment.                             }
  1346.  
  1347. procedure Delay(MS: Longint);
  1348. var
  1349.   StartValue,Value: ULong;
  1350.   Count: Longint;
  1351. begin
  1352.   if (MS >= 31) or (Random>0.9) then DosSleep(MS)
  1353.  else
  1354.   begin
  1355.     DosQuerySysInfo(qsv_Ms_Count,qsv_Ms_Count,StartValue,SizeOf(StartValue));
  1356.     Value := StartValue;
  1357.     Count := MS;
  1358.     repeat
  1359.       DelayLoop(DelayCount,Value);
  1360.       Dec(Count)
  1361.     until (Value-StartValue >= MS) or (Count <= 0);
  1362.   end;
  1363. end;
  1364.  
  1365. { Calculates 1ms delay count for DelayLoop routine. }
  1366. { CalcDelayCount is called once at startup.         }
  1367.  
  1368. procedure CalcDelayCount;
  1369. var
  1370.   Interval,StartValue,Value: ULong;
  1371. begin
  1372.   DosQuerySysInfo(qsv_Timer_Interval,qsv_Timer_Interval,Interval,SizeOf(Interval));
  1373.   DosQuerySysInfo(qsv_Ms_Count,qsv_Ms_Count,StartValue,SizeOf(StartValue));
  1374.   repeat
  1375.     DosQuerySysInfo(qsv_Ms_Count,qsv_Ms_Count,Value,SizeOf(Value));
  1376.   until Value <> StartValue;
  1377.   DelayCount := -DelayLoop(-1,Value) div Interval * 10;
  1378.   if DelayCount = 0 then Inc(DelayCount);
  1379. end;
  1380.  
  1381. function AltPressed: Boolean;
  1382. begin
  1383.   Result := _Alt > 0;
  1384. end;
  1385.  
  1386. function ShiftPressed: Boolean;
  1387. begin
  1388.   Result := _Shift > 0;
  1389. end;
  1390.  
  1391. function CtrlPressed: Boolean;
  1392. begin
  1393.   Result := _Ctrl > 0;
  1394. end;
  1395.  
  1396. function KeyPressed: Boolean;
  1397. var
  1398.   m: qMsg;
  1399. begin
  1400.   KeyPressed := KeyCount > 0;
  1401.   If WaitKeypressed and ( KeyCount = 0 ) then
  1402.     DosSleep( 31 );
  1403. end;
  1404.  
  1405. function ReadKey: Char;
  1406. begin
  1407.   while not KeyPressed do
  1408.     // If Keypressed did not wait, wait here
  1409.     if not WaitKeyPressed then
  1410.       DosSleep(31);
  1411.   mtx_Kbd.Request;
  1412.   ReadKey := KeyBuffer[0];
  1413.   Dec(KeyCount);
  1414.   Move(KeyBuffer[1], KeyBuffer[0], KeyCount);
  1415.   mtx_Kbd.Release;
  1416. end;
  1417.  
  1418. procedure WindowChar(Ch: Char);
  1419. begin
  1420.   if KeyCount < SizeOf(KeyBuffer) then
  1421.   begin
  1422.     mtx_Kbd.Request;
  1423.     KeyBuffer[KeyCount] := Ch;
  1424.     Inc(KeyCount);
  1425.     mtx_Kbd.Release;
  1426.   end;
  1427. end;
  1428.  
  1429. function MouseClicked: Boolean;
  1430. begin
  1431.   MouseClicked := MouCount > 0;
  1432. end;
  1433.  
  1434. procedure GetMouseEvent( var M: MouseEventRecT );
  1435. begin
  1436.   while not MouseClicked do
  1437.     DosSleep( 31 );
  1438.   mtx_Mou.Request;
  1439.   M := MouBuffer[0];
  1440.   Dec( MouCount );
  1441.   move( MouBuffer[1], MouBuffer[0], MouCount*Sizeof(MouBuffer[0]) );
  1442.   mtx_Mou.Release;
  1443. end;
  1444.  
  1445. // GetMouPos: Translate OS/2 coordinates to BGI ones for window
  1446. procedure GetMouPos( Wnd: HWnd; MouX, MouY: Word; Var X, Y: Word );
  1447. var
  1448.   xratio: Double;
  1449.   yratio: Double;
  1450.   swpos : Swp;
  1451. begin
  1452.   WinQueryWindowPos ( Wnd, swpos );
  1453.   with BGI.DW do
  1454.     begin
  1455.       xRatio := swpos.cx / xSize;
  1456.       yRatio := swpos.cy / ySize;
  1457.       X := Round(MouX/xRatio);
  1458.       Y := Round(ySize-MouY/yRatio);
  1459.     end;
  1460. end;
  1461.  
  1462. procedure PushMouse( Wnd: Hwnd; MouEvent: Word; MouX,MouY: Word);
  1463. begin
  1464.   mtx_Mou.Request;
  1465.   if MouCount < SizeOf(MouBuffer) then
  1466.     with MouBuffer[MouCount] do
  1467.       begin
  1468.         case MouEvent of
  1469.           wm_button1Click       : Event := mb1Click;
  1470.           wm_button1DblClk      : Event := mb1DblClick;
  1471.           wm_button1Down        : Event := mb1Down;
  1472.           wm_button1Up          : Event := mb1Up;
  1473.           wm_button1MotionStart : Event := mb1BeginDrag;
  1474.           wm_button1MotionEnd   : Event := mb1EndDrag;
  1475.           wm_button2Click       : Event := mb2Click;
  1476.           wm_button2DblClk      : Event := mb2DblClick;
  1477.           wm_button2Down        : Event := mb2Down;
  1478.           wm_button2Up          : Event := mb2Up;
  1479.           wm_button2MotionStart : Event := mb2BeginDrag;
  1480.           wm_button2MotionEnd   : Event := mb2EndDrag;
  1481.         end;
  1482.         GetMouPos( Wnd, MouX, MouY, X, Y );
  1483.         Inc(MouCount);
  1484.       end;
  1485.   mtx_Mou.Release;
  1486. end;
  1487.  
  1488. function MyMsgs( Wnd: HWnd; Msg: ULong; mp1, mp2: MParam ): MResult; cdecl;
  1489. var
  1490.   KeyUp: Boolean;
  1491.  
  1492. begin
  1493.   case msg of
  1494.     wm_mouseMove :
  1495.       begin
  1496.         GetMouPos( Wnd, Short1FromMp(Mp1), Short2FromMp(Mp1),
  1497.           CurrentMouseX, CurrentMouseY );
  1498.         MouseMoved := True;
  1499.       end;
  1500.     wm_button1Click, wm_button1DblClk, wm_button1Down,
  1501.     wm_button1Up, wm_button1MotionStart, wm_button1MotionEnd,
  1502.     wm_button2Click, wm_button2DblClk, wm_button2Down,
  1503.     wm_button2Up, wm_button2MotionStart, wm_button2MotionEnd :
  1504.         PushMouse( Wnd, msg, Short1FromMp(Mp1), Short2FromMp(Mp1));
  1505.     wm_char :
  1506.       begin
  1507.       KeyUp := (CharMsgMp1(Mp1).fs and kc_KeyUp) <> 0;
  1508.       if (CharMsgMp1(Mp1).fs and kc_VirtualKey) <> 0 then
  1509.         begin
  1510.           case CharMsgMp2(Mp2).VKey of
  1511.             vk_Shift : If KeyUp then
  1512.                 Dec( _Shift )
  1513.               else
  1514.                 if CharMsgMp1(Mp1).fs and kc_PrevDown = 0 then
  1515.                   Inc( _Shift );
  1516.             vk_Ctrl  : If KeyUp then
  1517.                 Dec( _Ctrl )
  1518.               else
  1519.                 if CharMsgMp1(Mp1).fs and kc_PrevDown = 0 then
  1520.                 Inc( _Ctrl );
  1521.             vk_Alt   : If KeyUp then
  1522.                 Dec( _Alt )
  1523.               else
  1524.                 if CharMsgMp1(Mp1).fs and kc_PrevDown = 0 then
  1525.                   Inc( _Alt );
  1526.             vk_ESC : If KeyUp then
  1527.               WindowChar( #27 );
  1528.           end;
  1529.         end;
  1530.       if not KeyUp then
  1531.       begin                                                     { Key is down }
  1532.         if CheckBreak then                                      { Break enabled }
  1533.           if (CharMsgMp2(Mp2).VKey = vk_Break) or               { Ctrl-Break }
  1534.             (((CharMsgMp1(Mp1).fs and kc_Ctrl) <> 0) and
  1535.              ((CharMsgMp2(Mp2).Chr = Ord('C')) or               { Ctrl-C }
  1536.               (CharMsgMp2(Mp2).Chr = Ord('c')))) then
  1537.                 Halt(255);{ Ctrl-c }
  1538.         if (CharMsgMp2(Mp2).Chr > 0) and (CharMsgMp2(Mp2).Chr <= 255) and
  1539.           ((CharMsgMp1(Mp1).fs and (kc_Ctrl + kc_Alt)) = 0)
  1540.           then
  1541.           begin
  1542.             WindowChar(Chr(CharMsgMp2(Mp2).Chr));
  1543.             Result := 1;
  1544.           end;
  1545. //          else WindowKeyDown(CharMsgMp2(Mp2).VKey, (CharMsgMp1(Mp1).fs and kc_Ctrl) <> 0);
  1546.         end;
  1547.       end;
  1548.   end;
  1549.   Result := 0;
  1550. end;
  1551.  
  1552. Function _InitGraph( p: Pointer ): Longint;
  1553. begin
  1554.   GrStatus := 0;
  1555.   _KeyPressed := 0;
  1556.   BGI.DW := tGraphWindow.Create( x_size, y_size, 8 , WindowTitle);
  1557.   if assigned( BGI.DW ) then
  1558.     with BGI, DW do
  1559.       try
  1560.         LastError := grOK;
  1561.         GrStatus := 1;
  1562.         MessageHandler := MyMsgs;
  1563.         Run;
  1564.       finally
  1565.         Destroy;
  1566.       end
  1567.   else
  1568.     raise EGraph.Create( 'Cannot create Graphwindow' );
  1569.   BGI.DW := nil;
  1570.   GrStatus := 2;
  1571.   tidMessage := -1;
  1572. end;
  1573.  
  1574. procedure MyExitProc;
  1575. begin
  1576.   ExitProc := SaveExit;
  1577.   SaveExit := nil;
  1578.   CloseGraph;
  1579. end;
  1580.  
  1581. procedure InitGraph(var GraphDriver:Integer; var GraphMode: Integer;
  1582.     PathToDriver: string);
  1583.  
  1584. begin
  1585.   If GrStatus = 1 then
  1586.     Exit;  // Already running;
  1587.  
  1588.   tidMessage := VPBeginThread( _InitGraph, 4*16384, nil);
  1589.   if tidMessage <> 0 then
  1590.     begin
  1591.       While GrStatus = 0 do
  1592.         DosSleep( 50 );
  1593.       SaveExit := ExitProc;
  1594.       ExitProc := @MyExitProc;
  1595.  
  1596.       If GrStatus = 1 then
  1597.         begin
  1598.           GraphDriver := 9;    // VGA
  1599.           GraphMode   := 2;    // VGAHi
  1600.           BGI.PathToFont := PathToDriver;
  1601.           If BGI.PathToFont[Length(BGI.PathToFont)] <> '\' then
  1602.             BGI.PathToFont := BGI.PathToFont + '\';
  1603.           ClearViewPort;
  1604.           WaitDraw;
  1605.         end;
  1606.     end;
  1607. end;
  1608.  
  1609. // Start graphics with any resolution up to 1280x1024
  1610. procedure VPInitGraph( xRes, yRes: Integer; PathToDriver: string);
  1611. begin
  1612.   If GrStatus = 1 then
  1613.     Exit;  // Already running;
  1614.  
  1615.   if ( xRes <= 0 ) or ( yRes <= 0 ) or
  1616.      ( xRes > xmax) or ( yRes > ymax ) then
  1617.     begin
  1618.       BGI.LastError := grInvalidMode;
  1619.       Exit;
  1620.     end;
  1621.  
  1622.   x_size := xRes;
  1623.   y_size := yRes;
  1624.   tidMessage := VPBeginThread( _InitGraph, 4*16384, nil);
  1625.   if tidMessage <> 0 then
  1626.     begin
  1627.       While GrStatus = 0 do
  1628.         DosSleep( 50 );
  1629.       SaveExit := ExitProc;
  1630.       ExitProc := @MyExitProc;
  1631.  
  1632.       If GrStatus = 1 then
  1633.         begin
  1634.           BGI.PathToFont := PathToDriver;
  1635.           If BGI.PathToFont[Length(BGI.PathToFont)] <> '\' then
  1636.             BGI.PathToFont := BGI.PathToFont + '\';
  1637.           ClearViewPort;
  1638.           WaitDraw;
  1639.         end;
  1640.     end
  1641.   else
  1642.     raise EGraph.Create( 'Error creating Graph thread' );
  1643. end;
  1644.  
  1645. Function  InstallUserFont(FontFileName: string) : Integer;
  1646. var
  1647.   i: Integer;
  1648.  
  1649. begin
  1650.   with BGI do
  1651.     if Fonts = MaxFonts then
  1652.       Result := -1
  1653.     else
  1654.       begin
  1655.         Inc( Fonts );
  1656.         with Font[ Fonts ] do
  1657.           begin
  1658.             FontName := FontFileName;
  1659.             Linked := False;
  1660.             CharData := nil;
  1661.           end;
  1662.  
  1663.         Result := Fonts;
  1664.       end;
  1665. end;
  1666.  
  1667. Procedure Line(X1, Y1, X2, Y2: Integer);
  1668. begin
  1669.   if Assigned( BGI.DW ) then
  1670.     With BGI.DW, LineInfo do
  1671.       begin
  1672.         BeginUpdate;
  1673.         if LineStyle = UserBitLn then
  1674.           SetLinePattern( Pattern )
  1675.         else
  1676.           SetLinePattern( LinePatterns[LineStyle] );
  1677.         SetLineThickness( LineInfo.Thickness );
  1678.         LinePutMode := WriteMode;
  1679.         DrawLine( x1, y1, x2, y2, FgColor );
  1680.         LinePutMode := NormalPut;
  1681.         SetLinePattern( $FFFFFFFF );
  1682.  
  1683.         EndUpdate;
  1684.       end;
  1685. end;
  1686.  
  1687. Procedure LineRel(Dx, Dy: Integer);
  1688. begin
  1689.   if Assigned( BGI.DW ) then
  1690.     With BGI.DW do
  1691.       begin
  1692.         BeginUpdate;
  1693.         LinePutMode := WriteMode;
  1694.         DrawLine( Position.x,    Position.y,
  1695.                   Position.x+Dx, Position.y+Dy, FgColor );
  1696.         LinePutMode := NormalPut;
  1697.         EndUpdate;
  1698.         Inc( Position.x, Dx );
  1699.         Inc( Position.y, Dy );
  1700.       end;
  1701. end;
  1702.  
  1703. Procedure LineTo(X, Y: Integer);
  1704. begin
  1705.   if Assigned( BGI.DW ) then
  1706.     With BGI.DW do
  1707.       begin
  1708.          BeginUpdate;
  1709.          LinePutMode := WriteMode;
  1710.          DrawLine( Position.x, Position.y, X, Y, FgColor );
  1711.          LinePutMode := NormalPut;
  1712.          EndUpdate;
  1713.          Position.x := x;
  1714.          Position.y := y;
  1715.        end;
  1716. end;
  1717.  
  1718. Procedure MoveRel(Dx, Dy: Integer);
  1719. begin
  1720.   if Assigned( BGI.DW ) then
  1721.     With BGI.DW do
  1722.       begin
  1723.         Inc( Position.x, Dx );
  1724.         Inc( Position.y, Dy );
  1725.       end;
  1726. end;
  1727.  
  1728. Procedure MoveTo(X, Y: Integer);
  1729. begin
  1730.   if Assigned( BGI.DW ) then
  1731.     With BGI.DW do
  1732.       begin
  1733.         Position.x := x;
  1734.         Position.y := y;
  1735.       end;
  1736. end;
  1737.  
  1738. procedure RotateXY( var x,y: Integer; Angle: Integer );
  1739. var
  1740.   x1, y1: Double;
  1741. begin
  1742.   While Angle < 0 do
  1743.     Inc( Angle, 360 );
  1744.   Angle := Angle mod 360;
  1745.   x1 := x;
  1746.   y1 := y;
  1747.   x := Round( x1*tcos[Angle*4] + y1*tsin[Angle*4] ) div 1024;
  1748.   y := Round( -x1*tsin[Angle*4] + y1*tcos[Angle*4] ) div 1024;
  1749. end;
  1750.  
  1751. procedure DrawBGIChar( var x,y: Integer; Ch: Char );
  1752.   procedure DecodeBGI( w: SmallWord; var x,y,Op: Integer );
  1753.   begin
  1754.     x  := w and $7F;
  1755.     if x and $40 <> 0 then
  1756.       x := x or $FFFFFF80;
  1757.     y  := (w shr 8) and $7F;
  1758.     if y and $40 <> 0 then
  1759.       y := y or $FFFFFF80;
  1760.     Op := byte(w) shr 7 or ((w shr 14) and 2);   // I think :)
  1761.   end;
  1762.  
  1763. const
  1764.   bgi_PenDone = 0;
  1765.   bgi_PenMove = 1;
  1766.   bgi_PenDraw = 3;
  1767.  
  1768. type
  1769.   psWord = ^SmallWord;
  1770.  
  1771. var
  1772.   ChOffs: Integer;
  1773.   ChPtr: Pchar;
  1774.   x1,y1,op: Integer;
  1775.   newx,newy: Integer;
  1776.   lastx,lasty: Integer;
  1777.  
  1778. begin
  1779.   With BGI.DW, BGI.Font[FntSel] do
  1780.     begin
  1781.       If ( Ch < FirstChar ) or ( Ch > LastChar ) then
  1782.         Exit;
  1783.  
  1784.       beginupdate;
  1785.       ChOffs := ord(ch)-ord(FirstChar);
  1786.       ChPtr := Ptr( Longint(CharData)+CharIndex[ChOffs] );
  1787.  
  1788.       DecodeBGI( psWord(ChPtr)^, x1, y1, Op );
  1789.       while Op <> bgi_PenDone do
  1790.         begin
  1791.           x1 := Round(x1 * xScale);
  1792.           y1 := Round(-y1 * yScale);
  1793.           RotateXY( x1, y1, TxtDir );
  1794.  
  1795.           if Op = bgi_PenMove then
  1796.             begin
  1797.               Lastx := x + x1;
  1798.               Lasty := y + y1;
  1799.             end
  1800.           else
  1801.             begin
  1802.               Newx := x + x1;
  1803.               Newy := y + y1;
  1804.               DrawLine( Lastx, Lasty, Newx, Newy, FgColor );
  1805.               Lastx := Newx;
  1806.               Lasty := Newy;
  1807.             end;
  1808.  
  1809.           Inc( ChPtr, Sizeof(SmallWord) );
  1810.           DecodeBGI( pWord(ChPtr)^, x1, y1, Op );
  1811.         end;
  1812.       endupdate;
  1813.       x1 := Round(CharWidth[ChOffs] * xScale);
  1814.       y1 := 0;
  1815.       RotateXY( x1, y1, TxtDir );
  1816.       Inc( x, x1 );
  1817.       Inc( y, y1 );
  1818.     end;
  1819. end;
  1820.  
  1821. Procedure OutText(TextString: string);
  1822. var
  1823.   x,y: Integer;
  1824.   offx, offy: Integer;
  1825.   i: Integer;
  1826.  
  1827. begin
  1828.   If assigned( BGI.DW ) then
  1829.     with BGI, BGI.DW do
  1830.       begin
  1831.         x := Position.x;
  1832.         y := Position.y;
  1833.         Offx := 0;
  1834.         Offy := 0;
  1835.  
  1836.         If TxtHoriz = CenterText then
  1837.           Offx := -TextWidth( textString ) div 2
  1838.         else If TxtHoriz = RightText then
  1839.           Offx := -TextWidth( textString );
  1840.  
  1841.         If TxtVert = TopText then
  1842.           Offy := TextHeight(TextString)
  1843.         else if TxtVert = CenterText then
  1844.           Offy := TextHeight(TextString) div 2;
  1845.         RotateXY( Offx, Offy, TxtDir );
  1846.  
  1847.         Inc( x, Offx );
  1848.         SetLineThickness( 1 );
  1849.         If FntSel = DefaultFont then
  1850.           begin
  1851.             BeginUpdate;
  1852.             DrawStr( x,y, FgColor, BkColor, TextString );
  1853.             EndUpdate;
  1854. //            Inc( Position.x, Length(TextString)*8 );
  1855.           end
  1856.         else
  1857.           begin
  1858.             Inc( y, Offy );
  1859.             For i := 1 to Length( TextString ) do
  1860.               DrawBGIChar( x, y, TextString[i] );
  1861.           end;
  1862.         SetLineThickness( LineInfo.Thickness );
  1863.  
  1864.         // Finally adjust drawing position
  1865.         case TxtHoriz of
  1866.           LeftText: Offx := TextWidth( TextString );
  1867.           CenterText: Offx := TextWidth( TextString ) div 2;
  1868.           RightText: Offx := 0;
  1869.         end;
  1870.         Offy := 0;
  1871.         RotateXY( Offx, Offy, TxtDir );
  1872.  
  1873.         inc( Position.x, Offx );
  1874.         inc( Position.y, Offy );
  1875.       end;
  1876. end;
  1877.  
  1878. Procedure OutTextXY(X, Y: Integer; TextString: string);
  1879. Var
  1880.   OldPos : PointType;
  1881. begin
  1882.   With BGI, DW do
  1883.     If Assigned( DW ) and ( FntSel <> -1 ) then
  1884.       begin
  1885.         OldPos := Position;
  1886.         Position.x := x;
  1887.         Position.y := y;
  1888.         OutText( TextString );
  1889.  
  1890.         // Ignore position change
  1891.         Position := OldPos;
  1892.       end;
  1893. end;
  1894.  
  1895. Procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  1896. begin
  1897.   If Assigned( BGI.DW ) then
  1898.     with BGI.DW do
  1899.       begin
  1900.         LineMode := False;
  1901.         Sector( x, y, StAngle, EndAngle, Radius, Radius );
  1902.       end;
  1903. end;
  1904.  
  1905. procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
  1906. var
  1907.   p: Pchar;
  1908.   width: Integer;
  1909.   height: Integer;
  1910.   i,j: Integer;
  1911.   inx, iny: Integer;
  1912.   Disp : ^Byte;
  1913. begin
  1914.   p := @BitMap;
  1915.   width  := pSmallWord(p)^;   inc(p,sizeof(smallword));
  1916.   height := pSmallWord(p)^;   inc(p,2*sizeof(smallword));
  1917.   If assigned( BGI.DW ) then
  1918.     with BGI.DW do
  1919.       begin
  1920.         inx := x;
  1921.         iny := y;
  1922.         VPTransformXY( x, y );
  1923.         BeginUpdate;
  1924.         for i := 0 to height-1 do
  1925.           begin
  1926.             if BitBlt < 0 then
  1927.               begin
  1928.                 move( p^, DisplayBuffer^[ x+(i+y)*xSize ], width );
  1929.                 inc( p, width );
  1930.               end
  1931.             else
  1932.               with PalInfo do
  1933.                 begin
  1934.                   Disp := @DisplayBuffer^[ x+(i+y)*xSize ];
  1935.                   for j := 1 to width do
  1936.                     begin
  1937.                     Case BitBlt of
  1938.                       CopyPut:Disp^ := ord(p^);
  1939.                       XORPut: Disp^ := ord(p^) xor Disp^;
  1940.                       ORPut:  Disp^ := ord(p^)  or Disp^;
  1941.                       ANDPut: Disp^ := ord(p^) and Disp^;
  1942.                       NOTPut: Disp^ := not ord(p^);
  1943.                     end;
  1944.                     inc(Disp);
  1945.                     Inc(p);
  1946.                   end;
  1947.                 end;
  1948.           end;
  1949.         EndUpdate;
  1950.         RectChanged( x, y, x+width-1, y+height-1 );
  1951.       end;
  1952. end;
  1953.  
  1954. Procedure PutPixel(X, Y: Integer; Color: Word);
  1955. begin
  1956.   if Assigned( BGI.DW ) then
  1957.     with BGI.DW, PalInfo do
  1958.       begin
  1959.         BeginUpdate;
  1960.         Pixels[ x, y ] := Colors[ Color ];
  1961.         EndUpdate;
  1962.       end;
  1963. end;
  1964.  
  1965. Procedure Rectangle(X1, Y1, X2, Y2: Integer);
  1966. begin
  1967.   if Assigned( BGI.DW ) then
  1968.     with BGI.DW do
  1969.       begin
  1970.         BeginUpdate;
  1971.         LineMode := True;
  1972.         LinePutMode := WriteMode;
  1973.         DrawBox( x1, y1, x2, y2, FgColor );
  1974.         LinePutMode := NormalPut;
  1975.         EndUpdate;
  1976.       end;
  1977. end;
  1978.  
  1979. Procedure RegisterBGIFont(FontID: Integer; Font: Pointer);
  1980. begin
  1981. end;
  1982.  
  1983. Procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
  1984. var
  1985.   Center: Pixel;
  1986.   fx, fy: Longint;
  1987.   Angle: Longint;
  1988.  
  1989. begin
  1990.   If Assigned( BGI.DW ) then
  1991.     with BGI.DW do
  1992.       begin
  1993.         BeginUpdate;
  1994.         StAngle := StAngle mod 360;
  1995.         If EndAngle <> 360 then
  1996.           EndAngle := EndAngle mod 360;
  1997.  
  1998.         Center.x := x;
  1999.         Center.y := y;
  2000.         DrawEllipse( Center, xRadius, YRadius, StAngle, EndAngle, FgColor );
  2001.         DrawLine( x,y, LastArc.xStart, LastArc.yStart, FgColor );
  2002.         DrawLine( x,y, LastArc.xEnd, LastArc.yEnd, FgColor );
  2003.  
  2004.         // Calculate a spot in the inside of the sector
  2005.         {$R+}
  2006.         Angle := (EndAngle+StAngle)*2;
  2007.         fx := x + Round(xRadius*tcos[Angle]/2048);
  2008.         fy := y - Round(yRadius*tsin[Angle]/2048);
  2009.         {$R-}
  2010.         EndUpdate;
  2011.  
  2012.         // Fill it using the current fill style
  2013.         if ( XRadius*YRadius > 0 ) and ( StAngle <> EndAngle ) then
  2014.           FloodFill( fx,fy,FgColor );
  2015.       end
  2016. end;
  2017.  
  2018. Procedure SetAllPalette(var Palette: PaletteType);
  2019. begin
  2020. end;
  2021.  
  2022. Procedure SetAspectRatio(Xasp, Yasp: Word);
  2023. begin
  2024.   If Assigned( BGI.DW ) then
  2025.     with BGI.DW do
  2026.       begin
  2027.         XAspect := XAsp;
  2028.         yAspect := YAsp;
  2029.       end
  2030. end;
  2031.  
  2032. Procedure SetBkColor(ColorNum: Word);
  2033. begin
  2034.   if Assigned( BGI.DW ) then
  2035.     BGI.DW.BkColor := ColorNum;
  2036. end;
  2037.  
  2038. Procedure SetColor(Color: Word);
  2039. begin
  2040.   if Assigned( BGI.DW ) then
  2041.     BGI.DW.FgColor := Color;
  2042. end;
  2043.  
  2044. Procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
  2045. var
  2046.   i: Integer;
  2047. begin
  2048.   if Assigned( BGI.DW ) then
  2049.     with BGI.DW do
  2050.       begin
  2051.         FillInfo.Pattern := UserFill;
  2052.         FillInfo.Color := Color;
  2053.         for i := 1 to 8 do
  2054.           begin
  2055.             // Expand 8x8 to 16x16 matrix
  2056.             FillPattern[ (i-1)   ] := Pattern[i] or Pattern[i] shl 8;
  2057.             FillPattern[ (i-1)+8 ] := FillPattern[ i-1 ];
  2058.           end;
  2059.         FillColor := Color;
  2060.       end;
  2061. end;
  2062.  
  2063. Procedure SetWideFillPattern(Pattern: NewPatternType; Color: Word);
  2064. var
  2065.   i: Integer;
  2066. begin
  2067.   if Assigned( BGI.DW ) then
  2068.     with BGI.DW do
  2069.       begin
  2070.         FillInfo.Pattern := UserFill;
  2071.         FillInfo.Color := Color;
  2072.         move( Pattern, FillPattern, Sizeof( FillPattern ) );
  2073.         FillColor := Color;
  2074.       end;
  2075. end;
  2076.  
  2077. Procedure SetFillStyle(Pattern: Word; Color: Word);
  2078. const
  2079.   AllPatterns : ARRAY [0..11] OF NewPatternType =
  2080.   (($0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000,
  2081.     $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000),
  2082.    ($FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,
  2083.     $FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF,$FFFF),
  2084.    ($0000,$0000,$0000,$FFFF,$0000,$0000,$0000,$0000,
  2085.     $0000,$0000,$0000,$FFFF,$0000,$0000,$0000,$0000),
  2086.    ($0001,$0002,$0004,$0008,$0010,$0020,$0040,$0080,
  2087.     $0100,$0200,$0400,$0800,$1000,$2000,$4000,$8000),
  2088.    ($0303,$0606,$0C0C,$1818,$3030,$6060,$C0C0,$8181,
  2089.     $0303,$0606,$0C0C,$1818,$3030,$6060,$C0C0,$8181),
  2090.    ($8181,$C0C0,$6060,$3030,$1818,$0C0C,$0606,$0303,
  2091.     $8181,$C0C0,$6060,$3030,$1818,$0C0C,$0606,$0303),
  2092.    ($8000,$4000,$2000,$1000,$0800,$0400,$0200,$0100,
  2093.     $0080,$0040,$0020,$0010,$0008,$0004,$0002,$0001),
  2094.    ($0808,$0808,$0808,$FFFF,$0808,$0808,$0808,$0808,
  2095.     $0808,$0808,$0808,$FFFF,$0808,$0808,$0808,$0808),
  2096.    ($8002,$4004,$2008,$1010,$0820,$0440,$0280,$0100,
  2097.     $0280,$0440,$0820,$1010,$2008,$4004,$8002,$0001),
  2098.    ($8282,$4444,$2828,$1010,$2828,$4444,$8282,$0101,
  2099.     $8282,$4444,$2828,$1010,$2828,$4444,$8282,$0101),
  2100.    ($0000,$0800,$0000,$0000,$0000,$0000,$0000,$0000,
  2101.     $0000,$0010,$0000,$0000,$0000,$0000,$0000,$0000),
  2102.    ($0000,$4444,$0000,$0000,$0000,$2222,$0000,$0000,
  2103.     $0000,$4444,$0000,$0000,$0000,$2222,$0000,$0000));
  2104. begin
  2105.   if Assigned( BGI.DW ) then
  2106.     with BGI.DW do
  2107.       begin
  2108.         If Pattern > High( AllPatterns ) then
  2109.           Pattern := SolidFill;
  2110.         FillInfo.Pattern := Pattern;
  2111.         FillInfo.Color := Color;
  2112.         move( AllPatterns[Pattern], FillPattern, Sizeof( FillPattern ) );
  2113.         FillColor := Color;
  2114.       end;
  2115. end;
  2116.  
  2117. Procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
  2118. begin
  2119.   If Assigned( BGI.DW ) then
  2120.     with BGI.DW do
  2121.       begin
  2122.         LineInfo.Thickness := ThickNess;
  2123.         LineInfo.Pattern := Pattern or (Pattern shl 16);
  2124.         LineInfo.LineStyle := LineStyle;
  2125.         SetLineThickness( LineInfo.Thickness );
  2126.         if LineStyle = UserBitLn then
  2127.           SetLinePattern( Pattern )
  2128.         else
  2129.           SetLinePattern( LinePatterns[LineStyle] );
  2130.       end;
  2131. end;
  2132.  
  2133. Procedure SetPalette(ColorNum: Word; Color: Byte);
  2134. begin
  2135. end;
  2136.  
  2137. Procedure SetRGBPalette(ColorNum: Word; Red, Green, Blue: Byte);
  2138. begin
  2139.   If Assigned( BGI.DW ) then
  2140.     begin
  2141.       with BGI.DW do
  2142.         SetRGBColor( ColorNum, Red, Green, Blue );
  2143.     end;
  2144. end;
  2145.  
  2146. Procedure SetTextJustify(Horiz, Vert: Word);
  2147. begin
  2148.   with BGI, DW do
  2149.     begin
  2150.       if not assigned( DW ) or ( FntSel = -1 ) then
  2151.         Exit;
  2152.       If ( Horiz < LeftText ) or ( Horiz > RightText ) or
  2153.          ( Vert < BottomText ) or ( Vert > TopText ) then
  2154.         Exit;
  2155.  
  2156.       TxtHoriz := Horiz;
  2157.       TxtVert  := Vert;
  2158.     end;
  2159. end;
  2160.  
  2161. procedure UnloadFont( Font: Integer );
  2162. begin
  2163.   if Font > DefaultFont then
  2164.     With BGI.Font[Font] do
  2165.       If ( ChDataMem > 0 ) and ( CharData <> nil ) then
  2166.         begin
  2167.           FreeMem( CharData, ChDataMem );
  2168.           CharData := nil;
  2169.         end;
  2170. end;
  2171.  
  2172. function LoadFont( Font: Integer ): Boolean;
  2173. const
  2174.   Ext: Array[1..3] of str4 = ('','.CHR','.BGI');
  2175. var
  2176.   f: File;
  2177.   Buf: Array[1..16] of char;
  2178.   Err: Integer;
  2179.   i: Integer;
  2180.   Path: Integer;
  2181.   fName : String;
  2182.  
  2183. begin
  2184.   LoadFont := False;
  2185.  
  2186.   Path := 1;
  2187.   Repeat
  2188.     i := Low(Ext);
  2189.     Repeat
  2190.       fName := BGI.Font[Font].FontName+Ext[i];
  2191.       If Path = 1 then
  2192.         fName := BGI.PathToFont + fName;
  2193.       if fName <> '' then
  2194.         begin
  2195.           Assign( f, fName );
  2196.           {$I-}
  2197.           reset(f, 1);
  2198.           {$I+}
  2199.         end;
  2200.       inc(i);
  2201.     Until ((IOResult = 0) and (fName <> '')) or (i>High(Ext));
  2202.     Inc( Path );
  2203.   Until ( Path > 2 ) or ( i <= High(Ext) );
  2204.   BGI.LastError := GrInvalidFont;
  2205.   If i <= High(Ext) then
  2206.     try
  2207.       BlockRead( f, Buf, 2, Err );
  2208.       If ( Buf[1] <> 'P' ) or ( Buf[2] <> 'K' ) then
  2209.         Exit;
  2210.  
  2211.       Seek( f, $80 );
  2212.       BlockRead( f, Buf, 16, Err );
  2213.       If (Buf[1] <> '+') or (err <> 16) then
  2214.         Exit;
  2215.  
  2216.       BGI.LastError := grOK;
  2217.       with BGI.Font[Font] do
  2218.         begin
  2219.           FirstChar := Buf[5];
  2220.           Chars := ord(Buf[2]);
  2221.           LastChar  := Chr( ord(FirstChar)+Chars-1 );
  2222.           Org_To_Top := ord(buf[9]);
  2223.           Org_To_Base:= ord(buf[10]);
  2224.           Org_To_Dec := ord(buf[11]);
  2225.           if Org_To_Dec and $80 > 0 then
  2226.             Org_To_Dec := Org_To_Dec or $FF00;
  2227.  
  2228.           BlockRead( f, CharIndex, Chars*2, Err );
  2229.           BlockRead( f, CharWidth, Chars, Err );
  2230.           ChDataMem := FileSize(f)-filePos(f);
  2231.           GetMem( CharData, ChDataMem );
  2232.           BlockRead( f, CharData^, ChDataMem, Err );
  2233.           Linked := True;
  2234.         end;
  2235.       Result := True;
  2236.     finally
  2237.       close(f);
  2238.     end;
  2239. end;
  2240.  
  2241. Procedure SetTextStyle(Font, Direction, CharSize: Integer);
  2242. begin
  2243.   If assigned( BGI.DW ) then
  2244.     with BGI.DW do
  2245.       begin
  2246.         If Font <> FntSel then
  2247.           begin
  2248.             UnloadFont( FntSel );
  2249.             If (Font = DefaultFont) or LoadFont( Font ) then
  2250.               begin
  2251.                 FntSel := Font;
  2252.               end
  2253.             else
  2254.               begin
  2255.                 Raise EGraph.CreateFmt(
  2256.                   'Font %d (%s) could not be found', [Font, BGI.Font[Font].FontName] );
  2257.                 FntSel := -1;
  2258.                 Exit;
  2259.               end;
  2260.           end;
  2261.         If CharSize > 10 then CharSize := 10;
  2262.         If CharSize = 0 then
  2263.           begin
  2264.             xScale := UserxScale;
  2265.             yScale := UseryScale;
  2266.           end
  2267.         else
  2268.           if CharSize > 0 then
  2269.             begin
  2270.               xScale := FontScale[ CharSize ];
  2271.               yScale := FontScale[ CharSize ];
  2272.             end
  2273.           else
  2274.             begin // CharSize < 0
  2275.               xScale := Abs(CharSize) / FontScale[ CharSize ];
  2276.               yScale := xScale;
  2277.             end;
  2278.         CharSz := CharSize;
  2279.         TxtDir := Direction;
  2280.       end;
  2281. end;
  2282.  
  2283. Procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
  2284. begin
  2285.   with BGI, DW do
  2286.     begin
  2287.       if not assigned( DW ) or ( FntSel = -1 ) then
  2288.         Exit;
  2289.       If ( DivX = 0 ) or ( DivY = 0 ) then
  2290.         Exit;
  2291.  
  2292.       UserxScale := MultX / DivX;
  2293.       UseryScale := MultY / DivY;
  2294.       If CharSz = 0 then
  2295.         begin
  2296.           xScale := UserxScale;
  2297.           yScale := UseryScale;
  2298.         end;
  2299.     end;
  2300. end;
  2301.  
  2302. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  2303. begin
  2304.   If Assigned( BGI.DW ) then
  2305.     if ( x1 < 0 ) or ( x2 < x1 ) or
  2306.        ( y1 < 0 ) or ( y2 < y1 ) then
  2307.       BGI.LastError := grError
  2308.     else
  2309.       With BGI.DW do
  2310.         begin
  2311.           SetViewPort( x1,y1, x2,y2 );
  2312.           VPClip := Clip;
  2313.           Position.x := 0;
  2314.           Position.y := 0;
  2315.         end;
  2316. end;
  2317.  
  2318. Procedure SetWriteMode(WriteMode: Integer);
  2319. begin
  2320.   If Assigned( BGI.DW ) then
  2321.     if WriteMode in [0..4] then
  2322.       BGI.DW.WriteMode := WriteMode;
  2323. end;
  2324.  
  2325. Function  TextHeight(TextString: string): Word;
  2326. begin
  2327.   With BGI, DW do
  2328.     If FntSel = DefaultFont then
  2329.       Result := 8
  2330.     else
  2331.       with Font[ FntSel ] do
  2332.         Result := round(( Org_to_Top - Org_To_Dec ) * Yscale);
  2333. end;
  2334.  
  2335. Function  TextWidth(TextString: string): Word;
  2336. var
  2337.   ChOffs : Integer;
  2338.   i: Integer;
  2339.  
  2340. begin
  2341.   Result := 0;
  2342.   If not assigned( BGI.DW ) or ( BGI.DW.FntSel = -1 ) then
  2343.     Exit;
  2344.  
  2345.   with BGI.DW do
  2346.     begin
  2347.       If FntSel = DefaultFont then
  2348.         begin
  2349.           Result := 8*Length(TextString);
  2350.           Exit;
  2351.         end;
  2352.       with BGI.Font[ FntSel ] do
  2353.         for i := 1 to Length( TextString ) do
  2354.           begin
  2355.             ChOffs := ord(TextString[i]) - ord(FirstChar);
  2356.             If ( ChOffs >= 0 ) and ( ChOffs < Chars ) then
  2357.               Inc( Result, CharWidth[ChOffs] );
  2358.           end;
  2359.     end;
  2360.   Result := Round( Result * BGI.DW.xScale );
  2361. end;
  2362.  
  2363. procedure WaitDraw;
  2364. begin
  2365.   If Assigned( BGI.DW ) then
  2366.     BGI.DW.WaitDraw;
  2367. end;
  2368.  
  2369. procedure SuspendRefresh;   // Suspend refreshing of screen
  2370. begin
  2371.   If Assigned( BGI.DW ) then
  2372.     BGI.DW.PauseDisplay := True;
  2373. end;
  2374.  
  2375. procedure EnableRefresh;    // Enable refreshing of screen
  2376. begin
  2377.   If Assigned( BGI.DW ) then
  2378.     BGI.DW.PauseDisplay := False;
  2379. end;
  2380.  
  2381. procedure AcceleratedBlit;  // Enable faster blitting routine (Only updated DIVE.DLL)
  2382. begin
  2383.   If Assigned( BGI.DW ) then
  2384.     BGI.DW.FastBlit := True;
  2385. end;
  2386.  
  2387. procedure SlowBlit;         // Enable slow blitting routine
  2388. begin
  2389.   If Assigned( BGI.DW ) then
  2390.     BGI.DW.FastBlit := False;
  2391. end;
  2392.  
  2393. procedure GetMousePos( var x,y: Word );
  2394. begin
  2395.   x := CurrentMouseX;
  2396.   y := CurrentMouseY;
  2397. end;
  2398.  
  2399. function  ReadKeyOrMouse( TimeOut: Word; var Mouse: Boolean;
  2400.   var Key: Char; var MEvent: MouseEventT; var mx, my: Word ): Boolean;
  2401. var
  2402.   M: MouseEventRecT;
  2403.   StartTime: Integer;
  2404. begin
  2405.   ReadKeyOrMouse := True;
  2406.   StartTime := GetTimemSec;
  2407.   repeat
  2408.     if keypressed then
  2409.       begin
  2410.         Mouse := False;
  2411.         Key := Readkey;
  2412.         Exit;
  2413.       end
  2414.     else if MouseClicked then
  2415.       begin
  2416.         Mouse := True;
  2417.         GetMouseEvent( M );
  2418.         MEvent := M.Event;
  2419.         mx := M.X;
  2420.         my := M.Y;
  2421.         Exit;
  2422.       end
  2423.     else
  2424.       DosSleep( 31 );
  2425.     // Repeat until timeout.  Timeout = -1 means indefinite wait
  2426.   until (TimeOut <> -1) and (GetTimeMSec - StartTime > TimeOut);
  2427.   ReadKeyOrMouse := False;
  2428. end;
  2429.  
  2430. var
  2431.   i: Integer;
  2432.  
  2433. initialization
  2434.   if IsConsole then
  2435.     begin
  2436.       Writeln( 'DGraph can only be used in a PM Application' );
  2437.       halt(2);
  2438.     end;
  2439.   BGI.DW := nil;
  2440.   BGI.Fonts := High(FontNames);
  2441.   for i := Low(FontNames) to High(FontNames) do
  2442.     with BGI.Font[i] do
  2443.       begin
  2444.         FontName := FontNames[i];
  2445.         Linked := false;
  2446.       end;
  2447.   BGI.LastError := grOK;
  2448.   GrStatus := 0;
  2449.   CalcDelayCount;
  2450.   SaveExit := nil;
  2451.   tidMessage := -1;
  2452.   mtx_Mou := tMutexSem.Create;
  2453.   mtx_Kbd := tMutexSem.Create;
  2454. end.
  2455.  
  2456.