home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vpbgib2.zip / GRAPH.PAS < prev    next >
Pascal/Delphi Source File  |  1996-11-02  |  35KB  |  1,249 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Run-time Library v1.1             █}
  4. {█      BGI Graphics unit for mixed BGI/Textmode         █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1996 fPrint UK Ltd                 █}
  7. {█      Written May-Sep 1996 by Allan Mertner            █}
  8. {█        Inspired by DIVERace by Michael Mrosowski      █}
  9. {█        Pipe interface engineered by Alex Vermeulen    █}
  10. {█                                                       █}
  11. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  12.  
  13. Unit Graph;
  14.  
  15. Interface
  16.  
  17. {$Delphi+}
  18.  
  19. Uses
  20.   Use32, SysUtils;
  21.  
  22. type
  23.   Str12 = String[12];
  24.   EGraph = class(Exception);
  25.  
  26. Const
  27.   grOk                =  0;  // error status values reported by graphresult }
  28.   grNoInitGraph       = -1;  // BGI graphics not installed
  29.   grNotDetected       = -2;  // Graphics hardware not detected
  30.   grFileNotFound      = -3;  // Device driver file not found
  31.   grInvalidDriver     = -4;  // Invalid device driver file
  32.   grNoLoadMem         = -5;  // Not enough memory to load driver
  33.   grNoScanMem         = -6;  // Out of memory in scan fill
  34.   grNoFloodMem        = -7;  // Out of memory in flood fill
  35.   grFontNotFound      = -8;  // Font file not found
  36.   grNoFontMem         = -9;  // Not enough memory to load font
  37.   grInvalidMode       = -10; // Invalid graphics mode for selected driver
  38.   grError             = -11; // Graphics error (generic error)
  39.   grIOerror           = -12; // Graphics I/O error
  40.   grInvalidFont       = -13; // Invalid font file
  41.   grInvalidFontNum    = -14; // Invalid font number
  42.  
  43.   Detect              = 0;
  44.   Black               = 0;   // Colour values
  45.   Blue                = 1;
  46.   Green               = 2;
  47.   Cyan                = 3;
  48.   Red                 = 4;
  49.   Magenta             = 5;
  50.   Brown               = 6;
  51.   LightGray           = 7;
  52.   DarkGray            = 8;
  53.   LightBlue           = 9;
  54.   LightGreen          = 10;
  55.   LightCyan           = 11;
  56.   LightRed            = 12;
  57.   LightMagenta        = 13;
  58.   Yellow              = 14;
  59.   White               = 15;
  60.   EGA_Black           = 0;   // different than DOS BGI values
  61.   EGA_Blue            = 1;
  62.   EGA_Green           = 2;
  63.   EGA_Cyan            = 3;
  64.   EGA_Red             = 4;
  65.   EGA_Magenta         = 5;
  66.   EGA_Brown           = 6;
  67.   EGA_LightGray       = 7;
  68.   EGA_DarkGray        = 8;
  69.   EGA_LightBlue       = 9;
  70.   EGA_LightGreen      = 10;
  71.   EGA_LightCyan       = 11;
  72.   EGA_LightRed        = 12;
  73.   EGA_LightMagenta    = 13;
  74.   EGA_Yello           = 14;
  75.   EGA_White           = 15;
  76.  
  77.   NormWidth           = 1;   // constants for line thickness
  78.   ThickWidth          = 3;
  79.  
  80.   SolidLn             = 0;   // constants for line patterns
  81.   DottedLn            = 1;
  82.   CenterLn            = 2;
  83.   DashedLn            = 3;
  84.   UserBitLn           = 4;
  85.  
  86.   DefaultFont         = 0;   // font constants for settextstyle
  87.   TriplexFont         = 1;
  88.   SmallFont           = 2;
  89.   SansSerifFont       = 3;
  90.   GothicFont          = 4;
  91.   ScriptFont          = 5;
  92.   SimplexFont         = 6;
  93.   TriplexScrFont      = 7;
  94.   ComplexFont         = 8;
  95.   EuropeanFont        = 9;
  96.   BoldFont            = 10;
  97.   FontNames : Array[1..10] of Str12
  98.             = ( 'TRIP.CHR', 'LITT.CHR', 'SANS.CHR', 'GOTH.CHR', 'SCRI.CHR',
  99.                 'SIMP.CHR', 'TSCR.CHR', 'LCOM.CHR', 'EURO.CHR', 'BOLD.CHR' );
  100.  
  101.   HorizDir            =  0;
  102.   VertDir             =  90;
  103.   UserCharSize        =  0;
  104.  
  105.   ClipOn              =  TRUE;
  106.   ClipOff             =  FALSE;
  107.  
  108.   TopOn               =  TRUE;
  109.   TopOff              =  FALSE;
  110.  
  111.   EmptyFill           = 0;   // fill patterns
  112.   SolidFill           = 1;
  113.   LineFill            = 2;
  114.   LtSlashFill         = 3;
  115.   SlashFill           = 4;
  116.   BkSlashFill         = 5;
  117.   LtBkSlashFill       = 6;
  118.   HatchFill           = 7;
  119.   XHatchFill          = 8;
  120.   InterleaveFill      = 9;
  121.   WideDotFill         = 10;
  122.   CloseDotFill        = 11;
  123.   UserFill            = 12;
  124.  
  125.   NormalPut           = 0;   // operators for image blits and setwritemode
  126.   CopyPut             = 0;
  127.   XORPut              = 1;
  128.   OrPut               = 2;
  129.   AndPut              = 3;
  130.   NotPut              = 4;
  131.  
  132.   LeftText            = 0;   // text justification constants
  133.   CenterText          = 1;
  134.   RightText           = 2;
  135.   BottomText          = 0;
  136.   TopText             = 2;
  137.  
  138.   MaxColors           = 255; // Different from DOS
  139.  
  140.   LinePatterns        : Array[0..3] of Word
  141.                       = ( $FFFFFFFF, $33333333, $3CCF3CCF, $0F0F0F0F );
  142.  
  143. type
  144.   str4 = String[4];
  145.   FillPatternType       = array [1..8] of Byte;
  146.   NewPatternType        = array [0..15] of SmallWord;
  147.   IntArray              = array [0..65000] of Integer;
  148.  
  149.   PaletteType           = record
  150.                               Size    : word;
  151.                               Colors  : array [0..MaxColors] of Byte;
  152.                           end;
  153.  
  154.   LineSettingsType      = record
  155.                               LineStyle : Word;
  156.                               Pattern   : Word;
  157.                               Thickness : Word;
  158.                           end;
  159.  
  160.   TextSettingsType      = record
  161.                               Font      : Word;
  162.                               Direction : Word;
  163.                               CharSize  : Integer;      { different than DOS BGI }
  164.                               Horiz     : Word;
  165.                               Vert      : Word;
  166.                               userxscale: double;
  167.                               useryscale: double;
  168.                           end;
  169.  
  170.   FillSettingsType      = record
  171.                               Pattern   : Word;
  172.                               Color     : Word;
  173.                           end;
  174.  
  175.   PointType             = record
  176.                               X         : Integer;
  177.                               Y         : Integer;
  178.                           end;
  179.   PointArray = Array[0..65000] of PointType;
  180.  
  181.   ViewPortType          = record
  182.                               X1        : Integer;
  183.                               Y1        : Integer;
  184.                               X2        : Integer;
  185.                               Y2        : Integer;
  186.                               Clip      : Boolean;
  187.                           end;
  188.  
  189.   ArcCoordsType         = record
  190.                               X         : Integer;
  191.                               Y         : Integer;
  192.                               Xstart    : Integer;
  193.                               Ystart    : Integer;
  194.                               Xend      : Integer;
  195.                               Yend      : Integer;
  196.                           end;
  197.  
  198.   MouseEventT =
  199.     ( mb1Click, mb1DblClick, mb1BeginDrag, mb1EndDrag, mb1Down, mb1Up,
  200.       mb2Click, mb2DblClick, mb2BeginDrag, mb2EndDrag, mb2Down, mb2Up );
  201.  
  202.   MouseEventRecT = record
  203.     Event : MouseEventT;
  204.     X,Y   : Word;
  205.   end;
  206.  
  207. { BGI Function Prototypes }
  208.  
  209. Procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  210. Procedure Bar(X1, Y1, X2, Y2: Integer);
  211. Procedure Bar3D(X1, Y1, X2, Y2: Integer; Depth: Word; Top: Boolean);
  212. Procedure Circle(X, Y: Integer; Radius: Word);
  213. Procedure ClearDevice;
  214. Procedure ClearViewport;
  215. Procedure CloseGraph;
  216. procedure DetectGraph(var GraphDriver, GraphMode: Integer);
  217. Procedure DrawPoly(NumPoints: Word; var PolyPoints);
  218. Procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius: Word);
  219. Procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  220. Procedure FillPoly(NumPoints: Word; var PolyPoints);
  221. Procedure FloodFill(X, Y: Integer; Border: Word);
  222. Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  223. Procedure GetAspectRatio(var Xasp, Yasp: Word);
  224. Function  GetBkColor: Word;
  225. Function  GetColor: Word;
  226. Procedure GetDefaultPalette(var Palette: PaletteType);
  227. Function  GetDriverName: string;
  228. Procedure GetFillPattern(var FillPattern: FillPatternType);
  229. Procedure GetFillSettings(var FillInfo: FillSettingsType);
  230. function  GetGraphMode: Integer;
  231. procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
  232. Procedure GetLineSettings(var LineInfo: LineSettingsType);
  233. Function  GetMaxColor: Word;
  234. Function  GetMaxX: Word;
  235. Function  GetMaxY: Word;
  236. Function  GetModeName(ModeNumber: Integer): string;
  237. Procedure GetPalette(var Palette: PaletteType);
  238. Function  GetPaletteSize: Integer;
  239. Function  GetPixel(X,Y: Integer): Word;
  240. Procedure GetTextSettings(var TextInfo: TextSettingsType);
  241. Procedure GetViewSettings(var ThisViewPort: ViewPortType);
  242. Function  GetX: Integer;
  243. Function  GetY: Integer;
  244. Procedure GraphDefaults;
  245. Function  GraphErrorMsg(ErrorCode: Integer): String;
  246. Function  GraphResult: Integer;
  247. function  ImageSize(x1, y1, x2, y2: Integer): Word;
  248. procedure InitGraph(var GraphDriver:Integer; var GraphMode: Integer;
  249.     PathToDriver: string);
  250. Function  InstallUserFont(FontFileName: string) : Integer;
  251. Procedure Line(X1, Y1, X2, Y2: Integer);
  252. Procedure LineRel(Dx, Dy: Integer);
  253. Procedure LineTo(X, Y: Integer);
  254. Procedure MoveRel(Dx, Dy: Integer);
  255. Procedure MoveTo(X, Y: Integer);
  256. Procedure OutText(TextString: string);
  257. Procedure OutTextXY(X, Y: Integer; TextString: string);
  258. Procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  259. procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
  260. Procedure PutPixel(X, Y: Integer; Color: Word);
  261. Procedure Rectangle(X1, Y1, X2, Y2: Integer);
  262. Procedure RegisterBGIFont(FontID: Integer; Font: Pointer);
  263. Procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
  264. Procedure SetAllPalette(var Palette: PaletteType);
  265. Procedure SetAspectRatio(Xasp, Yasp: Word);
  266. Procedure SetBkColor(ColorNum: Word);
  267. Procedure SetColor(Color: Word);
  268. Procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
  269. Procedure SetFillStyle(Pattern: Word; Color: Word);
  270. Procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
  271. Procedure SetPalette(ColorNum: Word; Color: Byte);
  272. Procedure SetRGBPalette(ColorNum: Word; Red, Green, Blue: Byte);
  273. Procedure SetTextJustify(Horiz, Vert: Word);
  274. Procedure SetTextStyle(Font, Direction, CharSize: Integer);
  275. Procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
  276. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  277. Procedure SetWriteMode(WriteMode: Integer);
  278. Function  TextHeight(TextString: string): Word;
  279. Function  TextWidth(TextString: string): Word;
  280.  
  281. // VP additional BGI functions
  282. procedure SetWideFillPattern(Pattern: NewPatternType; Color: Word);
  283. procedure VPInitGraph( xRes, yRes: Integer; PathToDriver: string);
  284. procedure FlushDisplay;              // Update BGI screen immediately
  285.  
  286. // VP functions for controlling the mouse
  287. procedure GetMousePos( var x,y: Word );
  288. function  ReadKeyOrMouse( TimeOut: Word; var Mouse: Boolean;
  289.   var Key: Char; var MEvent: MouseEventT; var mx, my: Word ): Boolean;
  290. function  MouseClicked: Boolean;
  291. procedure GetMouseEvent( var M: MouseEventRecT );
  292.  
  293. // VP functions replacing CRT functions
  294. function Keypressed: Boolean;        // Keypressed for both Server and Client
  295. function ReadKey: Char;
  296.  
  297. // VP constants modifying behaviour of Graph
  298. const
  299.   WaitKeypressed  : Boolean = False; // Delay() when calling keypressed
  300.   AutoStartServer : Boolean = True;  // Start BGI server proces in InitGraph
  301.   ImmediateUpdate : Boolean = True;  // Process all requests immediately
  302.   MinFrameRate    : Longint = 5;     // Minimum frame rate
  303.  
  304. Implementation
  305.  
  306. uses Os2Def, Os2Base, Crt, Dos, VPUtils, BgiMsg, Mutex;
  307.  
  308. const
  309.   Stopping        : boolean = false; // True when BGI is stopping
  310.   tid_BGI         : tid = 0;         // BGI Update Thread
  311.   tid_Kbd1        : tid = 0;         // Local Keyboard watch thread
  312.   tid_Kbd2        : tid = 0;         // Remote Keyboard watch thread
  313.   mtx_Kbd         : tMutexSem = nil; // Keyboard mutex sem
  314.   mtx_Mou         : tMutexSem = nil; // Mouse mutex sem
  315.   mtx_BGI         : tMutexSem = nil; // BGI Update semaphore
  316.   KeyCount        : Integer = 0;     // Count of keys in KeyBuffer
  317.   MouCount        : Integer = 0;     // Count of event in MouBuffer
  318.   ServerSessionId : ULong = -1;      // Process ID of GraphSrv
  319.   que_Input       : HQueue = 0;      // Queue ID for input queue
  320.   CurrentMouseX   : Word = 0;        // Current mouse position, X
  321.   CurrentMouseY   : Word = 0;        // Current mouse position, Y
  322.  
  323. var
  324.   F         : File;
  325.   DispPtr   : word;
  326.   DispList  : DisplayListT;
  327.   com       : CommandListT;
  328.   bgires    : BGIResArT;
  329.   KeyBuffer : array[0..127] of Char; // Keyboard type-ahead buffer
  330.   MouBuffer : array[0..127] of MouseEventRecT; // Mouse input buffer
  331.  
  332. procedure waitforpipe;
  333. var
  334.   cnt : Word;
  335.   res : word;
  336. begin
  337.   if filerec(f).Handle > 0 then
  338.     exit;
  339.  
  340.   // Create input queue used to capture input from BGI process
  341.   BGIQueueName[Length(BGIQueueName)+1] := #0;
  342.   Res := DosCreateQueue( que_input, que_fifo, @BGIQueueName[1] );
  343.   if Res <> No_Error then
  344.     raise EGraph.CreateFmt( 'Cannot connect to input queue; rc = ',[Res] );
  345.  
  346.   // Connect to pipe
  347.   fileMode := open_Access_ReadWrite Or Open_Share_DenyReadWrite Or
  348.               Open_Flags_Fail_On_Error;
  349.   cnt:=0;
  350.   repeat
  351.     inc(cnt);
  352.     if cnt > 500 then
  353.       raise EGraph.Create( 'Cannot establish connection to Graph Server process' );
  354.     {$I-}
  355.     Reset(f,1);
  356.     {$I+}
  357.     res:=IOREsult;
  358.     if res<>0 then
  359.       DosSleep(50);
  360.   until Res=0;
  361. end;
  362.  
  363. procedure ConnectionBroken;
  364. const
  365.   Exited: Boolean = False;
  366. var
  367.   Count: Longint;
  368.   rc: ApiRet;
  369. begin
  370.   // Make sure function is not called by 2 threads
  371.   if Exited then Halt(1);
  372.   Exited := True;
  373.   // Release all semaphores
  374.   Mtx_BGI.Release;
  375.   Mtx_Kbd.Release;
  376.  
  377.   Count := 0;
  378.   // Try to wait for server process to terminate so it can
  379.   // display any messages explaining the reason for the break
  380.   if ServerSessionId > 0 then
  381.     repeat
  382.       rc := DosSelectSession( ServerSessionId );
  383.       DosSleep( 50 );
  384.       inc( Count );
  385.     until (( rc <> Error_Smg_No_Target_Window ) and ( rc <> no_Error ) )
  386.       or ( Count > 50 );
  387.  
  388.   // Raise exception, terminating both this and the server program
  389.   raise EGraph.Create( 'Connection to Graph Server process broken' );
  390. end;
  391.  
  392. procedure flushdisplay;
  393. var
  394.   ulRead : Word;
  395.   Res    : Word;
  396.   rc     : ApiRet;
  397.  
  398. begin
  399.   if DispPtr=0 then Exit;
  400.   mtx_BGI.Request;
  401.  
  402.   if DispPtr=0 then
  403.     begin
  404.       // If display has been updated, exit
  405.       mtx_BGI.Release;
  406.       exit;
  407.     end;
  408.  
  409.   rc := DosTransactNPipe( FileRec(F).Handle,
  410.     DispList, DispPtr*Sizeof(word),
  411. //  The following line works around an error in Os2Base.Pas:
  412.     Res, Sizeof(Res), Longint(@ulRead) );
  413. //  The following line should be used in the fixed Os2Base.Pas:
  414. //  Res, Sizeof(Res), ulRead );
  415.   if rc <> 0 then
  416.     ConnectionBroken;
  417.   DispPtr:=0;
  418.   mtx_BGI.Release;
  419. end;
  420.  
  421. procedure askbgi(func,nrpar,nrret:word);
  422. var
  423.   t,
  424.   ulRead : word;
  425.   snd    : array [0..2] of word;
  426.   rc     : ApiRet;
  427.  
  428. begin
  429.   flushdisplay;
  430.  
  431.   mtx_BGI.Request;
  432.   DispList.w[DispPtr]:=func;
  433.   DispList.w[DispPtr+1]:=nrpar;
  434.   DispList.w[DispPtr+2]:=nrret;
  435.   for t:=0 to nrpar-1 do
  436.     DispList.i[DispPtr+t+3]:=com.i[t];
  437.  
  438.   rc := DosTransactNPipe( FileRec(F).Handle,
  439.     DispList, (nrpar+3)*Sizeof(word),
  440. //  The following line works arounf an error in Os2Base.Pas:
  441.     BgiRes, NrRet*Sizeof(Word), Longint(@ulRead) );
  442. //  BgiRes, NrRet*Sizeof(Word), ulRead );
  443.  
  444.   if rc <> 0 then
  445.     ConnectionBroken;
  446.   DispPtr:=0;
  447.  
  448.   mtx_BGI.Release;
  449. end;
  450.  
  451. procedure callbgi(func,nrpar:Word);
  452. var
  453.   t : word;
  454. begin
  455.   if ImmediateUpdate then
  456.     // Process all requests immediately - for animated graphics
  457.     askbgi( func, nrpar, 1 )
  458.   else
  459.     begin
  460.       // Process requests in chunks; lower overhead, but less
  461.       // pleasant for animated graphics
  462.       if DispPtr+NrPar+3>MaxDisp then
  463.         flushdisplay;
  464.  
  465.       mtx_BGI.Request;
  466.       DispList.w[DispPtr]:=func;
  467.       DispList.w[DispPtr+1]:=nrpar;
  468.       DispList.w[DispPtr+2]:=0;
  469.       for t:=0 to nrpar-1 do
  470.         DispList.i[DispPtr+t+3]:=com.i[t];
  471.       DispPtr:=DispPtr+nrpar+3;
  472.       mtx_BGI.Release;
  473.     end;
  474. end;
  475.  
  476. Procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  477. begin
  478.   com.i[0]:=x;com.i[1]:=y;
  479.   com.w[2]:=StAngle;com.w[3]:=EndAngle;com.w[4]:=Radius;
  480.   callbgi(1,5);
  481. end;
  482.  
  483. Procedure Bar(X1, Y1, X2, Y2: Integer);
  484. begin
  485.   com.i[0]:=x1;com.i[1]:=y1;
  486.   com.i[2]:=x2;com.i[3]:=y2;
  487.   callbgi(2,4);
  488. end;
  489.  
  490. Procedure Bar3D(X1, Y1, X2, Y2: Integer; Depth: Word; Top: Boolean);
  491. begin
  492.   com.i[0]:=x1;com.i[1]:=y1;
  493.   com.i[2]:=x2;com.i[3]:=y2;
  494.   com.w[4]:=Depth;if Top then com.w[5]:=1 else com.w[5]:=1;
  495.   callbgi(3,6);
  496. end;
  497.  
  498. Procedure Circle(X, Y: Integer; Radius: Word);
  499. begin
  500.   com.i[0]:=x;com.i[1]:=y;
  501.   com.w[2]:=Radius;
  502.   callbgi(4,3);
  503. end;
  504.  
  505. Procedure ClearDevice;
  506. begin
  507.   callbgi(5,0);
  508. end;
  509.  
  510. Procedure ClearViewport;
  511. begin
  512.   callbgi(6,0);
  513. end;
  514.  
  515. Procedure CloseGraph;
  516. begin
  517.   if tid_BGI = 0 then Exit;
  518.  
  519.   callbgi(7,0);  // CloseGraph() call to Server Process
  520.  
  521.   Stopping := True;
  522.   DosWaitThread( tid_BGI, dcww_Wait );
  523.   tid_BGI := 0;
  524. end;
  525.  
  526. procedure DetectGraph(var GraphDriver, GraphMode: Integer);
  527. begin
  528.   askbgi(8,0,2);
  529.   GraphDriver:=bgires[0];GraphMode:=bgires[1];
  530. end;
  531.  
  532. Procedure DrawPoly(NumPoints: Word; var PolyPoints);
  533. begin
  534.   com.nr:=NumPoints;
  535.   move(PolyPoints,com.pts,2*NumPoints*SizeOf(integer));
  536.   callbgi(9,1+NumPoints*2);
  537. end;
  538.  
  539. Procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius: Word);
  540. begin
  541.   com.i[0]:=x;com.i[1]:=y;
  542.   com.w[2]:=stAngle;com.w[3]:=EndAngle;
  543.   com.w[4]:=XRadius;com.w[5]:=YRadius;
  544.   callbgi(10,6);
  545. end;
  546.  
  547. Procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  548. begin
  549.   com.i[0]:=x;com.i[1]:=y;
  550.   com.w[2]:=XRadius;com.w[3]:=YRadius;
  551.   callbgi(11,6);
  552. end;
  553.  
  554. Procedure FillPoly(NumPoints: Word; var PolyPoints);
  555. begin
  556.   com.nr:=NumPoints;
  557.   move(PolyPoints,com.pts,2*NumPoints*SizeOf(integer));
  558.   callbgi(12,1+NumPoints*2);
  559. end;
  560.  
  561. Procedure FloodFill(X, Y: Integer; Border: Word);
  562. begin
  563.   com.x1:=x;com.y1:=y;com.w3:=border;
  564.   callbgi(13,3);
  565. end;
  566.  
  567. Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  568. begin
  569.   askbgi(14,0,6);
  570.   move(bgires,ArcCoords,sizeof(ArcCoords));
  571. end;
  572.  
  573. Procedure GetAspectRatio(var Xasp, Yasp: Word);
  574. begin
  575.   askbgi(15,0,2);
  576.   xasp:=bgires[0];yasp:=bgires[1];
  577. end;
  578.  
  579. Function  GetBkColor: Word;
  580. begin
  581.   askbgi(16,0,1);
  582.   GetBkColor:=bgires[0];
  583. end;
  584.  
  585. Function  GetColor: Word;
  586. begin
  587.   askbgi(17,0,1);
  588.   GetColor:=bgires[0];
  589. end;
  590.  
  591. Procedure GetDefaultPalette(var Palette: PaletteType);
  592. begin
  593.   askbgi(18,0,SizeOf(Palette) div Sizeof(word));
  594.   move(bgires,palette,sizeof(palette));
  595. end;
  596.  
  597. Function  GetDriverName: string;
  598. var
  599.   s : string;
  600. begin
  601.   askbgi(19,0,Sizeof(s) div Sizeof(word));
  602.   move(bgires,s,sizeof(s));
  603.   GetDrivername:=s;
  604. end;
  605.  
  606. Procedure GetFillPattern(var FillPattern: FillPatternType);
  607. begin
  608.   askbgi(20,0,Sizeof(FillPattern) div Sizeof(word));
  609.   move(bgires,fillpattern,sizeof(fillpattern));
  610. end;
  611.  
  612. Procedure GetFillSettings(var FillInfo: FillSettingsType);
  613. begin
  614.   askbgi(21,0,Sizeof(FillInfo) div Sizeof(word));
  615.   move(bgires,fillinfo,sizeof(fillinfo));
  616. end;
  617.  
  618. function  GetGraphMode: Integer;
  619. begin
  620.   askbgi(22,0,1);
  621.   getgraphmode:=bgires[0];
  622. end;
  623.  
  624. procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
  625. var
  626.   Buffer: Pointer;
  627.   Bufsize: Longint;
  628.   rc: ApiRet;
  629. begin
  630.   // Allocate shared memory region for transfer
  631.   BufSize := ImageSize( x1, y1, x2, y2 );
  632.   rc := DosAllocSharedMem( Buffer, nil, BufSize,
  633.     pag_read or pag_write or pag_commit or obj_gettable );
  634.   com.i[0]:=x1;com.i[1]:=y1;com.i[2]:=x2;com.i[3]:=y2;com.i[4]:=Longint(Buffer);
  635.   askbgi(23,5,1);
  636.  
  637.   // Move image to user buffer
  638.   if bgires[0] = 0 then
  639.     move( Buffer^, BitMap, BufSize );
  640.  
  641.   // Destroy shared memory area
  642.   rc := DosFreeMem( Buffer );
  643. end;
  644.  
  645. Procedure GetLineSettings(var LineInfo: LineSettingsType);
  646. begin
  647.   askbgi(24,0,Sizeof(LineInfo) div Sizeof(word));
  648.   move(bgires,lineinfo,sizeof(Lineinfo));
  649. end;
  650.  
  651. Function  GetMaxColor: Word;
  652. begin
  653.   askbgi(25,0,1);
  654.   getmaxcolor:=bgires[0];
  655. end;
  656.  
  657. Function  GetMaxX: Word;
  658. begin
  659.   askbgi(26,0,1);
  660.   getmaxx:=bgires[0];
  661. end;
  662.  
  663. Function  GetMaxY: Word;
  664. begin
  665.   askbgi(27,0,1);
  666.   getmaxy:=bgires[0];
  667. end;
  668.  
  669. Function  GetModeName(ModeNumber: Integer): string;
  670. var
  671.   s : string;
  672. begin
  673.   com.i1:=ModeNumber;
  674.   askbgi(28,1,Sizeof(s) div Sizeof(word));
  675.   move(bgires,s,sizeof(s));
  676.   GetModename:=s;
  677. end;
  678.  
  679. Procedure GetPalette(var Palette: PaletteType);
  680. begin
  681.   askbgi(29,0,Sizeof(Palette) div Sizeof(word));
  682.   move(bgires,palette,sizeof(Palette));
  683. end;
  684.  
  685. Function  GetPaletteSize: Integer;
  686. begin
  687.   askbgi(30,0,1);
  688.   GetPaletteSize:=bgires[0];
  689. end;
  690.  
  691. Function  GetPixel(X,Y: Integer): Word;
  692. begin
  693.   com.x1:=x;com.y1:=y;
  694.   askbgi(31,2,1);
  695.   getpixel:=bgires[0];
  696. end;
  697.  
  698. Procedure GetTextSettings(var TextInfo: TextSettingsType);
  699. begin
  700.   askbgi(32,0,Sizeof(textInfo) div Sizeof(word));
  701.   move(bgires,textinfo,sizeof(textinfo));
  702. end;
  703.  
  704. Procedure GetViewSettings(var ThisViewPort: ViewPortType);
  705. begin
  706.   askbgi(33,0,Sizeof(ThisViewPort) div Sizeof(word));
  707.   move(bgires,ThisViewPort,sizeof(ThisViewPort));
  708. end;
  709.  
  710. Function  GetX: Integer;
  711. begin
  712.   askbgi(34,0,1);
  713.   getx:=bgires[0];
  714. end;
  715.  
  716. Function  GetY: Integer;
  717. begin
  718.   askbgi(35,0,1);
  719.   gety:=bgires[0];
  720. end;
  721.  
  722. Procedure GraphDefaults;
  723. begin
  724.   flushdisplay;
  725.   callbgi(36,0);
  726. end;
  727.  
  728. Function  GraphErrorMsg(ErrorCode: Integer): String;
  729. begin
  730.   GraphErrorMsg:='';
  731. end;
  732.  
  733. Function  GraphResult: Integer;
  734. begin
  735.   flushdisplay;
  736.   graphresult:=0;
  737. end;
  738.  
  739. function  ImageSize(x1, y1, x2, y2: Integer): Word;
  740. begin
  741.   // Don't ask BGI about a multiplication
  742.   ImageSize := (x2-x1+1)*(y2-y1+1)+6;
  743. end;
  744.  
  745. procedure PushKey(Ch: Char);
  746. begin
  747.   mtx_Kbd.Request;
  748.   if KeyCount < SizeOf(KeyBuffer) then
  749.   begin
  750.     KeyBuffer[KeyCount] := Ch;
  751.     Inc(KeyCount);
  752.   end;
  753.   mtx_Kbd.Release;
  754. end;
  755.  
  756. procedure PushMouse( MouEvent: MouseEventT; MouX,MouY: Word);
  757. begin
  758.   mtx_Mou.Request;
  759.   if MouCount < SizeOf(MouBuffer) then
  760.     with MouBuffer[MouCount] do
  761.       begin
  762.         Event := MouEvent;
  763.         X := MouX;
  764.         Y := MouY;
  765.         Inc(MouCount);
  766.       end;
  767.   mtx_Mou.Release;
  768. end;
  769.  
  770. function MouseClicked: Boolean;
  771. begin
  772.   MouseClicked := MouCount > 0;
  773. end;
  774.  
  775. procedure GetMouseEvent( var M: MouseEventRecT );
  776. begin
  777.   while not MouseClicked do
  778.     DosSleep( 31 );
  779.   mtx_Mou.Request;
  780.   M := MouBuffer[0];
  781.   Dec( MouCount );
  782.   move( MouBuffer[1], MouBuffer[0], MouCount*Sizeof(MouBuffer[0]) );
  783.   mtx_Mou.Release;
  784. end;
  785.  
  786. function Keypressed: Boolean;
  787. begin
  788.   KeyPressed := KeyCount > 0;
  789.   If ( KeyCount = 0 ) and (WaitKeypressed or (DispPtr > 100)) then
  790.     // if no key was waiting, pause thread to allow update of
  791.     // screen, if WaitKeyPressed or many items to be processed
  792.     DosSleep( 1 );
  793. end;
  794.  
  795. function ReadKey: Char;
  796. begin
  797.   while not KeyPressed do
  798.     // If Keypressed did not wait, wait here
  799.     if not WaitKeyPressed then
  800.       DosSleep( 31 );
  801.   mtx_Kbd.Request;
  802.   ReadKey := KeyBuffer[0];
  803.   Dec(KeyCount);
  804.   Move(KeyBuffer[1], KeyBuffer[0], KeyCount);
  805.   mtx_Kbd.Release;
  806. end;
  807.  
  808. // Thread updating display at least MinFrameRate times per second
  809. function BGIUpdateThread( p: Pointer ): Longint;
  810. begin
  811.   while not Stopping do
  812.     begin
  813.       if DispPtr <> 0 then
  814.         FlushDisplay;
  815.       DosSleep( 1000 div MinFrameRate );
  816.     end;
  817. end;
  818.  
  819. // Thread routing keyboard input TXT screen
  820. function BGILocalKeyboardThread( p: Pointer ): Longint;
  821. begin
  822.   While not Stopping do
  823.     // Add next keystroke to BGI buffer
  824.     PushKey( Crt.Readkey )
  825. end;
  826.  
  827. // Thread routing keyboard input from BGI screen
  828. function BGIRemoteKeyboardThread( p: Pointer ): Longint;
  829. var
  830.   RData: RequestData;
  831.   cbData: ULong;
  832.   Buffer: Pointer;
  833.   Priority: Byte;
  834.   rc: ApiRet;
  835. begin
  836.   While not Stopping do
  837.     begin
  838.       // Wait for key to be pressed in BGI window
  839.       rc := DosReadQueue( que_input, RData, cbData, Buffer, 0,
  840.               dcww_Wait, Priority, 0 );
  841.       // If succesful, add to BGI buffer
  842.       if rc = 0 then
  843.         case RData.Data of
  844.           bgi_Init : DosGetSharedMem( Buffer, pag_Read );
  845.           bgi_Key  : PushKey( InputT(Buffer^).Ch );
  846.           bgi_MPos : with InputT(Buffer^) do
  847.             begin
  848.               CurrentMouseX := X;
  849.               CurrentMouseY := Y;
  850.             end;
  851.           bgi_Mou  : with InputT(Buffer^) do
  852.             PushMouse( MouseEventT(EventType), EventX, EventY );
  853.         end
  854.     end;
  855. end;
  856.  
  857. // Make checks to see if DIVE is installed and if it is
  858. // the buggy version from Warp or a newer one
  859. procedure VerifyDiveVersion;
  860. const
  861.   initErr: pChar = 'GRAPH initialization error';
  862. var
  863.   rc: Longint;
  864.   Buffer: array[0..259] of Char;
  865.   dll_Dive: Longint;
  866.   s: String;
  867.   Age: Longint;
  868.   Date: TDateTime;
  869.   Year, Month, Day: SmallWord;
  870.  
  871. begin
  872.   rc := DosLoadModule(Buffer, SizeOf(Buffer), 'DIVE', dll_Dive);
  873.   if rc <> 0 then
  874.     raise EGraph.Create( 'Dive not installed on system. Application terminated' );
  875.  
  876.   rc := DosQueryModuleName( dll_Dive, Sizeof(Buffer), Buffer );
  877.   if rc <> 0 then
  878.     raise EGraph.CreateFmt( 'Cannot load DIVE.DLL; rc = %d. Application terminated', [rc] );
  879.  
  880.   Age := FileAge( StrPas( Buffer ) );
  881.   Date := FileDateToDateTime( Age );
  882.   DecodeDate(Date, Year, Month, Day);
  883.  
  884.   If Year < 1995 then
  885.     raise EGraph.Create( 'DIVE installed is very outdated and cannot be used' );
  886.  
  887.   DosFreeModule( dll_Dive );
  888. end;
  889.  
  890. procedure _InitGraph( xRes, yRes: Integer; const PathToDriver: string);
  891. var
  892.   rc: ApiRet;
  893.   SD: StartData;
  894.   IdProcess : ULong;
  895.   s: String;
  896.   Count: Longint;
  897.   CommName: String;
  898. begin
  899.   DispPtr:=0;
  900.  
  901.   // if AutoStartServer is false, the BGI server process must be started
  902.   // manually by executing GRAPHSRV.EXE.
  903.   if AutoStartServer then
  904.     begin
  905.       // First verify presence of DIVE, copying routine from Os2Dive
  906.       VerifyDiveVersion;
  907.  
  908.       // Set up unique pipe name to allow multiple instances of
  909.       // this program to run safely
  910.       CommName := 'BGI'+                           // Pipe prefix
  911.                   Int2Hex( GetForegroundProcessID, 4 )+  // Process ID
  912.                   Int2Hex( GetTimeMSec, 8 );             // Time in ms
  913.       BGIPipeName := '\PIPE\'+CommName;
  914.       BGIQueueName := '\QUEUES\'+CommName;
  915.       s := Format( '/B%s /P%s /X%d /Y%d'#0, [PathToDriver, BGIPipeName, xres, yres] );
  916.       // Spawn Graph Server process
  917.       fillchar( sd, sizeof(sd), 0 );
  918.       with SD do
  919.         begin
  920.           Length      := sizeof(StartData);
  921.           Related     := ssf_Related_Child;
  922.           FgBg        := ssf_FgBg_Fore;
  923.           TraceOpt    := ssf_TraceOpt_None;
  924.           PgmTitle    := 'VP/2 BGI Graphics Server Process';
  925.           PgmName     := 'graphsrv.exe';
  926.           PgmInputs   := @s[1];
  927.  
  928.           TermQ       := nil;
  929.           Environment := nil;
  930.           InheritOpt  := ssf_InhertOpt_Parent;
  931.           SessionType := ssf_Type_Pm;
  932.           IconFile    := nil;
  933.           PgmHandle   := 0;
  934.           PgmControl  := ssf_Control_Visible;
  935.         end;
  936.       rc := DosStartSession( SD, ServerSessionId, IdProcess );
  937.       if ( rc <> No_Error ) and ( rc <> error_Smg_Start_In_Background ) then
  938.         begin
  939.           Writeln( 'Graph Server Process GRAPHSRV.EXE not found' );
  940.           halt(1);
  941.         end;
  942.     end; // If AutoStartServer
  943.  
  944. {$I-}
  945.   Close(f);
  946.   Assign(f,BGIPipeName);
  947. {$I+}
  948.   if ioresult <> 0 then ;
  949.   WaitForPipe;
  950.   Stopping := False;
  951.   // Start thread for trigging regular screen update
  952.   tid_BGI := VPBeginThread( BGIUpdateThread, 16384, nil );
  953.   DosSetPriority( prtys_thread, prtyc_timecritical, 0, tid_BGI );
  954.   // Start thread for watching the local keyboard
  955.   tid_Kbd1 := VPBeginThread( BGILocalKeyboardThread, 8192, nil );
  956.   // Start thread for watching the remote keyboard
  957.   tid_Kbd2 := VPBeginThread( BGIRemoteKeyboardThread, 8192, nil );
  958.  
  959.   GraphDefaults;
  960.   ClearDevice;
  961. end;
  962.  
  963. procedure InitGraph(var GraphDriver:Integer; var GraphMode: Integer;
  964.                         PathToDriver: string);
  965. begin
  966.   _InitGraph( 640, 480, PathToDriver );
  967. end;
  968.  
  969. Function  InstallUserFont(FontFileName: string) : Integer;
  970. begin
  971.   com.s:=fontfilename;
  972.   askbgi(41,3,1);
  973.   InstallUserFont:=bgires[0];
  974. end;
  975.  
  976. Procedure Line(X1, Y1, X2, Y2: Integer);
  977. begin
  978.   com.i[0]:=x1;com.i[1]:=y1;
  979.   com.i[2]:=x2;com.i[3]:=y2;
  980.   callbgi(42,4);
  981. end;
  982.  
  983. Procedure LineRel(Dx, Dy: Integer);
  984. begin
  985.   com.i[0]:=dx;com.i[1]:=dy;
  986.   callbgi(43,2);
  987. end;
  988.  
  989. Procedure LineTo(X, Y: Integer);
  990. begin
  991.   com.i[0]:=x;com.i[1]:=y;
  992.   callbgi(44,2);
  993. end;
  994.  
  995. Procedure MoveRel(Dx, Dy: Integer);
  996. begin
  997.   com.i[0]:=dx;com.i[1]:=dy;
  998.   callbgi(45,2);
  999. end;
  1000.  
  1001. Procedure MoveTo(X, Y: Integer);
  1002. begin
  1003.   com.i[0]:=x;com.i[1]:=y;
  1004.   callbgi(46,2);
  1005. end;
  1006.  
  1007. Procedure OutText(TextString: string);
  1008. begin
  1009.   com.i[0]:=0;com.i[1]:=0;
  1010.   com.s:=TextString;
  1011.   callbgi(47,3+(length(TextString) div sizeof(word)));
  1012. end;
  1013.  
  1014. Procedure OutTextXY(X, Y: Integer; TextString: string);
  1015. begin
  1016.   com.i[0]:=x;com.i[1]:=y;
  1017.   com.s:=TextString;
  1018.   callbgi(48,3+(length(TextString) div sizeof(word)));
  1019. end;
  1020.  
  1021. Procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  1022. begin
  1023.   com.i[0]:=x;com.i[1]:=y;
  1024.   com.w[2]:=StAngle;com.w[3]:=EndAngle;com.w[4]:=Radius;
  1025.   callbgi(49,5);
  1026. end;
  1027.  
  1028. procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
  1029. var
  1030.   Buffer: pChar;
  1031.   Bufsize: Longint;
  1032.   rc: ApiRet;
  1033. begin
  1034.   // Allocate shared memory region for transfer
  1035.   Buffer  := @Bitmap;
  1036.   BufSize := pSmallWord(Buffer)^;   inc(Buffer,sizeof(smallword));
  1037.   BufSize := BufSize*pSmallWord(Buffer)^+6;
  1038.   rc := DosAllocSharedMem( Pointer(Buffer), nil, BufSize,
  1039.     pag_read or pag_write or pag_commit or obj_gettable );
  1040.  
  1041.   // Move image to user buffer and transfer to BGI server
  1042.   move( BitMap, Buffer^, BufSize );
  1043.   com.x:=x;com.y:=y;com.Buffer:=Buffer;com.m:=BitBlt;
  1044.   askbgi(50,4,1);
  1045.  
  1046.   // Destroy shared memory area
  1047.   rc := DosFreeMem( Buffer );
  1048. end;
  1049.  
  1050. Procedure PutPixel(X, Y: Integer; Color: Word);
  1051. begin
  1052.   com.i[0]:=x;com.i[1]:=y;com.w3:=Color;
  1053.   callbgi(51,3);
  1054. end;
  1055.  
  1056. Procedure Rectangle(X1, Y1, X2, Y2: Integer);
  1057. begin
  1058.   com.i[0]:=x1;com.i[1]:=y1;
  1059.   com.i[2]:=x2;com.i[3]:=y2;
  1060.   callbgi(52,4);
  1061. end;
  1062.  
  1063. Procedure RegisterBGIFont(FontID: Integer; Font: Pointer);
  1064. begin
  1065.   com.i1:=fontid;com.w2:=word(font);
  1066.   callbgi(53,2);
  1067. end;
  1068.  
  1069. Procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
  1070. begin
  1071.   com.i[0]:=x;com.i[1]:=y;
  1072.   com.w[2]:=StAngle;com.w[3]:=EndAngle;
  1073.   com.w[4]:=XRadius;com.w[5]:=YRadius;
  1074.   callbgi(54,6);
  1075. end;
  1076.  
  1077. Procedure SetAllPalette(var Palette: PaletteType);
  1078. begin
  1079.   move(palette,com.i[0],sizeof(Palette));
  1080.   callbgi(55,Sizeof(Palette) div Sizeof(word));
  1081. end;
  1082.  
  1083. Procedure SetAspectRatio(Xasp, Yasp: Word);
  1084. begin
  1085.   com.w1:=xasp;com.w2:=yasp;
  1086.   callbgi(56,2);
  1087. end;
  1088.  
  1089. Procedure SetBkColor(ColorNum: Word);
  1090. begin
  1091.   com.w[0]:=ColorNum;
  1092.   callbgi(57,1);
  1093. end;
  1094.  
  1095. Procedure SetColor(Color: Word);
  1096. begin
  1097.   com.w[0]:=Color;
  1098.   callbgi(58,1);
  1099. end;
  1100.  
  1101. Procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
  1102. begin
  1103.   com.w1:=color;move(Pattern,com.w[1],sizeof(Pattern));
  1104.   callbgi(59,1+(sizeof(Pattern) div Sizeof(word)));
  1105. end;
  1106.  
  1107. Procedure SetFillStyle(Pattern: Word; Color: Word);
  1108. begin
  1109.   com.w[0]:=Pattern;
  1110.   com.w[1]:=Color;
  1111.   callbgi(60,2);
  1112. end;
  1113.  
  1114. Procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
  1115. begin
  1116.   com.w[0]:=LineStyle;
  1117.   com.w[1]:=Pattern;
  1118.   com.w[2]:=Thickness;
  1119.   callbgi(61,3);
  1120. end;
  1121.  
  1122. Procedure SetPalette(ColorNum: Word; Color: Byte);
  1123. begin
  1124.   com.w1:=colornum;
  1125.   com.w2:=color;
  1126.   callbgi(62,2);
  1127. end;
  1128.  
  1129. Procedure SetRGBPalette(ColorNum: Word; Red, Green, Blue: Byte);
  1130. begin
  1131.   com.w1:=colornum;
  1132.   com.w2:=red;com.w3:=green;com.w4:=blue;
  1133.   callbgi(63,4);
  1134. end;
  1135.  
  1136. Procedure SetTextJustify(Horiz, Vert: Word);
  1137. begin
  1138.   com.w[0]:=Horiz;
  1139.   com.w[1]:=Vert;
  1140.   callbgi(64,2);
  1141. end;
  1142.  
  1143. Procedure SetTextStyle(Font, Direction, CharSize: Integer);
  1144. begin
  1145.   com.i[0]:=Font;
  1146.   com.i[1]:=Direction;
  1147.   com.i[2]:=CharSize;
  1148.   callbgi(65,3);
  1149. end;
  1150.  
  1151. Procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
  1152. begin
  1153.   com.w1:=multx;
  1154.   com.w2:=divx;
  1155.   com.w3:=multy;
  1156.   com.w4:=divy;
  1157.   callbgi(66,4);
  1158. end;
  1159.  
  1160. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  1161. begin
  1162.   com.x1:=x1;
  1163.   com.y1:=y1;
  1164.   com.x2:=x2;
  1165.   com.y2:=y2;
  1166.   if clip then com.w5:=1 else com.w5:=0;
  1167.   callbgi(67,5);
  1168. end;
  1169.  
  1170. Procedure SetWriteMode(WriteMode: Integer);
  1171. begin
  1172.   com.i[0]:=WriteMode;
  1173.   callbgi(68,1);
  1174. end;
  1175.  
  1176. Function  TextHeight(TextString: string): Word;
  1177. begin
  1178.   com.s:=TextString;
  1179.   askbgi(69,3+(length(TextString) div sizeof(word)),1);
  1180.   textHeight:=bgires[0];
  1181. end;
  1182.  
  1183. Function  TextWidth(TextString: string): Word;
  1184. begin
  1185.   com.s:=TextString;
  1186.   askbgi(70,3+(length(TextString) div sizeof(word)),1);
  1187.   textWidth:=bgires[0];
  1188. end;
  1189.  
  1190. // VP additional BGI functions
  1191. procedure SetWideFillPattern(Pattern: NewPatternType; Color: Word);
  1192. begin
  1193.   com.w1:=color;move(Pattern,com.w[1],sizeof(Pattern));
  1194.   callbgi(71,1+(sizeof(Pattern) div Sizeof(word)));
  1195. end;
  1196.  
  1197. procedure VPInitGraph( xRes, yRes: Integer; PathToDriver: string);
  1198. begin
  1199.   _InitGraph( xRes, yRes, PathToDriver );
  1200. end;
  1201.  
  1202. procedure GetMousePos( var x,y: Word );
  1203. begin
  1204.   x := CurrentMouseX;
  1205.   y := CurrentMouseY;
  1206. end;
  1207.  
  1208. function  ReadKeyOrMouse( TimeOut: Word; var Mouse: Boolean;
  1209.   var Key: Char; var MEvent: MouseEventT; var mx, my: Word ): Boolean;
  1210. var
  1211.   M: MouseEventRecT;
  1212.   StartTime: Integer;
  1213. begin
  1214.   ReadKeyOrMouse := True;
  1215.   StartTime := GetTimemSec;
  1216.   repeat
  1217.     if keypressed then
  1218.       begin
  1219.         Mouse := False;
  1220.         Key := Readkey;
  1221.         Exit;
  1222.       end
  1223.     else if MouseClicked then
  1224.       begin
  1225.         Mouse := True;
  1226.         GetMouseEvent( M );
  1227.         MEvent := M.Event;
  1228.         mx := M.X;
  1229.         my := M.Y;
  1230.         Exit;
  1231.       end
  1232.     else
  1233.       DosSleep( 31 );
  1234.     // Repeat until timeout.  Timeout = -1 means indefinite wait
  1235.   until (TimeOut <> -1) and (GetTimeMSec - StartTime > TimeOut);
  1236.   ReadKeyOrMouse := False;
  1237. end;
  1238.  
  1239.  
  1240. initialization
  1241.   // Write exceptions to user screen
  1242.   SysUtils.PopUpErrors := false;
  1243.   // Create multiplex semaphores
  1244.   mtx_BGI := tMutexSem.Create;
  1245.   mtx_Kbd := tMutexSem.Create;
  1246.   mtx_Mou := tMutexSem.Create;
  1247. end.
  1248.  
  1249.