diff --git a/rtl/linux/graph.pp b/rtl/linux/graph.pp new file mode 100644 index 0000000000..35bfe015aa --- /dev/null +++ b/rtl/linux/graph.pp @@ -0,0 +1,1364 @@ +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; + 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 + +} diff --git a/rtl/linux/makefile b/rtl/linux/makefile index e399184dbf..a4a24ac22e 100644 --- a/rtl/linux/makefile +++ b/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 #