+ Initial implementation of graph unit

rtl/linux/graph.pp

@@ -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
+
+}

rtl/linux/makefile

@@ -201,7 +201,7 @@ ASMEXT=.s
 SYSTEMPPU=syslinux$(PPUEXT)
 OBJECTS=strings linux objpas \
 	dos crt objects printer \
-	getopts errors sockets \
+	getopts errors sockets graph\
 
 # Extra Syslinux Depends
 ifeq ($(LINK_TO_C),YES)
@@ -356,6 +356,9 @@ printer$(PPUEXT) : printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
 	$(PP) $(OPT) printer $(REDIR)
 	$(DEL) textrec.inc
 
+graph$(PPUEXT) : graph.pp linux$(PPUEXT) objects$(PPUEXT)
+	$(PP) $(OPT) graph $(REDIR)
+
 #
 # Other RTL Units
 #