home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vpbgib1.zip / GRAPH.PAS < prev    next >
Pascal/Delphi Source File  |  1996-08-08  |  27KB  |  997 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-July 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. Uses
  18.   Use32;
  19.  
  20. type
  21.   Str12 = String[12];
  22.  
  23. Const
  24.   grOk                =  0;  // error status values reported by graphresult }
  25.   grNoInitGraph       = -1;  // BGI graphics not installed
  26.   grNotDetected       = -2;  // Graphics hardware not detected
  27.   grFileNotFound      = -3;  // Device driver file not found
  28.   grInvalidDriver     = -4;  // Invalid device driver file
  29.   grNoLoadMem         = -5;  // Not enough memory to load driver
  30.   grNoScanMem         = -6;  // Out of memory in scan fill
  31.   grNoFloodMem        = -7;  // Out of memory in flood fill
  32.   grFontNotFound      = -8;  // Font file not found
  33.   grNoFontMem         = -9;  // Not enough memory to load font
  34.   grInvalidMode       = -10; // Invalid graphics mode for selected driver
  35.   grError             = -11; // Graphics error (generic error)
  36.   grIOerror           = -12; // Graphics I/O error
  37.   grInvalidFont       = -13; // Invalid font file
  38.   grInvalidFontNum    = -14; // Invalid font number
  39.  
  40.   Detect              = 0;
  41.   Black               = 0;   // Colour values
  42.   Blue                = 1;
  43.   Green               = 2;
  44.   Cyan                = 3;
  45.   Red                 = 4;
  46.   Magenta             = 5;
  47.   Brown               = 6;
  48.   LightGray           = 7;
  49.   DarkGray            = 8;
  50.   LightBlue           = 9;
  51.   LightGreen          = 10;
  52.   LightCyan           = 11;
  53.   LightRed            = 12;
  54.   LightMagenta        = 13;
  55.   Yellow              = 14;
  56.   White               = 15;
  57.   EGA_Black           = 0;   // different than DOS BGI values
  58.   EGA_Blue            = 1;
  59.   EGA_Green           = 2;
  60.   EGA_Cyan            = 3;
  61.   EGA_Red             = 4;
  62.   EGA_Magenta         = 5;
  63.   EGA_Brown           = 6;
  64.   EGA_LightGray       = 7;
  65.   EGA_DarkGray        = 8;
  66.   EGA_LightBlue       = 9;
  67.   EGA_LightGreen      = 10;
  68.   EGA_LightCyan       = 11;
  69.   EGA_LightRed        = 12;
  70.   EGA_LightMagenta    = 13;
  71.   EGA_Yello           = 14;
  72.   EGA_White           = 15;
  73.  
  74.   NormWidth           = 1;   // constants for line thickness
  75.   ThickWidth          = 3;
  76.  
  77.   SolidLn             = 0;   // constants for line patterns
  78.   DottedLn            = 1;
  79.   CenterLn            = 2;
  80.   DashedLn            = 3;
  81.   UserBitLn           = 4;
  82.  
  83.   DefaultFont         = 0;   // font constants for settextstyle
  84.   TriplexFont         = 1;
  85.   SmallFont           = 2;
  86.   SansSerifFont       = 3;
  87.   GothicFont          = 4;
  88.   ScriptFont          = 5;
  89.   SimplexFont         = 6;
  90.   TriplexScrFont      = 7;
  91.   ComplexFont         = 8;
  92.   EuropeanFont        = 9;
  93.   BoldFont            = 10;
  94.   FontNames : Array[1..10] of Str12
  95.             = ( 'TRIP.CHR', 'LITT.CHR', 'SANS.CHR', 'GOTH.CHR', 'SCRI.CHR',
  96.                 'SIMP.CHR', 'TSCR.CHR', 'LCOM.CHR', 'EURO.CHR', 'BOLD.CHR' );
  97.  
  98.   HorizDir            =  0;
  99.   VertDir             =  90;
  100.   UserCharSize        =  0;
  101.  
  102.   ClipOn              =  TRUE;
  103.   ClipOff             =  FALSE;
  104.  
  105.   TopOn               =  TRUE;
  106.   TopOff              =  FALSE;
  107.  
  108.   EmptyFill           = 0;   // fill patterns
  109.   SolidFill           = 1;
  110.   LineFill            = 2;
  111.   LtSlashFill         = 3;
  112.   SlashFill           = 4;
  113.   BkSlashFill         = 5;
  114.   LtBkSlashFill       = 6;
  115.   HatchFill           = 7;
  116.   XHatchFill          = 8;
  117.   InterleaveFill      = 9;
  118.   WideDotFill         = 10;
  119.   CloseDotFill        = 11;
  120.   UserFill            = 12;
  121.  
  122.   NormalPut           = 0;   // operators for image blits and setwritemode
  123.   CopyPut             = 0;
  124.   XORPut              = 1;
  125.   OrPut               = 2;
  126.   AndPut              = 3;
  127.   NotPut              = 4;
  128.  
  129.   LeftText            = 0;   // text justification constants
  130.   CenterText          = 1;
  131.   RightText           = 2;
  132.   BottomText          = 0;
  133.   TopText             = 2;
  134.  
  135.   MaxColors           = 255; // Different from DOS
  136.  
  137.   LinePatterns        : Array[0..3] of Word
  138.                       = ( $FFFFFFFF, $33333333, $3CCF3CCF, $0F0F0F0F );
  139.  
  140. type
  141.   str4 = String[4];
  142.   FillPatternType       = array [1..8] of Byte;
  143.   NewPatternType        = array [0..15] of SmallWord;
  144.   IntArray              = array [0..65000] of Integer;
  145.  
  146.   PaletteType           = record
  147.                               Size    : word;
  148.                               Colors  : array [0..MaxColors] of Byte;
  149.                           end;
  150.  
  151.   LineSettingsType      = record
  152.                               LineStyle : Word;
  153.                               Pattern   : Word;
  154.                               Thickness : Word;
  155.                           end;
  156.  
  157.   TextSettingsType      = record
  158.                               Font      : Word;
  159.                               Direction : Word;
  160.                               CharSize  : Integer;      { different than DOS BGI }
  161.                               Horiz     : Word;
  162.                               Vert      : Word;
  163.                               userxscale: double;
  164.                               useryscale: double;
  165.                           end;
  166.  
  167.   FillSettingsType      = record
  168.                               Pattern   : Word;
  169.                               Color     : Word;
  170.                           end;
  171.  
  172.   PointType             = record
  173.                               X         : Integer;
  174.                               Y         : Integer;
  175.                           end;
  176.   PointArray = Array[0..65000] of PointType;
  177.  
  178.   ViewPortType          = record
  179.                               X1        : Integer;
  180.                               Y1        : Integer;
  181.                               X2        : Integer;
  182.                               Y2        : Integer;
  183.                               Clip      : Boolean;
  184.                           end;
  185.  
  186.   ArcCoordsType         = record
  187.                               X         : Integer;
  188.                               Y         : Integer;
  189.                               Xstart    : Integer;
  190.                               Ystart    : Integer;
  191.                               Xend      : Integer;
  192.                               Yend      : Integer;
  193.                           end;
  194.  
  195.   MouseStatusType       = record
  196.                               X         : Integer;
  197.                               Y         : Integer;
  198.                               LButt     : Integer;
  199.                               MButt     : Integer;
  200.                               RButt     : Integer;
  201.                               NewInfo   : Integer;
  202.                           end;
  203.  
  204. { BGI Function Prototypes }
  205.  
  206. Procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  207. Procedure Bar(X1, Y1, X2, Y2: Integer);
  208. Procedure Bar3D(X1, Y1, X2, Y2: Integer; Depth: Word; Top: Boolean);
  209. Procedure Circle(X, Y: Integer; Radius: Word);
  210. Procedure ClearDevice;
  211. Procedure ClearViewport;
  212. Procedure CloseGraph;
  213. procedure DetectGraph(var GraphDriver, GraphMode: Integer);
  214. Procedure DrawPoly(NumPoints: Word; var PolyPoints);
  215. Procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius: Word);
  216. Procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  217. Procedure FillPoly(NumPoints: Word; var PolyPoints);
  218. Procedure FloodFill(X, Y: Integer; Border: Word);
  219. Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  220. Procedure GetAspectRatio(var Xasp, Yasp: Word);
  221. Function  GetBkColor: Word;
  222. Function  GetColor: Word;
  223. Procedure GetDefaultPalette(var Palette: PaletteType);
  224. Function  GetDriverName: string;
  225. Procedure GetFillPattern(var FillPattern: FillPatternType);
  226. Procedure GetFillSettings(var FillInfo: FillSettingsType);
  227. function  GetGraphMode: Integer;
  228. procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
  229. Procedure GetLineSettings(var LineInfo: LineSettingsType);
  230. Function  GetMaxColor: Word;
  231. Function  GetMaxX: Word;
  232. Function  GetMaxY: Word;
  233. Function  GetModeName(ModeNumber: Integer): string;
  234. Procedure GetPalette(var Palette: PaletteType);
  235. Function  GetPaletteSize: Integer;
  236. Function  GetPixel(X,Y: Integer): Word;
  237. Procedure GetTextSettings(var TextInfo: TextSettingsType);
  238. Procedure GetViewSettings(var ThisViewPort: ViewPortType);
  239. Function  GetX: Integer;
  240. Function  GetY: Integer;
  241. Procedure GraphDefaults;
  242. Function  GraphErrorMsg(ErrorCode: Integer): String;
  243. Function  GraphResult: Integer;
  244. function  ImageSize(x1, y1, x2, y2: Integer): Word;
  245. procedure InitGraph(var GraphDriver:Integer; var GraphMode: Integer;
  246.     PathToDriver: string);
  247. Function  InstallUserFont(FontFileName: string) : Integer;
  248. Procedure Line(X1, Y1, X2, Y2: Integer);
  249. Procedure LineRel(Dx, Dy: Integer);
  250. Procedure LineTo(X, Y: Integer);
  251. Procedure MoveRel(Dx, Dy: Integer);
  252. Procedure MoveTo(X, Y: Integer);
  253. Procedure OutText(TextString: string);
  254. Procedure OutTextXY(X, Y: Integer; TextString: string);
  255. Procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  256. procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
  257. Procedure PutPixel(X, Y: Integer; Color: Word);
  258. Procedure Rectangle(X1, Y1, X2, Y2: Integer);
  259. Procedure RegisterBGIFont(FontID: Integer; Font: Pointer);
  260. Procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
  261. Procedure SetAllPalette(var Palette: PaletteType);
  262. Procedure SetAspectRatio(Xasp, Yasp: Word);
  263. Procedure SetBkColor(ColorNum: Word);
  264. Procedure SetColor(Color: Word);
  265. Procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
  266. Procedure SetFillStyle(Pattern: Word; Color: Word);
  267. Procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
  268. Procedure SetPalette(ColorNum: Word; Color: Byte);
  269. Procedure SetRGBPalette(ColorNum: Word; Red, Green, Blue: Byte);
  270. Procedure SetTextJustify(Horiz, Vert: Word);
  271. Procedure SetTextStyle(Font, Direction, CharSize: Integer);
  272. Procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
  273. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  274. Procedure SetWriteMode(WriteMode: Integer);
  275. Function  TextHeight(TextString: string): Word;
  276. Function  TextWidth(TextString: string): Word;
  277.  
  278. // VP additional BGI functions
  279. procedure SetWideFillPattern(Pattern: NewPatternType; Color: Word);
  280. procedure FlushDisplay;              // Update BGI screen
  281.  
  282. // VP functions replacing CRT functions
  283. function Keypressed: Boolean;        // Keypressed for both Server and Client
  284. function ReadKey: Char;
  285.  
  286. // VP constants modifying behaviour of Graph
  287. const
  288.   WaitKeypressed  : Boolean = True;  // Delay() when calling keypressed
  289.   AutoStartServer : Boolean = True;  // Start BGI server proces in InitGraph
  290.  
  291. {$IFDEF DEBUG}
  292. procedure log( s: String );
  293. {$ENDIF}
  294.  
  295. Implementation
  296.  
  297. uses Os2Def, Os2Base, Crt, Dos, BGIMsg, VPUtils;
  298.  
  299. const
  300.   Stopping  : boolean = false;
  301.   tid_BGI   : tid = 0;     // BGI Update Thread
  302.   tid_Kbd   : tid = 0;     // Keyboard watch thread
  303.   mtx_BGI   : hMTX = 0;    // BGI Update semaphore
  304.   KeyCount  : Integer = 0; // Count of keys in KeyBuffer
  305.  
  306. var
  307.   F         : File;
  308.   DispPtr   : word;
  309.   DispList  : DisplayListT;
  310.   com       : CommandListT;
  311.   bgires    : BGIResArT;
  312.   KeyBuffer : array[0..127] of Char; // Keyboard type-ahead buffer
  313.  
  314. procedure waitforpipe;
  315. var
  316.   cnt,
  317.   res : word;
  318. begin
  319.   if filerec(f).Handle > 0 then exit;
  320.   cnt:=0;
  321.   repeat
  322.     inc(cnt);
  323.     if cnt>1000 then
  324.       Halt(22);
  325.     {$I-}
  326.     Reset(f,1);
  327.     {$I+}
  328.     res:=IOREsult;
  329.     if res<>0 then
  330.       DosSleep(50);
  331.   until Res=0;
  332. end;
  333.  
  334. procedure flushdisplay;
  335. var
  336.   ulWritten,
  337.   ulRead,
  338.   result : word;
  339. begin
  340.   if DispPtr=0 then Exit;
  341.   if DosRequestMutexSem( mtx_BGI, 0 ) <> 0 then
  342.     exit;  // Not important to update display - exit
  343.  
  344.   if DispPtr=0 then
  345.     begin
  346.       // If display has been updated, exit
  347.       DosReleaseMutexSem( mtx_BGI );
  348.       exit;
  349.     end;
  350.   waitforpipe;
  351. {$I-}
  352.   BlockWrite(F,displist,DispPtr*Sizeof(word),ulWritten);
  353.   BlockRead(F,result,sizeof(result),ulRead);
  354.   DispPtr:=0;
  355. //  Close(F);
  356. {$I+}
  357.   if ioresult = 0 then ;
  358.   DosReleaseMutexSem( mtx_BGI );
  359. end;
  360.  
  361. procedure askbgi(func,nrpar,nrret:word);
  362. var
  363.   t,
  364.   ulWritten,
  365.   ulRead : word;
  366.   snd    : array [0..2] of word;
  367. begin
  368.   flushdisplay;
  369.  
  370.   While DosRequestMutexSem( mtx_BGI, 90 ) <> 0 do
  371.     DosSleep( 31 );
  372.   DispList.w[DispPtr]:=func;
  373.   DispList.w[DispPtr+1]:=nrpar;
  374.   DispList.w[DispPtr+2]:=nrret;
  375.   for t:=0 to nrpar-1 do
  376.     DispList.i[DispPtr+t+3]:=com.i[t];
  377.   waitforpipe;
  378.   BlockWrite(F,displist,(nrpar+3)*sizeof(word),ulWritten);
  379.   if nrret>0 then
  380.     BlockRead(F,bgires,nrret*sizeof(word),ulRead);
  381.   DispPtr:=0;
  382.   DosReleaseMutexSem( mtx_BGI );
  383. end;
  384.  
  385. procedure callbgi(func,nrpar:byte);
  386. var
  387.   t : word;
  388. begin
  389.   if DispPtr+NrPar+3>MaxDisp then
  390.     flushdisplay;
  391.  
  392.   While DosRequestMutexSem( mtx_BGI, 50 ) <> 0 do
  393.     DosSleep( 31 );
  394.   DispList.w[DispPtr]:=func;
  395.   DispList.w[DispPtr+1]:=nrpar;
  396.   DispList.w[DispPtr+2]:=0;
  397.   for t:=0 to nrpar-1 do
  398.     DispList.i[DispPtr+t+3]:=com.i[t];
  399.   DispPtr:=DispPtr+nrpar+3;
  400.   DosReleaseMutexSem( mtx_BGI );
  401. end;
  402.  
  403. Procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  404. begin
  405.   com.i[0]:=x;com.i[1]:=y;
  406.   com.w[2]:=StAngle;com.w[3]:=EndAngle;com.w[4]:=Radius;
  407.   callbgi(1,5);
  408. end;
  409.  
  410. Procedure Bar(X1, Y1, X2, Y2: Integer);
  411. begin
  412.   com.i[0]:=x1;com.i[1]:=y1;
  413.   com.i[2]:=x2;com.i[3]:=y2;
  414.   callbgi(2,4);
  415. end;
  416.  
  417. Procedure Bar3D(X1, Y1, X2, Y2: Integer; Depth: Word; Top: Boolean);
  418. begin
  419.   com.i[0]:=x1;com.i[1]:=y1;
  420.   com.i[2]:=x2;com.i[3]:=y2;
  421.   com.w[4]:=Depth;if Top then com.w[5]:=1 else com.w[5]:=1;
  422.   callbgi(3,6);
  423. end;
  424.  
  425. Procedure Circle(X, Y: Integer; Radius: Word);
  426. begin
  427.   com.i[0]:=x;com.i[1]:=y;
  428.   com.w[2]:=Radius;
  429.   callbgi(4,3);
  430. end;
  431.  
  432. Procedure ClearDevice;
  433. begin
  434.   callbgi(5,0);
  435. end;
  436.  
  437. Procedure ClearViewport;
  438. begin
  439.   callbgi(6,0);
  440. end;
  441.  
  442. Procedure CloseGraph;
  443. begin
  444.   if tid_BGI = 0 then Exit;
  445.  
  446.   callbgi(7,0);  // CloseGraph() call to Server Process
  447.  
  448.   Stopping := True;
  449.   DosWaitThread( tid_BGI, dcww_Wait );
  450.   tid_BGI := 0;
  451.   DosCloseMutexSem( mtx_BGI );
  452. end;
  453.  
  454. procedure DetectGraph(var GraphDriver, GraphMode: Integer);
  455. begin
  456.   askbgi(8,0,2);
  457.   GraphDriver:=bgires[0];GraphMode:=bgires[1];
  458. end;
  459.  
  460. Procedure DrawPoly(NumPoints: Word; var PolyPoints);
  461. begin
  462.   com.nr:=NumPoints;
  463.   move(PolyPoints,com.pts,2*NumPoints*SizeOf(integer));
  464.   callbgi(9,1+NumPoints*2);
  465. end;
  466.  
  467. Procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius: Word);
  468. begin
  469.   com.i[0]:=x;com.i[1]:=y;
  470.   com.w[2]:=stAngle;com.w[3]:=EndAngle;
  471.   com.w[2]:=XRadius;com.w[3]:=YRadius;
  472.   callbgi(10,6);
  473. end;
  474.  
  475. Procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Word);
  476. begin
  477.   com.i[0]:=x;com.i[1]:=y;
  478.   com.w[2]:=XRadius;com.w[3]:=YRadius;
  479.   callbgi(11,6);
  480. end;
  481.  
  482. Procedure FillPoly(NumPoints: Word; var PolyPoints);
  483. begin
  484.   com.nr:=NumPoints;
  485.   move(PolyPoints,com.pts,2*NumPoints*SizeOf(integer));
  486.   callbgi(12,1+NumPoints*2);
  487. end;
  488.  
  489. Procedure FloodFill(X, Y: Integer; Border: Word);
  490. begin
  491.   com.x1:=x;com.y1:=y;com.w3:=border;
  492.   callbgi(12,3);
  493. end;
  494.  
  495. Procedure GetArcCoords(var ArcCoords: ArcCoordsType);
  496. begin
  497.   askbgi(14,0,6);
  498.   move(bgires,ArcCoords,sizeof(ArcCoords));
  499. end;
  500.  
  501. Procedure GetAspectRatio(var Xasp, Yasp: Word);
  502. begin
  503.   askbgi(15,0,2);
  504.   xasp:=bgires[0];yasp:=bgires[1];
  505. end;
  506.  
  507. Function  GetBkColor: Word;
  508. begin
  509.   askbgi(16,0,1);
  510.   GetBkColor:=bgires[0];
  511. end;
  512.  
  513. Function  GetColor: Word;
  514. begin
  515.   askbgi(17,0,1);
  516.   GetColor:=bgires[0];
  517. end;
  518.  
  519. Procedure GetDefaultPalette(var Palette: PaletteType);
  520. begin
  521.   askbgi(18,0,SizeOf(Palette) div Sizeof(word));
  522.   move(bgires,palette,sizeof(palette));
  523. end;
  524.  
  525. Function  GetDriverName: string;
  526. var
  527.   s : string;
  528. begin
  529.   askbgi(19,0,Sizeof(s) div Sizeof(word));
  530.   move(bgires,s,sizeof(s));
  531.   GetDrivername:=s;
  532. end;
  533.  
  534. Procedure GetFillPattern(var FillPattern: FillPatternType);
  535. begin
  536.   askbgi(20,0,Sizeof(FillPattern) div Sizeof(word));
  537.   move(bgires,fillpattern,sizeof(fillpattern));
  538. end;
  539.  
  540. Procedure GetFillSettings(var FillInfo: FillSettingsType);
  541. begin
  542.   askbgi(21,0,Sizeof(FillInfo) div Sizeof(word));
  543.   move(bgires,fillinfo,sizeof(fillinfo));
  544. end;
  545.  
  546. function  GetGraphMode: Integer;
  547. begin
  548.   askbgi(22,0,1);
  549.   getgraphmode:=bgires[0];
  550. end;
  551.  
  552. procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
  553. begin
  554. {23}
  555. end;
  556.  
  557. Procedure GetLineSettings(var LineInfo: LineSettingsType);
  558. begin
  559.   askbgi(24,0,Sizeof(LineInfo) div Sizeof(word));
  560.   move(bgires,lineinfo,sizeof(Lineinfo));
  561. end;
  562.  
  563. Function  GetMaxColor: Word;
  564. begin
  565.   askbgi(25,0,1);
  566.   getmaxcolor:=bgires[0];
  567. end;
  568.  
  569. Function  GetMaxX: Word;
  570. begin
  571.   askbgi(26,0,1);
  572.   getmaxx:=bgires[0];
  573. end;
  574.  
  575. Function  GetMaxY: Word;
  576. begin
  577.   askbgi(27,0,1);
  578.   getmaxy:=bgires[0];
  579. end;
  580.  
  581. Function  GetModeName(ModeNumber: Integer): string;
  582. var
  583.   s : string;
  584. begin
  585.   com.i1:=ModeNumber;
  586.   askbgi(28,1,Sizeof(s) div Sizeof(word));
  587.   move(bgires,s,sizeof(s));
  588.   GetModename:=s;
  589. end;
  590.  
  591. Procedure GetPalette(var Palette: PaletteType);
  592. begin
  593.   askbgi(29,0,Sizeof(Palette) div Sizeof(word));
  594.   move(bgires,palette,sizeof(Palette));
  595. end;
  596.  
  597. Function  GetPaletteSize: Integer;
  598. begin
  599.   askbgi(30,0,1);
  600.   GetPaletteSize:=bgires[0];
  601. end;
  602.  
  603. Function  GetPixel(X,Y: Integer): Word;
  604. begin
  605.   com.x1:=x;com.y1:=y;
  606.   askbgi(31,2,1);
  607.   getpixel:=bgires[0];
  608. end;
  609.  
  610. Procedure GetTextSettings(var TextInfo: TextSettingsType);
  611. begin
  612.   askbgi(32,0,Sizeof(textInfo) div Sizeof(word));
  613.   move(bgires,textinfo,sizeof(textinfo));
  614. end;
  615.  
  616. Procedure GetViewSettings(var ThisViewPort: ViewPortType);
  617. begin
  618.   askbgi(33,0,Sizeof(ThisViewPort) div Sizeof(word));
  619.   move(bgires,ThisViewPort,sizeof(ThisViewPort));
  620. end;
  621.  
  622. Function  GetX: Integer;
  623. begin
  624.   askbgi(34,0,1);
  625.   getx:=bgires[0];
  626. end;
  627.  
  628. Function  GetY: Integer;
  629. begin
  630.   askbgi(35,0,1);
  631.   gety:=bgires[0];
  632. end;
  633.  
  634. Procedure GraphDefaults;
  635. begin
  636.   flushdisplay;
  637.   callbgi(36,0);
  638. end;
  639.  
  640. Function  GraphErrorMsg(ErrorCode: Integer): String;
  641. begin
  642.   GraphErrorMsg:='';
  643. end;
  644.  
  645. Function  GraphResult: Integer;
  646. begin
  647.   flushdisplay;
  648.   graphresult:=0;
  649. end;
  650.  
  651. function  ImageSize(x1, y1, x2, y2: Integer): Word;
  652. begin
  653.   com.i[0]:=x1;com.i[1]:=y1;com.i[2]:=x2;com.i[3]:=y2;
  654.   askbgi(39,4,1);
  655.   ImageSize:=bgires[0];
  656. end;
  657.  
  658. procedure PushKey(Ch: Char);
  659. begin
  660.   if KeyCount < SizeOf(KeyBuffer) then
  661.   begin
  662.     KeyBuffer[KeyCount] := Ch;
  663.     Inc(KeyCount);
  664.   end;
  665. end;
  666.  
  667. function Keypressed: Boolean;
  668. begin
  669.   KeyPressed := KeyCount > 0;
  670.   If WaitKeypressed and ( KeyCount = 0 ) then
  671.     DosSleep( 1 );
  672. end;
  673.  
  674. function ReadKey: Char;
  675. begin
  676.   while not KeyPressed do
  677.     ;
  678.   ReadKey := KeyBuffer[0];
  679.   Dec(KeyCount);
  680.   Move(KeyBuffer[1], KeyBuffer[0], KeyCount);
  681. end;
  682.  
  683. // Thread updating display at least 5x per second
  684. function BGIUpdateThread( p: Pointer ): Longint;
  685. begin
  686.   while not Stopping do
  687.     begin
  688.       if DispPtr <> 0 then
  689.         FlushDisplay;
  690.       DosSleep( 200 );
  691.     end;
  692. end;
  693.  
  694. // Thread routing keyboard input from both TXT and BGI screen
  695. function BGIKeyboardThread( p: Pointer ): Longint;
  696. begin
  697.   While not Stopping do
  698.     begin
  699.       // Ask if key was pressed in text mode screen
  700.       If Crt.Keypressed then
  701.         // Yes, add to buffer
  702.         PushKey( Crt.Readkey )
  703.       else
  704.         if DispPtr = 0 then
  705.           begin
  706.             // Ask BGI if key is pressed, if no display items waiting
  707.             askbgi(99,0,1);
  708.             if bgires[0] <> 0 then
  709.               PushKey( chr(bgires[0]) )
  710.             else
  711.               DosSleep( 31 );
  712.           end
  713.         else
  714.           DosSleep( 31 );
  715.     end;
  716. end;
  717.  
  718. procedure InitGraph(var GraphDriver:Integer; var GraphMode: Integer;
  719.                         PathToDriver: string);
  720. var
  721.   rc: ApiRet;
  722.   SD: StartData;
  723.   IdSession: ULong;
  724.   Pid: ULong;
  725.   s: String;
  726. begin
  727.   DispPtr:=0;
  728.  
  729.   // if AutoStartServer is false, the BGI server process must be started
  730.   // manually by executing GRAPHSRV.EXE.
  731.   if AutoStartServer then
  732.     begin
  733.       // Set up unique pipe name to allow multiple instances of
  734.       // this program to run safely
  735.       BGIPipeName := '\PIPE\BGI'+                           // Pipe prefix
  736.                      Int2Hex( GetForegroundProcessID, 4 )+  // Process ID
  737.                      Int2Hex( GetTimeMSec, 8 );             // Time in ms
  738.       s := '/B'+PathToDriver+' /P'+BGIPipeName+#0;
  739.       // Spawn Graph Server process
  740.       fillchar( sd, sizeof(sd), 0 );
  741.       with SD do
  742.         begin
  743.           Length      := sizeof(StartData);
  744.           Related     := ssf_Related_Child;
  745.           FgBg        := ssf_FgBg_Fore;
  746.           TraceOpt    := ssf_TraceOpt_None;
  747.           PgmTitle    := 'VP/2 BGI Graphics Server Process';
  748.           PgmName     := 'graphsrv.exe';
  749.           PgmInputs   := @s[1];
  750.  
  751.           TermQ       := nil;
  752.           Environment := nil;
  753.           InheritOpt  := ssf_InhertOpt_Parent;
  754.           SessionType := ssf_Type_Pm;
  755.           IconFile    := nil;
  756.           PgmHandle   := 0;
  757.           PgmControl  := ssf_Control_Visible;
  758.         end;
  759.       rc := DosStartSession( SD, IdSession, Pid );
  760.       if ( rc <> No_Error ) and ( rc <> error_Smg_Start_In_Background ) then
  761.         begin
  762.           Writeln( 'Graph Server Process GRAPHSRV.EXE not found' );
  763.           halt(1);
  764.         end;
  765.     end; // If AutoStartServer
  766.  
  767. {$I-}
  768.   Close(f);
  769.   Assign(f,BGIPipeName);
  770. {$I+}
  771.   if ioresult<>0 then;
  772.   Stopping := False;
  773.   // Create semaphores
  774.   DosCreateMutexSem( nil, mtx_BGI, 0, False );
  775.   // Start thread for trigging regular screen update
  776.   tid_BGI := VPBeginThread( BGIUpdateThread, 16384, nil );
  777.   // Start thread for watching the keyboard
  778.   tid_Kbd := VPBeginThread( BGIKeyboardThread, 16384, nil );
  779.  
  780.   GraphDefaults;
  781.   ClearDevice;
  782.  
  783. end;
  784.  
  785. Function  InstallUserFont(FontFileName: string) : Integer;
  786. begin
  787.   com.s:=fontfilename;
  788.   askbgi(41,3,1);
  789.   InstallUserFont:=bgires[0];
  790. end;
  791.  
  792. Procedure Line(X1, Y1, X2, Y2: Integer);
  793. begin
  794.   com.i[0]:=x1;com.i[1]:=y1;
  795.   com.i[2]:=x2;com.i[3]:=y2;
  796.   callbgi(42,4);
  797. end;
  798.  
  799. Procedure LineRel(Dx, Dy: Integer);
  800. begin
  801.   com.i[0]:=dx;com.i[1]:=dy;
  802.   callbgi(43,2);
  803. end;
  804.  
  805. Procedure LineTo(X, Y: Integer);
  806. begin
  807.   com.i[0]:=x;com.i[1]:=y;
  808.   callbgi(44,2);
  809. end;
  810.  
  811. Procedure MoveRel(Dx, Dy: Integer);
  812. begin
  813.   com.i[0]:=dx;com.i[1]:=dy;
  814.   callbgi(45,2);
  815. end;
  816.  
  817. Procedure MoveTo(X, Y: Integer);
  818. begin
  819.   com.i[0]:=x;com.i[1]:=y;
  820.   callbgi(46,2);
  821. end;
  822.  
  823. Procedure OutText(TextString: string);
  824. begin
  825.   com.i[0]:=0;com.i[1]:=0;
  826.   com.s:=TextString;
  827.   callbgi(47,3+(length(TextString) div sizeof(word)));
  828. end;
  829.  
  830. Procedure OutTextXY(X, Y: Integer; TextString: string);
  831. begin
  832.   com.i[0]:=x;com.i[1]:=y;
  833.   com.s:=TextString;
  834.   callbgi(48,3+(length(TextString) div sizeof(word)));
  835. end;
  836.  
  837. Procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
  838. begin
  839.   com.i[0]:=x;com.i[1]:=y;
  840.   com.w[2]:=StAngle;com.w[3]:=EndAngle;com.w[4]:=Radius;
  841.   callbgi(49,5);
  842. end;
  843.  
  844. procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
  845. begin
  846. {50}
  847. end;
  848.  
  849. Procedure PutPixel(X, Y: Integer; Color: Word);
  850. begin
  851.   com.i[0]:=x;com.i[1]:=y;com.w3:=Color;
  852.   callbgi(51,3);
  853. end;
  854.  
  855. Procedure Rectangle(X1, Y1, X2, Y2: Integer);
  856. begin
  857.   com.i[0]:=x1;com.i[1]:=y1;
  858.   com.i[2]:=x2;com.i[3]:=y2;
  859.   callbgi(52,4);
  860. end;
  861.  
  862. Procedure RegisterBGIFont(FontID: Integer; Font: Pointer);
  863. begin
  864.   com.i1:=fontid;com.w2:=word(font);
  865.   callbgi(53,2);
  866. end;
  867.  
  868. Procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
  869. begin
  870.   com.i[0]:=x;com.i[1]:=y;
  871.   com.w[2]:=StAngle;com.w[3]:=EndAngle;
  872.   com.w[4]:=XRadius;com.w[5]:=YRadius;
  873.   callbgi(54,6);
  874. end;
  875.  
  876. Procedure SetAllPalette(var Palette: PaletteType);
  877. begin
  878.   move(palette,com.i[0],sizeof(Palette));
  879.   callbgi(55,Sizeof(Palette) div Sizeof(word));
  880. end;
  881.  
  882. Procedure SetAspectRatio(Xasp, Yasp: Word);
  883. begin
  884.   com.w1:=xasp;com.w2:=yasp;
  885.   callbgi(56,2);
  886. end;
  887.  
  888. Procedure SetBkColor(ColorNum: Word);
  889. begin
  890.   com.w[0]:=ColorNum;
  891.   callbgi(57,1);
  892. end;
  893.  
  894. Procedure SetColor(Color: Word);
  895. begin
  896.   com.w[0]:=Color;
  897.   callbgi(58,1);
  898. end;
  899.  
  900. Procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
  901. begin
  902.   com.w1:=color;move(Pattern,com.w[1],sizeof(Pattern));
  903.   callbgi(59,1+(sizeof(Pattern) div Sizeof(word)));
  904. end;
  905.  
  906. Procedure SetFillStyle(Pattern: Word; Color: Word);
  907. begin
  908.   com.w[0]:=Pattern;
  909.   com.w[1]:=Color;
  910.   callbgi(60,2);
  911. end;
  912.  
  913. Procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
  914. begin
  915.   com.w[0]:=LineStyle;
  916.   com.w[1]:=Pattern;
  917.   com.w[2]:=Thickness;
  918.   callbgi(61,3);
  919. end;
  920.  
  921. Procedure SetPalette(ColorNum: Word; Color: Byte);
  922. begin
  923.   com.w1:=colornum;
  924.   com.w2:=color;
  925.   callbgi(62,2);
  926. end;
  927.  
  928. Procedure SetRGBPalette(ColorNum: Word; Red, Green, Blue: Byte);
  929. begin
  930.   com.w1:=colornum;
  931.   com.w2:=red;com.w3:=green;com.w4:=blue;
  932.   callbgi(63,4);
  933. end;
  934.  
  935. Procedure SetTextJustify(Horiz, Vert: Word);
  936. begin
  937.   com.w[0]:=Horiz;
  938.   com.w[1]:=Vert;
  939.   callbgi(64,2);
  940. end;
  941.  
  942. Procedure SetTextStyle(Font, Direction, CharSize: Integer);
  943. begin
  944.   com.i[0]:=Font;
  945.   com.i[1]:=Direction;
  946.   com.i[2]:=CharSize;
  947.   callbgi(65,3);
  948. end;
  949.  
  950. Procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
  951. begin
  952.   com.w1:=multx;
  953.   com.w2:=divx;
  954.   com.w3:=multy;
  955.   com.w4:=divy;
  956.   callbgi(66,4);
  957. end;
  958.  
  959. Procedure SetViewPort(X1, Y1, X2, Y2: Integer; Clip: Boolean);
  960. begin
  961.   com.x1:=x1;
  962.   com.y1:=y1;
  963.   com.x2:=x2;
  964.   com.y2:=y2;
  965.   if clip then com.w5:=1 else com.w5:=0;
  966.   callbgi(67,5);
  967. end;
  968.  
  969. Procedure SetWriteMode(WriteMode: Integer);
  970. begin
  971.   com.i[0]:=WriteMode;
  972.   callbgi(68,1);
  973. end;
  974.  
  975. Function  TextHeight(TextString: string): Word;
  976. begin
  977.   com.s:=TextString;
  978.   askbgi(70,3+(length(TextString) div sizeof(word)),1);
  979.   textHeight:=bgires[0];
  980. end;
  981.  
  982. Function  TextWidth(TextString: string): Word;
  983. begin
  984.   com.s:=TextString;
  985.   askbgi(70,3+(length(TextString) div sizeof(word)),1);
  986.   textWidth:=bgires[0];
  987. end;
  988.  
  989. // VP additional BGI functions
  990. procedure SetWideFillPattern(Pattern: NewPatternType; Color: Word);
  991. begin
  992.   com.w1:=color;move(Pattern,com.w[1],sizeof(Pattern));
  993.   callbgi(71,1+(sizeof(Pattern) div Sizeof(word)));
  994. end;
  995.  
  996. end.
  997.