|
|
@@ -0,0 +1,1364 @@
|
|
|
+unit Graph;
|
|
|
+
|
|
|
+{ *********************************************************************
|
|
|
+
|
|
|
+ $Id$
|
|
|
+
|
|
|
+ Copyright 1997,1998 Matthias K"oppe <[email protected]>
|
|
|
+ This library is free software in the sense of the GNU Library GPL;
|
|
|
+ see `License Conditions' below.
|
|
|
+
|
|
|
+ Info:
|
|
|
+
|
|
|
+ This unit provides the functions of Borland's Graph unit for linux,
|
|
|
+ it uses the SVGAlib to do the actual work, so you must have svgalib
|
|
|
+ on your system
|
|
|
+
|
|
|
+ This version requires Free Pascal 0.99.5 or higher.
|
|
|
+
|
|
|
+ Large parts have not yet been implemented or tested.
|
|
|
+
|
|
|
+ History:
|
|
|
+
|
|
|
+ Date Version Who Comments
|
|
|
+ ---------- -------- ------- -------------------------------------
|
|
|
+ 25-Sep-97 0.1 mkoeppe Initial multi-target version.
|
|
|
+ 05-Oct-97 0.1.1 mkoeppe Linux: Added mouse use. Improved clipping.
|
|
|
+ Added bitmap functions.
|
|
|
+ ??-Oct-97 0.1.2 mkoeppe Fixed screenbuf functions.
|
|
|
+ 07-Feb-98 0.1.3 mkoeppe Fixed a clipping bug in DOS target.
|
|
|
+ 12-Apr-98 0.1.4 mkoeppe Linux: Using Michael's re-worked SVGALIB
|
|
|
+ interface; prepared for FPC 0.99.5; removed
|
|
|
+ dependencies.
|
|
|
+ 15-Apr-98 0.1.5 michael Renamed to graph, inserted needed SVGlib
|
|
|
+ declarations here so it can be used independently
|
|
|
+ of the svgalib unit. Removed things that are NOT
|
|
|
+ part of Borland's Graph from the unit interface.
|
|
|
+
|
|
|
+ License Conditions:
|
|
|
+
|
|
|
+ This library is free software; you can redistribute it and/or
|
|
|
+ modify it under the terms of the GNU Library General Public
|
|
|
+ License as published by the Free Software Foundation; either
|
|
|
+ version 2 of the License, or (at your option) any later version.
|
|
|
+
|
|
|
+ This library is distributed in the hope that it will be useful,
|
|
|
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
+ Library General Public License for more details.
|
|
|
+
|
|
|
+ You should have received a copy of the GNU Library General Public
|
|
|
+ License along with this library; if not, write to the Free
|
|
|
+ Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
+
|
|
|
+ *********************************************************************}
|
|
|
+
|
|
|
+{
|
|
|
+ Functions not currently implemented :
|
|
|
+ -------------------------------------
|
|
|
+ SetWriteMode
|
|
|
+ SetLineStyle
|
|
|
+ SetFillPattern
|
|
|
+ SetUserCharSize
|
|
|
+ SetTextStyle
|
|
|
+ FillPoly
|
|
|
+ FloodFill
|
|
|
+ GetArcCoords
|
|
|
+ Arc
|
|
|
+ SetAspectRatio
|
|
|
+ PieSlice
|
|
|
+ Sector
|
|
|
+
|
|
|
+ (please remove what you implement fom this list)
|
|
|
+}
|
|
|
+
|
|
|
+
|
|
|
+interface
|
|
|
+
|
|
|
+
|
|
|
+{ ---------------------------------------------------------------------
|
|
|
+ Constants
|
|
|
+ ---------------------------------------------------------------------}
|
|
|
+
|
|
|
+const
|
|
|
+ NormalPut = 0;
|
|
|
+ CopyPut = 0;
|
|
|
+ XORPut = 1;
|
|
|
+ ORPut = 2;
|
|
|
+ ANDPut = 3;
|
|
|
+ NotPut = 4;
|
|
|
+ BackPut = 8;
|
|
|
+
|
|
|
+ Black = 0;
|
|
|
+ Blue = 1;
|
|
|
+ Green = 2;
|
|
|
+ Cyan = 3;
|
|
|
+ Red = 4;
|
|
|
+ Magenta = 5;
|
|
|
+ Brown = 6;
|
|
|
+ LightGray = 7;
|
|
|
+ DarkGray = 8;
|
|
|
+ LightBlue = 9;
|
|
|
+ LightGreen = 10;
|
|
|
+ LightCyan = 11;
|
|
|
+ LightRed = 12;
|
|
|
+ LightMagenta = 13;
|
|
|
+ Yellow = 14;
|
|
|
+ White = 15;
|
|
|
+ Border = 16;
|
|
|
+
|
|
|
+ SolidLn = 0;
|
|
|
+ DottedLn = 1;
|
|
|
+ CenterLn = 2;
|
|
|
+ DashedLn = 3;
|
|
|
+ UserBitLn = 4;
|
|
|
+
|
|
|
+ EmptyFill = 0;
|
|
|
+ SolidFill = 1;
|
|
|
+ LineFill = 2;
|
|
|
+ LtSlashFill = 3;
|
|
|
+ SlashFill = 4;
|
|
|
+ BkSlashFill = 5;
|
|
|
+ LtBkSlashFill = 6;
|
|
|
+ HatchFill = 7;
|
|
|
+ XHatchFill = 8;
|
|
|
+ InterleaveFill = 9;
|
|
|
+ WideDotFill = 10;
|
|
|
+ CloseDotFill = 11;
|
|
|
+ UserFill = 12;
|
|
|
+
|
|
|
+ NormWidth = 1;
|
|
|
+ ThickWidth = 3;
|
|
|
+
|
|
|
+const
|
|
|
+ LeftText = 0;
|
|
|
+ CenterText = 1;
|
|
|
+ RightText = 2;
|
|
|
+ BottomText = 0;
|
|
|
+ TopText = 2;
|
|
|
+ BaseLine = 3;
|
|
|
+ LeadLine = 4;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+{ ---------------------------------------------------------------------
|
|
|
+ Types
|
|
|
+ ---------------------------------------------------------------------}
|
|
|
+
|
|
|
+
|
|
|
+Type
|
|
|
+ FillPatternType = array[1..8] of byte;
|
|
|
+
|
|
|
+ ArcCoordsType = record
|
|
|
+ x,y : integer;
|
|
|
+ xstart,ystart : integer;
|
|
|
+ xend,yend : integer;
|
|
|
+ end;
|
|
|
+
|
|
|
+ RGBColor = record
|
|
|
+ r,g,b,i : byte;
|
|
|
+ end;
|
|
|
+
|
|
|
+ PaletteType = record
|
|
|
+ Size : integer;
|
|
|
+ Colors : array[0..767]of Byte;
|
|
|
+ end;
|
|
|
+
|
|
|
+ LineSettingsType = record
|
|
|
+ linestyle : word;
|
|
|
+ pattern : word;
|
|
|
+ thickness : word;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TextSettingsType = record
|
|
|
+ font : word;
|
|
|
+ direction : word;
|
|
|
+ charsize : word;
|
|
|
+ horiz : word;
|
|
|
+ vert : word;
|
|
|
+ end;
|
|
|
+
|
|
|
+ FillSettingsType = record
|
|
|
+ pattern : word;
|
|
|
+ color : longint;
|
|
|
+ end;
|
|
|
+
|
|
|
+ PointType = record
|
|
|
+ x,y : integer;
|
|
|
+ end;
|
|
|
+
|
|
|
+ ViewPortType = record
|
|
|
+ x1,y1,x2,y2 : integer;
|
|
|
+ Clip : boolean;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ const
|
|
|
+ fillpattern : array[0..12] of FillPatternType = (
|
|
|
+ ($00,$00,$00,$00,$00,$00,$00,$00), { Hintergrundfarbe }
|
|
|
+ ($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff), { Vordergrundfarbe }
|
|
|
+ ($ff,$ff,$00,$00,$ff,$ff,$00,$00), { === }
|
|
|
+ ($01,$02,$04,$08,$10,$20,$40,$80), { /// }
|
|
|
+ ($07,$0e,$1c,$38,$70,$e0,$c1,$83), { /// als dicke Linien }
|
|
|
+ ($07,$83,$c1,$e0,$70,$38,$1c,$0e), { \\\ als dicke Linien }
|
|
|
+ ($5a,$2d,$96,$4b,$a5,$d2,$69,$b4), { \ \\ \ }
|
|
|
+ ($ff,$88,$88,$88,$ff,$88,$88,$88), { K„stchen }
|
|
|
+ ($18,$24,$42,$81,$81,$42,$24,$18), { Rauten }
|
|
|
+ ($cc,$33,$cc,$33,$cc,$33,$cc,$33), { "Mauermuster" }
|
|
|
+ ($80,$00,$08,$00,$80,$00,$08,$00), { weit auseinanderliegende Punkte }
|
|
|
+ ($88,$00,$22,$00,$88,$00,$22,$00), { dichte Punkte}
|
|
|
+ (0,0,0,0,0,0,0,0) { benutzerdefiniert }
|
|
|
+ );
|
|
|
+
|
|
|
+
|
|
|
+{ ---------------------------------------------------------------------
|
|
|
+ Function Declarations
|
|
|
+ ---------------------------------------------------------------------}
|
|
|
+
|
|
|
+{ Retrieving coordinates }
|
|
|
+function GetX: Integer;
|
|
|
+function GetY: Integer;
|
|
|
+
|
|
|
+{ Pixel-oriented routines }
|
|
|
+procedure PutPixel(X, Y: Integer; Pixel: Word);
|
|
|
+function GetPixel(X, Y: Integer): Word;
|
|
|
+
|
|
|
+{ Line-oriented primitives }
|
|
|
+procedure SetWriteMode(WriteMode: Integer);
|
|
|
+procedure LineTo(X, Y: Integer);
|
|
|
+procedure LineRel(Dx, Dy: Integer);
|
|
|
+procedure MoveTo(X, Y: Integer);
|
|
|
+procedure MoveRel(Dx, Dy: Integer);
|
|
|
+procedure Line(x1, y1, x2, y2: Integer);
|
|
|
+procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
|
|
|
+
|
|
|
+{ Linearly bounded primitives }
|
|
|
+procedure Rectangle(x1, y1, x2, y2: Integer);
|
|
|
+procedure Bar(x1, y1, x2, y2: Integer);
|
|
|
+procedure Bar3D(x1, y1, x2, y2: Integer; Depth: Word; Top: Boolean);
|
|
|
+procedure DrawPoly(NumPoints: Word; var PolyPoints);
|
|
|
+procedure FillPoly(NumPoints: Word; var PolyPoints);
|
|
|
+procedure SetFillStyle(Pattern: Word; Color: Word);
|
|
|
+procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
|
|
|
+procedure FloodFill(X, Y: Integer; Border: Word);
|
|
|
+
|
|
|
+{ Nonlinearly bounded primitives }
|
|
|
+
|
|
|
+procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
|
|
|
+procedure GetArcCoords(var ArcCoords: ArcCoordsType);
|
|
|
+procedure Circle(X, Y: Integer; Radius: Word);
|
|
|
+procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius : Word);
|
|
|
+procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word);
|
|
|
+procedure SetAspectRatio(Xasp, Yasp: Word);
|
|
|
+procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
|
|
|
+procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
|
|
|
+
|
|
|
+{ Color routines }
|
|
|
+procedure SetBkColor(ColorNum: Word);
|
|
|
+procedure SetColor(Color: Word);
|
|
|
+
|
|
|
+{ Bitmap utilities }
|
|
|
+procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
|
|
|
+procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
|
|
|
+function ImageSize(x1, y1, x2, y2: Integer): LongInt;
|
|
|
+
|
|
|
+{ Text routines}
|
|
|
+procedure OutText(TextString: string);
|
|
|
+procedure OutTextXY(X, Y: Integer; TextString: string);
|
|
|
+procedure SetTextJustify(Horiz, Vert: Word);
|
|
|
+procedure SetTextStyle(Font, Direction: Word; CharSize: Word);
|
|
|
+procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
|
|
|
+
|
|
|
+{ Graph clipping method }
|
|
|
+procedure SetViewPort(x1, y1, x2, y2: Integer; Clip: Boolean);
|
|
|
+
|
|
|
+{ Init/Done }
|
|
|
+procedure InitVideo;
|
|
|
+procedure DoneVideo;
|
|
|
+
|
|
|
+{ Other }
|
|
|
+function GetResX: Integer;
|
|
|
+function GetResY: Integer;
|
|
|
+function GetAspect: Real;
|
|
|
+
|
|
|
+const
|
|
|
+ NoGraphics: Boolean = false;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+implementation
|
|
|
+
|
|
|
+uses Objects, Linux;
|
|
|
+
|
|
|
+
|
|
|
+{ ---------------------------------------------------------------------
|
|
|
+ SVGA bindings.
|
|
|
+ ---------------------------------------------------------------------}
|
|
|
+
|
|
|
+{ Link with VGA, gl and c libraries }
|
|
|
+{$linklib vga}
|
|
|
+{$linklib gl}
|
|
|
+{$linklib c}
|
|
|
+
|
|
|
+ { Constants }
|
|
|
+const
|
|
|
+ { VGA modes }
|
|
|
+ TEXT = 0; { Compatible with VGAlib v1.2 }
|
|
|
+ G320x200x16 = 1;
|
|
|
+ G640x200x16 = 2;
|
|
|
+ G640x350x16 = 3;
|
|
|
+ G640x480x16 = 4;
|
|
|
+ G320x200x256 = 5;
|
|
|
+ G320x240x256 = 6;
|
|
|
+ G320x400x256 = 7;
|
|
|
+ G360x480x256 = 8;
|
|
|
+ G640x480x2 = 9;
|
|
|
+
|
|
|
+ G640x480x256 = 10;
|
|
|
+ G800x600x256 = 11;
|
|
|
+ G1024x768x256 = 12;
|
|
|
+
|
|
|
+ G1280x1024x256 = 13; { Additional modes. }
|
|
|
+
|
|
|
+ G320x200x32K = 14;
|
|
|
+ G320x200x64K = 15;
|
|
|
+ G320x200x16M = 16;
|
|
|
+ G640x480x32K = 17;
|
|
|
+ G640x480x64K = 18;
|
|
|
+ G640x480x16M = 19;
|
|
|
+ G800x600x32K = 20;
|
|
|
+ G800x600x64K = 21;
|
|
|
+ G800x600x16M = 22;
|
|
|
+ G1024x768x32K = 23;
|
|
|
+ G1024x768x64K = 24;
|
|
|
+ G1024x768x16M = 25;
|
|
|
+ G1280x1024x32K = 26;
|
|
|
+ G1280x1024x64K = 27;
|
|
|
+ G1280x1024x16M = 28;
|
|
|
+
|
|
|
+ G800x600x16 = 29;
|
|
|
+ G1024x768x16 = 30;
|
|
|
+ G1280x1024x16 = 31;
|
|
|
+
|
|
|
+ G720x348x2 = 32; { Hercules emulation mode }
|
|
|
+
|
|
|
+ G320x200x16M32 = 33; { 32-bit per pixel modes. }
|
|
|
+ G640x480x16M32 = 34;
|
|
|
+ G800x600x16M32 = 35;
|
|
|
+ G1024x768x16M32 = 36;
|
|
|
+ G1280x1024x16M32 = 37;
|
|
|
+
|
|
|
+ { additional resolutions }
|
|
|
+ G1152x864x16 = 38;
|
|
|
+ G1152x864x256 = 39;
|
|
|
+ G1152x864x32K = 40;
|
|
|
+ G1152x864x64K = 41;
|
|
|
+ G1152x864x16M = 42;
|
|
|
+ G1152x864x16M32 = 43;
|
|
|
+
|
|
|
+ G1600x1200x16 = 44;
|
|
|
+ G1600x1200x256 = 45;
|
|
|
+ G1600x1200x32K = 46;
|
|
|
+ G1600x1200x64K = 47;
|
|
|
+ G1600x1200x16M = 48;
|
|
|
+ G1600x1200x16M32 = 49;
|
|
|
+
|
|
|
+ GLASTMODE = 49;
|
|
|
+
|
|
|
+ { Text }
|
|
|
+
|
|
|
+ WRITEMODE_OVERWRITE = 0;
|
|
|
+ WRITEMODE_MASKED = 1;
|
|
|
+ FONT_EXPANDED = 0;
|
|
|
+ FONT_COMPRESSED = 2;
|
|
|
+
|
|
|
+ { Types }
|
|
|
+ type
|
|
|
+ pvga_modeinfo = ^vga_modeinfo;
|
|
|
+ vga_modeinfo = record
|
|
|
+ width,
|
|
|
+ height,
|
|
|
+ bytesperpixel,
|
|
|
+ colors,
|
|
|
+ linewidth, { scanline width in bytes }
|
|
|
+ maxlogicalwidth, { maximum logical scanline width }
|
|
|
+ startaddressrange, { changeable bits set }
|
|
|
+ maxpixels, { video memory / bytesperpixel }
|
|
|
+ haveblit, { mask of blit functions available }
|
|
|
+ flags: Longint; { other flags }
|
|
|
+ { Extended fields: }
|
|
|
+ chiptype, { Chiptype detected }
|
|
|
+ memory, { videomemory in KB }
|
|
|
+ linewidth_unit: Longint; { Use only a multiple of this as parameter for
|
|
|
+ set_displaystart }
|
|
|
+ linear_aperture: PChar; { points to mmap secondary mem aperture of card }
|
|
|
+ aperture_size: Longint; { size of aperture in KB if size>=videomemory.}
|
|
|
+ set_aperture_page: procedure (page: Longint);
|
|
|
+ { if aperture_size<videomemory select a memory page }
|
|
|
+ extensions: Pointer; { points to copy of eeprom for mach32 }
|
|
|
+ { depends from actual driver/chiptype.. etc. }
|
|
|
+ end;
|
|
|
+
|
|
|
+ PGraphicsContext = ^TGraphicsContext;
|
|
|
+ TGraphicsContext = record
|
|
|
+ ModeType: Byte;
|
|
|
+ ModeFlags: Byte;
|
|
|
+ Dummy: Byte;
|
|
|
+ FlipPage: Byte;
|
|
|
+ Width: LongInt;
|
|
|
+ Height: LongInt;
|
|
|
+ BytesPerPixel: LongInt;
|
|
|
+ Colors: LongInt;
|
|
|
+ BitsPerPixel: LongInt;
|
|
|
+ ByteWidth: LongInt;
|
|
|
+ VBuf: pointer;
|
|
|
+ Clip: LongInt;
|
|
|
+ ClipX1: LongInt;
|
|
|
+ ClipY1: LongInt;
|
|
|
+ ClipX2: LongInt;
|
|
|
+ ClipY2: LongInt;
|
|
|
+ ff: pointer;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { vga functions }
|
|
|
+ function vga_init: Longint; Cdecl; External;
|
|
|
+ function vga_getdefaultmode: Longint; Cdecl; External;
|
|
|
+ function vga_hasmode(mode: Longint): Boolean; Cdecl; External;
|
|
|
+ function vga_getmodeinfo(mode: Longint): pvga_modeinfo; Cdecl; External;
|
|
|
+ function vga_setmode(mode: Longint): Longint; Cdecl; External;
|
|
|
+
|
|
|
+ { gl functions }
|
|
|
+ procedure gl_setpixel(x, y, c: LongInt); Cdecl; External;
|
|
|
+ function gl_getpixel(x, y: LongInt): LongInt; cdecl; external;
|
|
|
+ procedure gl_line(x1, y1, x2, y2, c: LongInt); Cdecl; External;
|
|
|
+ procedure gl_fillbox(x, y, w, h, c: LongInt); Cdecl; External;
|
|
|
+ procedure gl_circle(x, y, r, c: LongInt ); Cdecl; External;
|
|
|
+ procedure gl_getbox(x, y, w, h: LongInt; dp: pointer); Cdecl; External;
|
|
|
+ procedure gl_putbox(x, y, w, h: LongInt; dp: pointer); Cdecl; External;
|
|
|
+ procedure gl_disableclipping; Cdecl; External;
|
|
|
+ procedure gl_enableclipping; Cdecl; External;
|
|
|
+ procedure gl_putboxpart(x, y, w, h, bw, bh: LongInt; b: pointer; xo, yo: LongInt); Cdecl; External;
|
|
|
+ function gl_rgbcolor(r, g, b: LongInt): LongInt; Cdecl; External;
|
|
|
+ function gl_setcontextvga(m: LongInt): LongInt; Cdecl; External;
|
|
|
+ function gl_allocatecontext: PGraphicsContext; Cdecl; External;
|
|
|
+ procedure gl_getcontext(gc: PGraphicsContext); Cdecl; External;
|
|
|
+ procedure gl_setrgbpalette; Cdecl; External;
|
|
|
+ procedure gl_freecontext(gc: PGraphicsContext); Cdecl; External;
|
|
|
+ procedure gl_setclippingwindow(x1, y1, x2, y2: LongInt); Cdecl; External;
|
|
|
+ procedure gl_setwritemode(wm: LongInt); Cdecl; External;
|
|
|
+ procedure gl_setfontcolors(bg, fg: LongInt); Cdecl; External;
|
|
|
+ procedure gl_writen(x, y, n: LongInt; s: PChar); Cdecl; External;
|
|
|
+ procedure gl_setfont(fw, fh: LongInt; fdp: pointer); Cdecl; External;
|
|
|
+ procedure gl_copyboxfromcontext(var gc: TGraphicsContext; x1, y1, w, h, x2, y2: LongInt); Cdecl; External;
|
|
|
+ procedure gl_setcontext(gc: PGraphicsContext); Cdecl; External;
|
|
|
+ function gl_setcontextvgavirtual(m: LongInt): LongInt; cdecl; external;
|
|
|
+ procedure gl_font8x8; Cdecl; External;
|
|
|
+
|
|
|
+{ ---------------------------------------------------------------------
|
|
|
+ Types, constants and variables
|
|
|
+ ---------------------------------------------------------------------}
|
|
|
+
|
|
|
+var
|
|
|
+ DrawDelta: TPoint;
|
|
|
+ CurX, CurY: Integer;
|
|
|
+ TheColor, TheFillColor: LongInt;
|
|
|
+ IsVirtual: Boolean;
|
|
|
+ PhysicalScreen, BackScreen: PGraphicsContext;
|
|
|
+ ColorTable: array[0..15] of LongInt;
|
|
|
+
|
|
|
+const
|
|
|
+ BgiColors: array[0..15] of LongInt
|
|
|
+ = ($000000, $000080, $008000, $008080,
|
|
|
+ $800000, $800080, $808000, $C0C0C0,
|
|
|
+ $808080, $0000FF, $00FF00, $00FFFF,
|
|
|
+ $FF0000, $FF00FF, $FFFF00, $FFFFFF);
|
|
|
+
|
|
|
+const
|
|
|
+ DoUseMarker: Boolean = true;
|
|
|
+ TheMarker: Char = '~';
|
|
|
+ TextColor: LongInt = 15;
|
|
|
+ MarkColor: LongInt = 15;
|
|
|
+ BackColor: LongInt = 0;
|
|
|
+ FontWidth: Integer = 8;
|
|
|
+ FontHeight: Integer = 8;
|
|
|
+
|
|
|
+var
|
|
|
+ sHoriz, sVert: Word;
|
|
|
+
|
|
|
+{ initialisierte Variablen }
|
|
|
+const
|
|
|
+ SourcePage: Word = 0;
|
|
|
+ DestPage: Word = 0;
|
|
|
+
|
|
|
+{ Retrieves the capabilities for the current mode }
|
|
|
+const
|
|
|
+ vmcImage = 1;
|
|
|
+ vmcCopy = 2;
|
|
|
+ vmcSaveRestore = 4;
|
|
|
+ vmcBuffer = 8;
|
|
|
+ vmcBackPut = 16;
|
|
|
+
|
|
|
+{ ---------------------------------------------------------------------
|
|
|
+ Graphics Vision Layer
|
|
|
+ ---------------------------------------------------------------------}
|
|
|
+
|
|
|
+
|
|
|
+{ Types and constants }
|
|
|
+var
|
|
|
+ SizeX, SizeY: Word;
|
|
|
+
|
|
|
+{ Draw origin and clipping rectangle }
|
|
|
+var
|
|
|
+ DrawOrigin: TPoint;
|
|
|
+ ClipRect: TRect;
|
|
|
+ MetaClipRect: TRect;
|
|
|
+ MetaOrigin: TPoint;
|
|
|
+
|
|
|
+{ Font attributes }
|
|
|
+const
|
|
|
+ ftNormal = 0;
|
|
|
+ ftBold = 1;
|
|
|
+ ftThin = 2;
|
|
|
+ ftItalic = 4;
|
|
|
+
|
|
|
+var
|
|
|
+ sFont, sColor:Word;
|
|
|
+ sCharSpace: Integer;
|
|
|
+ sMarker: Char;
|
|
|
+ sAttr: Word;
|
|
|
+
|
|
|
+{ Windows-style text metric }
|
|
|
+type
|
|
|
+ PTextMetric = ^TTextMetric;
|
|
|
+ TTextMetric = record
|
|
|
+ tmHeight: Integer;
|
|
|
+ tmAscent: Integer;
|
|
|
+ tmDescent: Integer;
|
|
|
+ tmInternalLeading: Integer;
|
|
|
+ tmExternalLeading: Integer;
|
|
|
+ tmAveCharWidth: Integer;
|
|
|
+ tmMaxCharWidth: Integer;
|
|
|
+ tmWeight: Integer;
|
|
|
+ tmItalic: Byte;
|
|
|
+ tmUnderlined: Byte;
|
|
|
+ tmStruckOut: Byte;
|
|
|
+ tmFirstChar: Byte;
|
|
|
+ tmLastChar: Byte;
|
|
|
+ tmDefaultChar: Byte;
|
|
|
+ tmBreakChar: Byte;
|
|
|
+ tmPitchAndFamily: Byte;
|
|
|
+ tmCharSet: Byte;
|
|
|
+ tmOverhang: Integer;
|
|
|
+ tmDigitizedAspectX: Integer;
|
|
|
+ tmDigitizedAspectY: Integer;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+{ Bitmap utilities }
|
|
|
+type
|
|
|
+ PBitmap = ^TBitmap;
|
|
|
+ TBitmap = record
|
|
|
+ Width, Height: Integer;
|
|
|
+ Data: record end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { Storing screen regions }
|
|
|
+type
|
|
|
+ TVgaBuf = record
|
|
|
+ Bounds: TRect;
|
|
|
+ Mem: Word;
|
|
|
+ Size: Word;
|
|
|
+ end;
|
|
|
+
|
|
|
+const
|
|
|
+ pbNone = 0;
|
|
|
+ pbCopy = 1;
|
|
|
+ pbClear = 2;
|
|
|
+
|
|
|
+type
|
|
|
+ PScreenBuf = ^TScreenBuf;
|
|
|
+ TScreenBuf = record
|
|
|
+ Mode: Word;
|
|
|
+ Rect: TRect;
|
|
|
+ Size: LongInt;
|
|
|
+ Info: LongInt
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+ { Procedures and functions }
|
|
|
+
|
|
|
+procedure SetColors;
|
|
|
+var
|
|
|
+ i: Integer;
|
|
|
+begin
|
|
|
+ for i:=0 to 15 do
|
|
|
+ ColorTable[i] := gl_rgbcolor(BgiColors[i] shr 16,
|
|
|
+ (BgiColors[i] shr 8) and 255,
|
|
|
+ BgiColors[i] and 255)
|
|
|
+end;
|
|
|
+
|
|
|
+procedure InitVideo;
|
|
|
+var
|
|
|
+ VgaMode: Integer;
|
|
|
+ ModeInfo: pvga_modeinfo;
|
|
|
+begin
|
|
|
+ if NoGraphics
|
|
|
+ then begin
|
|
|
+ SizeX := 640;
|
|
|
+ SizeY := 480
|
|
|
+ end
|
|
|
+ else begin
|
|
|
+ VgaMode := vga_getdefaultmode;
|
|
|
+ if (VgaMode = -1) then VgaMode := G320X200X256;
|
|
|
+ if (not vga_hasmode(VgaMode))
|
|
|
+ then begin
|
|
|
+ WriteLn('BGI: Mode not available.');
|
|
|
+ Halt(1)
|
|
|
+ end;
|
|
|
+ ModeInfo := vga_getmodeinfo(VgaMode);
|
|
|
+ {IsVirtual := (ModeInfo^.colors = 16) or (ModeInfo^.flags and IS_MODEX <> 0);}
|
|
|
+ IsVirtual := true;
|
|
|
+ { We always want a back screen (for buffering). }
|
|
|
+ if IsVirtual
|
|
|
+ then begin
|
|
|
+ { Create virtual screen }
|
|
|
+ gl_setcontextvgavirtual(VgaMode);
|
|
|
+ BackScreen := gl_allocatecontext;
|
|
|
+ gl_getcontext(BackScreen)
|
|
|
+ end;
|
|
|
+ vga_setmode(VgaMode);
|
|
|
+ gl_setcontextvga(VgaMode); { Physical screen context. }
|
|
|
+ PhysicalScreen := gl_allocatecontext;
|
|
|
+ gl_getcontext(PhysicalScreen);
|
|
|
+ if (PhysicalScreen^.colors = 256) then gl_setrgbpalette;
|
|
|
+ SetColors;
|
|
|
+ SizeX := PhysicalScreen^.Width;
|
|
|
+ SizeY := PhysicalScreen^.Height
|
|
|
+ end
|
|
|
+end;
|
|
|
+
|
|
|
+procedure DoneVideo;
|
|
|
+begin
|
|
|
+ if not NoGraphics
|
|
|
+ then begin
|
|
|
+ if IsVirtual then gl_freecontext(BackScreen);
|
|
|
+ vga_setmode(TEXT)
|
|
|
+ end
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetDelta;
|
|
|
+begin
|
|
|
+ if ClipRect.Empty
|
|
|
+ then begin
|
|
|
+ DrawDelta.X := 10000;
|
|
|
+ DrawDelta.Y := 10000;
|
|
|
+ end
|
|
|
+ else begin
|
|
|
+ DrawDelta.X := DrawOrigin.X;
|
|
|
+ DrawDelta.y := DrawOrigin.y
|
|
|
+ end
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetDrawOrigin(x, y: Integer);
|
|
|
+begin
|
|
|
+ DrawOrigin.x := x;
|
|
|
+ DrawOrigin.y := y;
|
|
|
+ SetDelta;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetDrawOriginP(var P: TPoint);
|
|
|
+begin
|
|
|
+ SetDrawOrigin(P.x, P.y)
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetClipRect(x1, y1, x2, y2: Integer);
|
|
|
+begin
|
|
|
+ Cliprect.Assign(x1, y1, x2, y2);
|
|
|
+ if not NoGraphics
|
|
|
+ then begin
|
|
|
+ if ClipRect.Empty
|
|
|
+ then gl_setclippingwindow(0, 0, 0, 0)
|
|
|
+ else gl_setclippingwindow(x1, y1, x2 - 1, y2 - 1);
|
|
|
+ {gl_enableclipping(0);}
|
|
|
+ end;
|
|
|
+ SetDelta
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetClipRectR(var R: TRect);
|
|
|
+begin
|
|
|
+ SetClipRect(R.A.X, R.A.Y, R.B.X, R.B.Y);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetMetaOrigin(x, y: Integer);
|
|
|
+begin
|
|
|
+ MetaOrigin.x := x;
|
|
|
+ MetaOrigin.y := y
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetMetaOriginP(P: TPoint);
|
|
|
+begin
|
|
|
+ SetMetaOrigin(P.x, P.y)
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetMetaClipRect(x1, y1, x2, y2: Integer);
|
|
|
+begin
|
|
|
+ MetaCliprect.Assign(x1, y1, x2, y2)
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetMetaClipRectR(var R: TRect);
|
|
|
+begin
|
|
|
+ MetaCliprect := R
|
|
|
+end;
|
|
|
+
|
|
|
+function GetBuffer(Size: Word): pointer;
|
|
|
+begin
|
|
|
+ { No metafiling available. }
|
|
|
+ GetBuffer := nil
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure HoriLine(x1,y1,x2: Integer);
|
|
|
+begin
|
|
|
+ Line(x1, y1, x2, y1)
|
|
|
+end;
|
|
|
+
|
|
|
+Procedure VertLine(x1,y1,y2: Integer);
|
|
|
+begin
|
|
|
+ Line(x1, y1, x1, y2)
|
|
|
+end;
|
|
|
+
|
|
|
+procedure FillCircle(xm, ym, r: Integer);
|
|
|
+begin
|
|
|
+ FillEllipse(xm, ym, r, r)
|
|
|
+end;
|
|
|
+
|
|
|
+{ Text routines }
|
|
|
+
|
|
|
+function TextWidth(s: string): Integer;
|
|
|
+var
|
|
|
+ i: Integer;
|
|
|
+begin
|
|
|
+ if DoUseMarker
|
|
|
+ then begin
|
|
|
+ For i := Length(s) downto 1 do
|
|
|
+ If s[i] = TheMarker then Delete(s, i, 1);
|
|
|
+ If s = ''
|
|
|
+ then TextWidth := 0
|
|
|
+ else TextWidth := Length(s) * FontWidth
|
|
|
+ end
|
|
|
+ else TextWidth := Length(s) * FontWidth
|
|
|
+end;
|
|
|
+
|
|
|
+function TextHeight(s: string): Integer;
|
|
|
+begin
|
|
|
+ TextHeight := FontHeight
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure OutText(TextString: string);
|
|
|
+begin
|
|
|
+ OutTextXY(GetX, GetY, TextString)
|
|
|
+end;
|
|
|
+
|
|
|
+procedure OutTextXY(X, Y: Integer; TextString: string);
|
|
|
+var
|
|
|
+ P, Q: PChar;
|
|
|
+ i: Integer;
|
|
|
+ col: Boolean;
|
|
|
+begin
|
|
|
+ if NoGraphics or (TextString='') then Exit;
|
|
|
+ gl_setwritemode(FONT_COMPRESSED + WRITEMODE_MASKED);
|
|
|
+ case sHoriz of
|
|
|
+ CenterText : Dec(x, TextWidth(TextString) div 2);
|
|
|
+ RightText : Dec(x, TextWidth(TextString));
|
|
|
+ end; { case }
|
|
|
+ case sVert of
|
|
|
+ CenterText : Dec(y, TextHeight(TextString) div 2);
|
|
|
+ BottomText, BaseLine : Dec(y, TextHeight(TextString));
|
|
|
+ end; { case }
|
|
|
+ MoveTo(X, Y);
|
|
|
+ P := @TextString[1]; Q := P;
|
|
|
+ col := false;
|
|
|
+ gl_setfontcolors(BackColor, TextColor);
|
|
|
+ For i := 1 to Length(TextString) do
|
|
|
+ begin
|
|
|
+ If (Q[0] = TheMarker) and DoUseMarker
|
|
|
+ then begin
|
|
|
+ If col then gl_setfontcolors(BackColor, MarkColor)
|
|
|
+ else gl_setfontcolors(BackColor, TextColor);
|
|
|
+ If Q <> P then begin
|
|
|
+ gl_writen(CurX, CurY, Q-P, P);
|
|
|
+ MoveRel(FontWidth * (Q-P), 0)
|
|
|
+ end;
|
|
|
+ col := not col;
|
|
|
+ P := Q + 1
|
|
|
+ end;
|
|
|
+ {Inc(Q)} Q := Q + 1
|
|
|
+ end;
|
|
|
+ If col then gl_setfontcolors(BackColor, MarkColor)
|
|
|
+ else gl_setfontcolors(BackColor, TextColor);
|
|
|
+ If Q <> P then begin
|
|
|
+ gl_writen(CurX, CurY, Q-P, P);
|
|
|
+ MoveRel(FontWidth * (Q-P), 0)
|
|
|
+ end
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetTextJustify(Horiz, Vert: Word);
|
|
|
+begin
|
|
|
+ sHoriz := Horiz; sVert := Vert;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetTextStyle(Font, Direction: Word; CharSize: Word);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetUserCharSize(MultX, DivX, MultY, DivY: Word);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetKern(Enable: Boolean);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetMarker(Marker: Char);
|
|
|
+begin
|
|
|
+ TheMarker := Marker
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure SetTextParams(Font: Word; CharSpace: Integer; Color: Word;
|
|
|
+ UseMarker: Boolean);
|
|
|
+type
|
|
|
+ pp = ^pointer;
|
|
|
+
|
|
|
+function FixCol(Col: Byte): Byte;
|
|
|
+{ SVGALIB cannot write black characters... }
|
|
|
+begin
|
|
|
+ if Col=0 then FixCol := 1 else FixCol := Col
|
|
|
+end; { FixCol }
|
|
|
+
|
|
|
+begin
|
|
|
+ sColor := Color; sCharSpace := CharSpace; sFont := Font;
|
|
|
+ if not NoGraphics then begin
|
|
|
+ TextColor := ColorTable[FixCol(Color and 15)];
|
|
|
+ MarkColor := ColorTable[FixCol((Color shr 8) and 15)];
|
|
|
+ DoUseMarker := UseMarker;
|
|
|
+ gl_setfont(8, 8, (pp(@gl_font8x8))^);
|
|
|
+ end
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+function GetResX: Integer;
|
|
|
+begin
|
|
|
+ GetResX := 96;
|
|
|
+end; { GetResX }
|
|
|
+
|
|
|
+function GetResY: Integer;
|
|
|
+begin
|
|
|
+ GetResY := 96
|
|
|
+end; { GetResY }
|
|
|
+
|
|
|
+function GetAspect: Real;
|
|
|
+begin
|
|
|
+ GetAspect := 1.0
|
|
|
+end; { GetAspect }
|
|
|
+
|
|
|
+procedure SetViewPort(x1, y1, x2, y2: Integer; Clip: Boolean);
|
|
|
+begin
|
|
|
+ SetDrawOrigin(x1, y1);
|
|
|
+ if Clip then SetClipRect(x1, y1, x2+1, y2+1)
|
|
|
+ else SetClipRect(0, 0, SizeX, SizeY)
|
|
|
+end;
|
|
|
+
|
|
|
+{ VGAMEM }
|
|
|
+
|
|
|
+type
|
|
|
+ TImage = record
|
|
|
+ end;
|
|
|
+
|
|
|
+procedure CopyScreen(x1, y1, x2, y2, x3, y3: Integer);
|
|
|
+begin
|
|
|
+ if not NoGraphics and (x2 > x1) and (y2 > y1)
|
|
|
+ then gl_copyboxfromcontext(PhysicalScreen^, x1, y1, x2 - x1, y2 - y1, x3, y3);
|
|
|
+end;
|
|
|
+
|
|
|
+{ BGI-like Image routines
|
|
|
+}
|
|
|
+
|
|
|
+function CopyImage(Image: pointer): pointer;
|
|
|
+begin
|
|
|
+ CopyImage := nil
|
|
|
+end;
|
|
|
+
|
|
|
+function CutImage(x1, y1, x2, y2: Integer): pointer;
|
|
|
+var
|
|
|
+ Image: PBitmap;
|
|
|
+begin
|
|
|
+
|
|
|
+ GetMem(Image, ImageSize(x1, y1, x2, y2));
|
|
|
+ if Image <> nil
|
|
|
+ then GetImage(x1, y1, x2, y2, Image^);
|
|
|
+ CutImage := Image;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure GetImageExtent(Image: pointer; var Extent: Objects.TPoint);
|
|
|
+begin
|
|
|
+ if Image = nil
|
|
|
+ then begin
|
|
|
+ Extent.X := 0;
|
|
|
+ Extent.Y := 0
|
|
|
+ end
|
|
|
+ else begin
|
|
|
+ Extent.X := PBitmap(Image)^.Width;
|
|
|
+ Extent.Y := PBitmap(Image)^.Height
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure FreeImage(Image: pointer);
|
|
|
+var
|
|
|
+ P: TPoint;
|
|
|
+begin
|
|
|
+ if Image <> nil
|
|
|
+ then begin
|
|
|
+ GetImageExtent(Image, P);
|
|
|
+ FreeMem(Image, ImageSize(0, 0, P.x - 1, P.y - 1));
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+function LoadImage(var S: TStream): pointer;
|
|
|
+begin
|
|
|
+ LoadImage := nil
|
|
|
+end;
|
|
|
+
|
|
|
+function MaskedImage(Image: pointer): pointer;
|
|
|
+begin
|
|
|
+ MaskedImage := nil;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure PasteImage(X, Y: Integer; Image: pointer; BitBlt: Word);
|
|
|
+begin
|
|
|
+ if Image <> nil then PutImage(X, Y, Image^, BitBlt)
|
|
|
+end;
|
|
|
+
|
|
|
+procedure StoreImage(var S: TStream; Image: pointer);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+{ Storing screen regions }
|
|
|
+function PrepBuf(var R: Objects.TRect; Action: Word; var Buf: TVgaBuf): Boolean;
|
|
|
+begin
|
|
|
+ if BackScreen <> nil
|
|
|
+ then begin
|
|
|
+ Buf.Bounds := R;
|
|
|
+ gl_setcontext(BackScreen);
|
|
|
+ gl_disableclipping;
|
|
|
+ case Action of
|
|
|
+ pbCopy : gl_copyboxfromcontext(PhysicalScreen^,
|
|
|
+ R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y,
|
|
|
+ R.A.X, R.A.Y);
|
|
|
+ pbClear : gl_fillbox(R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y, 0);
|
|
|
+ end;
|
|
|
+ PrepBuf := true;
|
|
|
+ SetDrawOrigin(0, 0);
|
|
|
+ SetClipRectR(R);
|
|
|
+ end
|
|
|
+ else PrepBuf := false
|
|
|
+end; { PrepBuf }
|
|
|
+
|
|
|
+procedure EndBufDraw;
|
|
|
+begin
|
|
|
+ if not NoGraphics
|
|
|
+ then gl_setcontext(PhysicalScreen);
|
|
|
+end; { EndBufDraw }
|
|
|
+
|
|
|
+procedure ReleaseBuf(var Buf: TVgaBuf);
|
|
|
+begin
|
|
|
+end; { ReleaseBuf }
|
|
|
+
|
|
|
+procedure PasteRectAt(var R: Objects.TRect; P: Objects.TPoint; var Buf: TVgaBuf);
|
|
|
+begin
|
|
|
+ if not NoGraphics and (BackScreen <> nil)
|
|
|
+ then gl_copyboxfromcontext(BackScreen^,
|
|
|
+ R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y,
|
|
|
+ P.X, P.Y);
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure PasteRect(var R: Objects.TRect; var Buf: TVgaBuf);
|
|
|
+begin
|
|
|
+ PasteRectAt(R, R.A, Buf);
|
|
|
+end; { PasteRect }
|
|
|
+
|
|
|
+
|
|
|
+function StoreScreen(x1, y1, x2, y2: Integer): PScreenBuf;
|
|
|
+var
|
|
|
+ s: LongInt;
|
|
|
+ Handle: Word;
|
|
|
+ p: pointer;
|
|
|
+ SaveOrigin: TPoint;
|
|
|
+
|
|
|
+function NewScreenBuf(AMode: Word; AnInfo: LongInt): PScreenBuf;
|
|
|
+ var
|
|
|
+ p: PScreenBuf;
|
|
|
+ Begin
|
|
|
+ New(p);
|
|
|
+ p^.Mode := AMode;
|
|
|
+ p^.Size := s;
|
|
|
+ p^.Rect.Assign(x1, y1, x2, y2);
|
|
|
+ p^.Info := AnInfo;
|
|
|
+ NewScreenBuf := p
|
|
|
+ End;
|
|
|
+
|
|
|
+Begin
|
|
|
+ { General Images }
|
|
|
+ s := 0;
|
|
|
+ SaveOrigin := DrawOrigin;
|
|
|
+ SetDrawOrigin(0, 0);
|
|
|
+ p := CutImage(x1, y1, x2-1, y2-1);
|
|
|
+ SetDrawOriginP(SaveOrigin);
|
|
|
+ If p <> nil
|
|
|
+ then StoreScreen := NewScreenBuf(2, LongInt(p))
|
|
|
+ else StoreScreen := nil
|
|
|
+End;
|
|
|
+
|
|
|
+procedure FreeScreenBuf(Buf: PScreenBuf);
|
|
|
+Begin
|
|
|
+ If Buf <> nil then Begin
|
|
|
+ case Buf^.Mode of
|
|
|
+ 2 : FreeImage(pointer(Buf^.Info));
|
|
|
+ end;
|
|
|
+ Dispose(Buf)
|
|
|
+ End
|
|
|
+End;
|
|
|
+
|
|
|
+procedure DrawScreenBufAt(Buf: PScreenBuf; x3, y3: Integer);
|
|
|
+var
|
|
|
+ SaveOrigin: TPoint;
|
|
|
+Begin
|
|
|
+ If Buf <> nil then
|
|
|
+ case Buf^.Mode of
|
|
|
+ 2 :
|
|
|
+ begin
|
|
|
+ SaveOrigin := DrawOrigin;
|
|
|
+ SetDrawOrigin(0, 0);
|
|
|
+ PasteImage(x3, y3, pointer(Buf^.Info), NormalPut);
|
|
|
+ SetDrawOriginP(SaveOrigin);
|
|
|
+ end
|
|
|
+ end
|
|
|
+End;
|
|
|
+
|
|
|
+procedure DrawScreenBuf(Buf: PScreenBuf);
|
|
|
+Begin
|
|
|
+ If Buf <> nil then
|
|
|
+ DrawScreenBufAt(Buf, Buf^.Rect.A.x, Buf^.Rect.A.y)
|
|
|
+End;
|
|
|
+
|
|
|
+function GetVgaMemCaps: Word;
|
|
|
+begin
|
|
|
+ GetVgaMemCaps := vmcCopy
|
|
|
+end;
|
|
|
+
|
|
|
+procedure GetTextMetrics(var Metrics: TTextMetric);
|
|
|
+begin
|
|
|
+ with Metrics do
|
|
|
+ begin
|
|
|
+ tmHeight := 8;
|
|
|
+ tmAscent := 8;
|
|
|
+ tmDescent := 0;
|
|
|
+ tmInternalLeading := 0;
|
|
|
+ tmExternalLeading := 0;
|
|
|
+ tmAveCharWidth := 8;
|
|
|
+ tmMaxCharWidth := 8;
|
|
|
+ tmWeight := 700;
|
|
|
+ tmItalic := 0;
|
|
|
+ tmUnderlined := 0;
|
|
|
+ tmStruckOut := 0;
|
|
|
+ tmFirstChar := 0;
|
|
|
+ tmLastChar := 255;
|
|
|
+ tmDefaultChar := 32;
|
|
|
+ tmBreakChar := 32;
|
|
|
+ tmPitchAndFamily := 0;
|
|
|
+ tmCharSet := 0;
|
|
|
+ tmOverhang := 0;
|
|
|
+ tmDigitizedAspectX := 100;
|
|
|
+ tmDigitizedAspectY := 100
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{ ---------------------------------------------------------------------
|
|
|
+ Real graph implementation
|
|
|
+ ---------------------------------------------------------------------}
|
|
|
+
|
|
|
+
|
|
|
+function GetX: Integer;
|
|
|
+begin
|
|
|
+ GetX := CurX - DrawDelta.X
|
|
|
+end;
|
|
|
+
|
|
|
+function GetY: Integer;
|
|
|
+begin
|
|
|
+ GetY := CurY - DrawDelta.Y
|
|
|
+end;
|
|
|
+
|
|
|
+{ Pixel-oriented routines }
|
|
|
+procedure PutPixel(X, Y: Integer; Pixel: Word);
|
|
|
+begin
|
|
|
+ if not NoGraphics
|
|
|
+ then gl_setpixel(X + DrawDelta.X, Y + DrawDelta.Y, Pixel)
|
|
|
+end;
|
|
|
+
|
|
|
+function GetPixel(X, Y: Integer): Word;
|
|
|
+begin
|
|
|
+ if NoGraphics
|
|
|
+ then GetPixel := 0
|
|
|
+ else GetPixel := gl_getpixel(X + DrawDelta.X, Y + DrawDelta.Y)
|
|
|
+end;
|
|
|
+
|
|
|
+{ Line-oriented primitives }
|
|
|
+procedure SetWriteMode(WriteMode: Integer);
|
|
|
+begin
|
|
|
+{ Graph.SetWriteMode(WriteMode) }
|
|
|
+end;
|
|
|
+
|
|
|
+procedure LineTo(X, Y: Integer);
|
|
|
+begin
|
|
|
+ if not NoGraphics
|
|
|
+ then gl_line(CurX, CurY, X + DrawDelta.X, Y + DrawDelta.Y, TheColor);
|
|
|
+ CurX := X + DrawDelta.X;
|
|
|
+ CurY := Y + DrawDelta.Y
|
|
|
+end;
|
|
|
+
|
|
|
+procedure LineRel(Dx, Dy: Integer);
|
|
|
+begin
|
|
|
+ if not NoGraphics
|
|
|
+ then gl_line(CurX, CurY, CurX + Dx, CurY + Dy, TheColor);
|
|
|
+ CurX := CurX + Dx;
|
|
|
+ CurY := CurY + Dy
|
|
|
+end;
|
|
|
+
|
|
|
+procedure MoveTo(X, Y: Integer);
|
|
|
+begin
|
|
|
+ CurX := X + DrawDelta.X;
|
|
|
+ CurY := Y + DrawDelta.Y
|
|
|
+end;
|
|
|
+
|
|
|
+procedure MoveRel(Dx, Dy: Integer);
|
|
|
+begin
|
|
|
+ CurX := CurX + Dx;
|
|
|
+ CurY := CurY + Dy
|
|
|
+end;
|
|
|
+
|
|
|
+procedure Line(x1, y1, x2, y2: Integer);
|
|
|
+begin
|
|
|
+ if not NoGraphics
|
|
|
+ then gl_line(x1 + DrawDelta.X, y1 + DrawDelta.Y,
|
|
|
+ x2 + DrawDelta.X, y2 + DrawDelta.Y, TheColor)
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetFillPattern(Pattern: FillPatternType; Color: Word);
|
|
|
+
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+{ Linearly bounded primitives }
|
|
|
+
|
|
|
+procedure Rectangle(x1, y1, x2, y2: Integer);
|
|
|
+begin
|
|
|
+ MoveTo(x1, y1);
|
|
|
+ LineTo(x2, y1);
|
|
|
+ LineTo(x2, y2);
|
|
|
+ LineTo(x1, y2);
|
|
|
+ LineTo(x1, y1)
|
|
|
+end;
|
|
|
+
|
|
|
+procedure Bar(x1, y1, x2, y2: Integer);
|
|
|
+var
|
|
|
+ R: TRect;
|
|
|
+begin
|
|
|
+ if not NoGraphics
|
|
|
+ then begin
|
|
|
+ R.Assign(x1 + DrawDelta.X, y1 + DrawDelta.Y,
|
|
|
+ x2 + DrawDelta.X + 1, y2 + DrawDelta.Y + 1);
|
|
|
+ R.Intersect(ClipRect);
|
|
|
+ if not R.Empty
|
|
|
+ then gl_fillbox(R.A.X, R.A.Y,
|
|
|
+ R.B.X - R.A.X, R.B.Y - R.A.Y, TheFillColor)
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure Bar3D(x1, y1, x2, y2: Integer; Depth: Word; Top: Boolean);
|
|
|
+begin
|
|
|
+ Bar(x1,y1,x2,y2);
|
|
|
+ Rectangle(x1,y1,x2,y2);
|
|
|
+ if top then begin
|
|
|
+ Moveto(x1,y1);
|
|
|
+ Lineto(x1+depth,y1-depth);
|
|
|
+ Lineto(x2+depth,y1-depth);
|
|
|
+ Lineto(x2,y1);
|
|
|
+ end;
|
|
|
+ Moveto(x2+depth,y1-depth);
|
|
|
+ Lineto(x2+depth,y2-depth);
|
|
|
+ Lineto(x2,y2);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure DrawPoly(NumPoints: Word; var PolyPoints);
|
|
|
+
|
|
|
+type
|
|
|
+ ppointtype = ^pointtype;
|
|
|
+
|
|
|
+var
|
|
|
+ i : longint;
|
|
|
+
|
|
|
+begin
|
|
|
+ line(ppointtype(@polypoints)[NumPoints-1].x,
|
|
|
+ ppointtype(@polypoints)[NumPoints-1].y,
|
|
|
+ ppointtype(@polypoints)[0].x,
|
|
|
+ ppointtype(@polypoints)[0].y);
|
|
|
+ for i:=0 to NumPoints-2 do
|
|
|
+ line(ppointtype(@polypoints)[i].x,
|
|
|
+ ppointtype(@polypoints)[i].y,
|
|
|
+ ppointtype(@polypoints)[i+1].x,
|
|
|
+ ppointtype(@polypoints)[i+1].y);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure FillPoly(NumPoints: Word; var PolyPoints);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetFillStyle(Pattern: Word; Color: Word);
|
|
|
+begin
|
|
|
+ TheFillColor := ColorTable[Color]
|
|
|
+end;
|
|
|
+
|
|
|
+procedure FloodFill(X, Y: Integer; Border: Word);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+{ Nonlinearly bounded primitives
|
|
|
+}
|
|
|
+procedure GetArcCoords(var ArcCoords: ArcCoordsType);
|
|
|
+
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+procedure Circle(X, Y: Integer; Radius: Word);
|
|
|
+begin
|
|
|
+ if not NoGraphics
|
|
|
+ then gl_circle(X + DrawDelta.X, Y + DrawDelta.Y, Radius, TheColor)
|
|
|
+end;
|
|
|
+
|
|
|
+procedure Ellipse(X, Y: Integer;
|
|
|
+ StAngle, EndAngle: Word; XRadius, YRadius : Word);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word);
|
|
|
+begin
|
|
|
+ Bar(X - XRadius, Y - YRadius, X + XRadius, Y + YRadius);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetAspectRatio(Xasp, Yasp: Word);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+procedure Sector(X, Y: Integer;
|
|
|
+ StAngle, EndAngle, XRadius, YRadius: Word);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+{ Color routines
|
|
|
+}
|
|
|
+
|
|
|
+procedure SetBkColor(ColorNum: Word);
|
|
|
+begin
|
|
|
+ BackColor := ColorTable[ColorNum];
|
|
|
+end;
|
|
|
+
|
|
|
+procedure SetColor(Color: Word);
|
|
|
+begin
|
|
|
+ TheColor := ColorTable[Color];
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);
|
|
|
+var
|
|
|
+ SaveClipRect: TRect;
|
|
|
+begin
|
|
|
+ with TBitmap(Bitmap) do
|
|
|
+ begin
|
|
|
+ Width := x2 - x1 + 1;
|
|
|
+ Height := y2 - y1 + 1;
|
|
|
+ if not NoGraphics
|
|
|
+ then begin
|
|
|
+ {gl_disableclipping(0);}
|
|
|
+ SaveClipRect := ClipRect;
|
|
|
+ SetClipRect(0, 0, SizeX, SizeY);
|
|
|
+ gl_getbox(x1 + DrawDelta.X, y1 + DrawDelta.Y,
|
|
|
+ x2 - x1 + 1, y2 - y1 + 1, @Data);
|
|
|
+ SetClipRectR(SaveClipRect)
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure PutImage(X, Y: Integer; var BitMap; BitBlt: Word);
|
|
|
+var
|
|
|
+ R: TRect;
|
|
|
+ SaveClipRect: TRect;
|
|
|
+begin
|
|
|
+ if not NoGraphics then
|
|
|
+ with TBitmap(Bitmap) do
|
|
|
+ begin
|
|
|
+ {gl_putbox(x + DrawDelta.X, y + DrawDelta.Y, Width, Height, @Data)}
|
|
|
+ R.Assign(X + DrawDelta.X, Y + DrawDelta.Y,
|
|
|
+ X + DrawDelta.X + Width, Y + DrawDelta.Y + Height);
|
|
|
+ R.Intersect(ClipRect);
|
|
|
+ if not R.Empty
|
|
|
+ then begin
|
|
|
+ {gl_disableclipping(0);}
|
|
|
+ SaveClipRect := ClipRect;
|
|
|
+ SetClipRect(0, 0, SizeX, SizeY);
|
|
|
+ gl_putboxpart(R.A.X, R.A.Y,
|
|
|
+ R.B.X - R.A.X, R.B.Y - R.A.Y,
|
|
|
+ Width, Height,
|
|
|
+ @Data,
|
|
|
+ R.A.X - X, R.A.Y - Y);
|
|
|
+ SetClipRectR(SaveClipRect);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end; { PutImage }
|
|
|
+
|
|
|
+function ImageSize(x1, y1, x2, y2: Integer): LongInt;
|
|
|
+begin
|
|
|
+ if NoGraphics
|
|
|
+ then ImageSize := SizeOf(TBitmap)
|
|
|
+ else ImageSize := SizeOf(TBitmap)
|
|
|
+ + LongInt(x2 - x1 + 1) * LongInt(y2 - y1 + 1) * PhysicalScreen^.BytesPerPixel;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+begin
|
|
|
+ { Give up root permissions if we are root. }
|
|
|
+ if geteuid = 0 then vga_init;
|
|
|
+end.
|
|
|
+
|
|
|
+{
|
|
|
+ $Log$
|
|
|
+ Revision 1.1 1998-04-15 13:40:11 michael
|
|
|
+ + Initial implementation of graph unit
|
|
|
+
|
|
|
+}
|
michael