unit Graph; { ********************************************************************* $Id$ Copyright 1997,1998 Matthias K"oppe 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 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; 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.2 1998-05-12 10:42:47 peter * moved getopts to inc/, all supported OS's need argc,argv exported + strpas, strlen are now exported in the systemunit * removed logs * removed $ifdef ver_above Revision 1.1 1998/04/15 13:40:11 michael + Initial implementation of graph unit }