Re: Some patches for grx-2.4.3

-- Maurice Lombardi Laboratoire de Spectrometrie Physique, Universite Joseph Fourier de Grenoble, BP87 38402 Saint Martin d'Heres Cedex FRANCE Tel: 33 (0)4 76 51 47 51 Fax: 33 (0)4 76 51 45 44 mailto:Maurice.Lombardi@ujf-grenoble.fr --- grx243.orig/src/makefile.dj2 Wed Jun 27 01:42:14 2001 +++ grx243/src/makefile.dj2 Wed Jul 11 21:13:28 2001 @@ -173,6 +173,7 @@ ifdef GRX_DEFAULT_FONT_PATH FONTPATHdos = $(subst /,,$(GRX_DEFAULT_FONT_PATH)) install-fonts: + if not exist $(FONTPATHdos)\nul mkdir $(FONTPATHdos) copy ..\fonts*.* $(FONTPATHdos) uninstall-fonts: del $(FONTPATHdos)*.* diff -u -Nr grx243.franck/pascal/bgi/graph.pas grx243/pascal/bgi/graph.pas --- grx243.franck/pascal/bgi/graph.pas Wed Oct 3 11:37:44 2001 +++ grx243/pascal/bgi/graph.pas Sat Oct 6 12:08:46 2001 @@ -276,27 +276,27 @@ Type PaletteType = record - Size : Byte; - Colors : array[0..MaxColors] of Byte; + Size : Byte; + Colors : array[0..MaxColors] of Byte; end; LineSettingsType = record - LineStyle : Integer; - uPattern : ShortInt; { ??? original Pattern } - Thickness : Integer; + LineStyle : Integer; + uPattern : ShortInt; { ??? original Pattern } + Thickness : Integer; end; TextSettingsType = record - Font : Integer; - Direction : Integer; - CharSize : Integer; - Horiz : Integer; - Vert : Integer; + Font : Integer; + Direction : Integer; + CharSize : Integer; + Horiz : Integer; + Vert : Integer; end; FillSettingsType = record - Pattern : Integer; - Color : Integer; + Pattern : Integer; + Color : Integer; end; FillPatternType = array[1..8] of Byte; @@ -305,17 +305,17 @@ definition 'int pts[][2]' used to define polygons } PointType = record - X, Y : Integer; + X, Y : Integer; end; ViewPortType = record - left, top, right, bottom : Integer; - Clip : Boolean; { ??? was Integer } + left, top, right, bottom : Integer; + Clip : Boolean; { ??? was Integer } end; ArcCoordsType = record - X, Y:Integer; - Xstart, Ystart, Xend, Yend : Integer; + X, Y:Integer; + Xstart, Ystart, Xend, Yend : Integer; end; { ------------------------------------------------------------------ } @@ -340,7 +340,7 @@ procedure PutPixel(X, Y: Integer; Pixel: Integer); C; procedure Bar3D(left, top, right, bottom: Integer; Depth: Integer; TopFlag: Boolean); C; procedure Rectangle(left, top, right, bottom: Integer); C; -procedure FillPoly(NumPoints: Word; var PolyPoints); C; +procedure FillPoly(NumPoints: Word; var PolyPoints { : array of PointType }); C; procedure FillEllipse(X, Y: Integer; XRadius, YRadius: Integer); C; procedure GetArcCoords(var ArcCoords: ArcCoordsType); C; procedure FloodFill(X, Y: Integer; Border: Integer); C; @@ -379,7 +379,7 @@ procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word); AsmName '__gr_arc'; procedure Circle(X,Y: Integer; Radius: Word); AsmName '__gr_circle'; procedure ClearDevice; AsmName '__gr_cleardevice'; -procedure DrawPoly(NumPoints: Word; var PolyPoints); AsmName '__gr_drawpoly'; +procedure DrawPoly(NumPoints: Word; var PolyPoints { : array of PointType }); AsmName '__gr_drawpoly'; procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius: Word); AsmName '__gr_ellipse'; procedure GetAspectRatio(var Xasp, Yasp: Integer); AsmName '__gr_getaspectratio'; function GetBkColor: Word; AsmName '__gr_getbkcolor'; diff -u -Nr grx243.franck/pascal/grx.pas grx243/pascal/grx.pas --- grx243.franck/pascal/grx.pas Sat Oct 6 19:30:38 2001 +++ grx243/pascal/grx.pas Sat Oct 6 13:13:46 2001 @@ -50,6 +50,12 @@ GrColor = Integer (32); (* color and operation type, must be 32bit *) GrColorPtr = ^GrColor; +{ This definition is compatible with the grx + definition 'int pts[][2]' used to define polygons } + PointType = record + X, Y : Integer; + end; + Const (* these are the supported configurations: *) GRX_VERSION_TCC_8086_DOS = 1; (* also works with BCC *) @@ -450,7 +456,7 @@ Function GrAllocColorID(r,g,b:Integer):GrColor; AsmName 'GrAllocColorID'; { potentially inlined version } Function GrAllocCell:GrColor; AsmName 'GrAllocCell'; { unshared, read-write } -Function GrAllocEgaColors:GrColorPtr; AsmName 'GrAllocEgaColor'; { shared, read-only standard EGA colors } +Function GrAllocEgaColors:GrColorPtr; AsmName 'GrAllocEgaColors'; { shared, read-only standard EGA colors } Procedure GrSetColor(c:GrColor; r,g,b:Integer); AsmName 'GrSetColor'; Procedure GrFreeColor(c:GrColor); AsmName 'GrFreeColor'; @@ -482,8 +488,8 @@ Procedure GrBox(x1, y1, x2, y2: Integer; c: GrColor); AsmName 'GrBox'; Procedure GrFilledBox(x1, y1, x2, y2: Integer; c: GrColor); AsmName 'GrFilledBox'; Procedure GrFramedBox(x1, y1, x2, y2, wdt: Integer; var c: GrFBoxColors); AsmName 'GrFramedBox'; -Function GrGenerateEllipse(xc, yc, xa, ya:Integer; var poIntegers: array of Integer):Integer; AsmName 'GrGenerateEllipse'; -Function GrGenerateEllipseArc(xc, yc, xa, ya, start, ende: Integer; var poIntegers: array of Integer):Integer; AsmName 'GrGenerateEllipseArc'; +Function GrGenerateEllipse(xc, yc, xa, ya:Integer; var poIntegers{ : array of PointType }):Integer; AsmName 'GrGenerateEllipse'; +Function GrGenerateEllipseArc(xc, yc, xa, ya, start, ende: Integer; var poIntegers{ : array of PointType }):Integer; AsmName 'GrGenerateEllipseArc'; Procedure GrLastArcCoords(var xs, ys, xe, ye, xc, yc: Integer); AsmName 'GrLastArcCoords'; Procedure GrCircle(xc, yc, r: Integer; c: GrColor); AsmName 'GrCircle'; Procedure GrEllipse(xc, yc, xa, ya: Integer; c: GrColor); AsmName 'GrEllipse'; @@ -493,10 +499,10 @@ Procedure GrFilledEllipse(xc, yc, xa, ya: Integer; c: GrColor); AsmName 'GrFilledEllipse'; Procedure GrFilledCircleArc(xc, yc, r, start, ende, style: Integer; c: GrColor); AsmName 'GrFilledCircleArc'; Procedure GrFilledEllipseArc(xc, yc, xa, ya, start, ende, style: Integer; c: GrColor); AsmName 'GrFilledEllipseArc'; -Procedure GrPolyLine(numpts: Integer; var poIntegers: array of Integer; c: GrColor); AsmName 'GrPolyLine'; -Procedure GrPolygon(numpts: Integer; var poIntegers:array of Integer; c: GrColor); AsmName 'GrPolygon'; -Procedure GrFilledConvexPolygon(numpts: Integer; var poIntegers:array of Integer; c: GrColor); AsmName 'GrFilledConvexPolygon'; -Procedure GrFilledPolygon(numpts: Integer; var poIntegers:array of Integer; c: GrColor); AsmName 'GrFilledPolygon'; +Procedure GrPolyLine(numpts: Integer; var poIntegers{ : array of PointType }; c: GrColor); AsmName 'GrPolyLine'; +Procedure GrPolygon(numpts: Integer; var poIntegers{ : array of PointType }; c: GrColor); AsmName 'GrPolygon'; +Procedure GrFilledConvexPolygon(numpts: Integer; var poIntegers{ : array of PointType }; c: GrColor); AsmName 'GrFilledConvexPolygon'; +Procedure GrFilledPolygon(numpts: Integer; var poIntegers{ : array of PointType }; c: GrColor); AsmName 'GrFilledPolygon'; Procedure GrBitBlt(dst: GrContextPtr; x, y: Integer; src: GrContextPtr; x1, y1, x2, y2: Integer; op: GrColor); AsmName 'GrBitBlt'; Function GrPixel(x, y:Integer):GrColor; AsmName 'GrPixel'; Function GrPixelC(c: GrContextPtr; x, y: Integer): GrColor; AsmName 'GrPixelC'; @@ -730,8 +736,8 @@ Procedure GrCustomEllipse(xc, yc, r: Integer; var o: GrLineOption); AsmName 'GrCustomEllipse'; Procedure GrCustomCircleArc(xc, yc, r, start, ende, style: Integer; var o: GrLineOption); AsmName 'GrCustomCircleArc'; Procedure GrCustomEllipseArc(xc, yc, xa, ya, start, ende, style: Integer; var o: GrLineOption); AsmName 'GrCustomEllipseArc'; -Procedure GrCustomPolyLine(numpts: Integer; var poIntegers: array of Integer; var o: GrLineOption); AsmName 'GrCustomPolyLine'; -Procedure GrCustomPolygon(numpts: Integer; var poIntegers: array of Integer; var o: GrLineOption); AsmName 'GrCustomPolygon'; +Procedure GrCustomPolyLine(numpts: Integer; var poIntegers{ : array of PointType }; var o: GrLineOption); AsmName 'GrCustomPolyLine'; +Procedure GrCustomPolygon(numpts: Integer; var poIntegers{ : array of PointType }; var o: GrLineOption); AsmName 'GrCustomPolygon'; { ================================================================== PATTERNED DRAWING AND FILLING PRIMITIVES @@ -805,8 +811,8 @@ Procedure GrPatternedEllipse(xc, yc, xa, ya: Integer; lp: GrLinePatternPtr); AsmName 'GrPatternedEllipse'; Procedure GrPatternedCircleArc(xc, yc, r, start, ende, style: Integer; lp: GrLinePatternPtr); AsmName 'GrPatternedCircleArc'; Procedure GrPatternedEllipseArc(xc, yc, xa, ya, start, ende, style: Integer; lp: GrLinePatternPtr); AsmName 'GrPatternedEllipseArc'; -Procedure GrPatternedPolyLine(numpts: Integer; var poIntegers: array of Integer; lp: GrLinePatternPtr); AsmName 'GrPatternedPolyLine'; -Procedure GrPatternedPolygon(numpts: Integer; var poIntegers: array of Integer; lp: GrLinePatternPtr); AsmName 'GrPatternedPolygon'; +Procedure GrPatternedPolyLine(numpts: Integer; var poIntegers{ : array of PointType }; lp: GrLinePatternPtr); AsmName 'GrPatternedPolyLine'; +Procedure GrPatternedPolygon(numpts: Integer; var poIntegers{ : array of PointType }; lp: GrLinePatternPtr); AsmName 'GrPatternedPolygon'; Procedure GrPatternFilledPlot(x, y: Integer; p: GrPatternPtr); AsmName 'GrPatternFilledPlot'; Procedure GrPatternFilledLine(x1, y1, x2, y2: Integer; p: GrPatternPtr); AsmName 'GrPatternFilledLine'; @@ -815,8 +821,8 @@ Procedure GrPatternFilledEllipse(xc, yc, xa, ya: Integer; p: GrPatternPtr); AsmName 'GrPatternFilledEllipse'; Procedure GrPatternFilledCircleArc(xc, yc, r, start, ende, style: Integer; p: GrPatternPtr); AsmName 'GrPatternFilledCircleArc'; Procedure GrPatternFilledEllipseArc(xc, yc, xa, ya, start, ende, style: Integer; p: GrPatternPtr); AsmName 'GrPatternFilledEllipseArc'; -Procedure GrPatternFilledConvexPolygon(numpts: Integer; var poIntegers: array of Integer; p: GrPatternPtr); AsmName 'GrPatternFilledConvexPolygon'; -Procedure GrPatternFilledPolygon(numpts: Integer; var poIntegers: array of Integer; p: GrPatternPtr); AsmName 'GrPatternFilledPolygon'; +Procedure GrPatternFilledConvexPolygon(numpts: Integer; var poIntegers{ : array of PointType }; p: GrPatternPtr); AsmName 'GrPatternFilledConvexPolygon'; +Procedure GrPatternFilledPolygon(numpts: Integer; var poIntegers{ : array of PointType }; p: GrPatternPtr); AsmName 'GrPatternFilledPolygon'; Procedure GrPatternFloodFill(x, y: Integer; border: GrColor; p: GrPatternPtr); AsmName 'GrPatternFloodFill'; Procedure GrPatternDrawChar(chr, x, y: Integer; var opt: GrTextOption; p: GrPatternPtr); AsmName 'GrPatternDrawChar'; @@ -889,10 +895,10 @@ Procedure GrUsrFilledEllipse(xc, yc, xa, ya: Integer; c: GrColor); AsmName 'GrUsrFilledEllipse'; Procedure GrUsrFilledCircleArc(xc, yc, r, start, ende, style: Integer; c: GrColor); AsmName 'GrUsrFilledCircleArc'; Procedure GrUsrFilledEllipseArc(xc, yc, xa, ya, start, ende, style: Integer; c: GrColor); AsmName 'GrUsrFilledEllipseArc'; -Procedure GrUsrPolyLine(numpts: Integer; var poIntegers: array of Integer; c: GrColor); AsmName 'GrUsrPolyLine'; -Procedure GrUsrPolygon(numpts: Integer; var poIntegers:array of Integer; c: GrColor); AsmName 'GrUsrPolygon'; -Procedure GrUsrFilledConvexPolygon(numpts: Integer; var poIntegers:array of Integer; c: GrColor); AsmName 'GrUsrFilledConvexPolygon'; -Procedure GrUsrFilledPolygon(numpts: Integer; var poIntegers:array of Integer; c: GrColor); AsmName 'GrUsrFilledPolygon'; +Procedure GrUsrPolyLine(numpts: Integer; var poIntegers{ : array of PointType }; c: GrColor); AsmName 'GrUsrPolyLine'; +Procedure GrUsrPolygon(numpts: Integer; var poIntegers{ : array of PointType }; c: GrColor); AsmName 'GrUsrPolygon'; +Procedure GrUsrFilledConvexPolygon(numpts: Integer; var poIntegers{ : array of PointType }; c: GrColor); AsmName 'GrUsrFilledConvexPolygon'; +Procedure GrUsrFilledPolygon(numpts: Integer; var poIntegers{ : array of PointType }; c: GrColor); AsmName 'GrUsrFilledPolygon'; Procedure GrUsrFloodFill(x, y: Integer; border, c: GrColor); AsmName 'GrUsrFloodFill'; Function GrUsrPixel(x, y:Integer):GrColor; AsmName 'GrUsrPixel'; @@ -904,8 +910,8 @@ Procedure GrUsrCustomEllipse(xc, yc, r: Integer; var o: GrLineOption); AsmName 'GrUsrCustomEllipse'; Procedure GrUsrCustomCircleArc(xc, yc, r, start, ende, style: Integer; var o: GrLineOption); AsmName 'GrUsrCustomCircleArc'; Procedure GrUsrCustomEllipseArc(xc, yc, xa, ya, start, ende, style: Integer; var o: GrLineOption); AsmName 'GrUsrCustomEllipseArc'; -Procedure GrUsrCustomPolyLine(numpts: Integer; var poIntegers: array of Integer; var o: GrLineOption); AsmName 'GrUsrCustomPolyLine'; -Procedure GrUsrCustomPolygon(numpts: Integer; var poIntegers: array of Integer; var o: GrLineOption); AsmName 'GrUsrCustomPolygon'; +Procedure GrUsrCustomPolyLine(numpts: Integer; var poIntegers{ : array of PointType }; var o: GrLineOption); AsmName 'GrUsrCustomPolyLine'; +Procedure GrUsrCustomPolygon(numpts: Integer; var poIntegers{ : array of PointType }; var o: GrLineOption); AsmName 'GrUsrCustomPolygon'; Procedure GrUsrPatternedLine(x1, y1, x2, y2: Integer; lp: GrLinePatternPtr); AsmName 'GrUsrPatternedLine'; Procedure GrUsrPatternedBox(x1, y1, x2, y2: Integer; lp: GrLinePatternPtr); AsmName 'GrUsrPatternedBox'; @@ -913,8 +919,8 @@ Procedure GrUsrPatternedEllipse(xc, yc, xa, ya: Integer; lp: GrLinePatternPtr); AsmName 'GrUsrPatternedEllipse'; Procedure GrUsrPatternedCircleArc(xc, yc, r, start, ende, style: Integer; lp: GrLinePatternPtr); AsmName 'GrUsrPatternedCircleArc'; Procedure GrUsrPatternedEllipseArc(xc, yc, xa, ya, start, ende, style: Integer; lp: GrLinePatternPtr); AsmName 'GrUsrPatternedEllipseArc'; -Procedure GrUsrPatternedPolyLine(numpts: Integer; var poIntegers: array of Integer; lp: GrLinePatternPtr); AsmName 'GrUsrPatternedPolyLine'; -Procedure GrUsrPatternedPolygon(numpts: Integer; var poIntegers: array of Integer; lp: GrLinePatternPtr); AsmName 'GrUsrPatternedPolygon'; +Procedure GrUsrPatternedPolyLine(numpts: Integer; var poIntegers{ : array of PointType }; lp: GrLinePatternPtr); AsmName 'GrUsrPatternedPolyLine'; +Procedure GrUsrPatternedPolygon(numpts: Integer; var poIntegers{ : array of PointType }; lp: GrLinePatternPtr); AsmName 'GrUsrPatternedPolygon'; Procedure GrUsrPatternFilledPlot(x, y: Integer; p: GrPatternPtr); AsmName 'GrPatternFilledPlot'; Procedure GrUsrPatternFilledLine(x1, y1, x2, y2: Integer; p: GrPatternPtr); AsmName 'GrUsrPatternFilledLine'; @@ -923,8 +929,8 @@ Procedure GrUsrPatternFilledEllipse(xc, yc, xa, ya: Integer; p: GrPatternPtr); AsmName 'GrUsrPatternFilledEllipse'; Procedure GrUsrPatternFilledCircleArc(xc, yc, r, start, ende, style: Integer; p: GrPatternPtr); AsmName 'GrUsrPatternFilledCircleArc'; Procedure GrUsrPatternFilledEllipseArc(xc, yc, xa, ya, start, ende, style: Integer; p: GrPatternPtr); AsmName 'GrUsrPatternFilledEllipseArc'; -Procedure GrUsrPatternFilledConvexPolygon(numpts: Integer; var poIntegers: array of Integer; p: GrPatternPtr); AsmName 'GrUsrPatternFilledConvexPolygon'; -Procedure GrUsrPatternFilledPolygon(numpts: Integer; var poIntegers: array of Integer; p: GrPatternPtr); AsmName 'GrUsrPatternFilledPolygon'; +Procedure GrUsrPatternFilledConvexPolygon(numpts: Integer; var poIntegers{ : array of PointType }; p: GrPatternPtr); AsmName 'GrUsrPatternFilledConvexPolygon'; +Procedure GrUsrPatternFilledPolygon(numpts: Integer; var poIntegers{ : array of PointType }; p: GrPatternPtr); AsmName 'GrUsrPatternFilledPolygon'; Procedure GrUsrPatternFloodFill(x, y: Integer; border: GrColor; p: GrPatternPtr); AsmName 'GrUsrPatternFloodFill'; Procedure GrUsrDrawChar(chr, x, y: Integer; var opt: GrTextOption); AsmName 'GrUsrDrawChar'; diff -u -Nr grx243.franck/pascal/makefile grx243/pascal/makefile --- grx243.franck/pascal/makefile Fri Oct 27 14:35:22 2000 +++ grx243/pascal/makefile Sat Oct 6 19:19:20 2001 @@ -8,7 +8,7 @@ # Set the library-path to libjpeg and libtiff GRAPHICSLIB = -L/usr/lib -# Compiler and optins on your system +# Compiler and options on your system COMPILER = gpc --automake -Wall # Needed libraries (at least jpeg and tiff) @@ -18,7 +18,7 @@ # I Think, you don't need to change from here # -------------------------------------------- -all: blt_test modetest taste txt_test vir_test +all: blt_test modetest taste txt_test vir_test polytest blt_test:blt_test.pas $(COMPILER) $(GRXLIB) $(GRAPHICSLIB) $(LIBRARIES) blt_test.pas -oblt_test @@ -35,7 +35,10 @@ vir_test:vir_test.pas $(COMPILER) $(GRXLIB) $(GRAPHICSLIB) $(LIBRARIES) vir_test.pas -ovir_test +polytest:polytest.pas + $(COMPILER) $(GRXLIB) $(GRAPHICSLIB) $(LIBRARIES) polytest.pas -opolytest + clean: - rm -f *.o *.gpi blt_test modetest taste txt_test vir_test + rm -f *.o *.gpi blt_test modetest taste txt_test vir_test polytest diff -u -Nr grx243.franck/pascal/makefile.dj2 grx243/pascal/makefile.dj2 --- grx243.franck/pascal/makefile.dj2 Thu Jun 7 23:10:38 2001 +++ grx243/pascal/makefile.dj2 Sat Oct 6 16:26:28 2001 @@ -36,7 +36,8 @@ modetest.exe \ taste.exe \ txt_test.exe \ - vir_test.exe + vir_test.exe \ + polytest.exe all: $(PROGS) diff -u -Nr grx243.franck/pascal/makefile.lnx grx243/pascal/makefile.lnx --- grx243.franck/pascal/makefile.lnx Thu Jun 7 23:09:42 2001 +++ grx243/pascal/makefile.lnx Sat Oct 6 16:26:50 2001 @@ -36,7 +36,8 @@ modetest \ taste \ txt_test \ - vir_test + vir_test \ + polytest all: $(PROGS) diff -u -Nr grx243.franck/pascal/makefile.w32 grx243/pascal/makefile.w32 --- grx243.franck/pascal/makefile.w32 Thu Jun 7 23:11:04 2001 +++ grx243/pascal/makefile.w32 Sat Oct 6 16:27:12 2001 @@ -36,7 +36,8 @@ modetest.exe \ taste.exe \ txt_test.exe \ - vir_test.exe + vir_test.exe \ + polytest.exe all: $(PROGS) diff -u -Nr grx243.franck/pascal/makefile.x11 grx243/pascal/makefile.x11 --- grx243.franck/pascal/makefile.x11 Thu Jun 7 23:10:10 2001 +++ grx243/pascal/makefile.x11 Sat Oct 6 16:27:36 2001 @@ -36,7 +36,8 @@ xmodetest \ xtaste \ xtxt_test \ - xvir_test + xvir_test \ + xpolytest all: $(PROGS) diff -u -Nr grx243.franck/pascal/polytest.pas grx243/pascal/polytest.pas --- grx243.franck/pascal/polytest.pas Thu Jan 1 00:00:00 1970 +++ grx243/pascal/polytest.pas Sat Oct 6 19:09:14 2001 @@ -0,0 +1,146 @@ +(** + ** polytest.pas ---- test polygon rendering + ** + ** Copyright (c) 1995 Csaba Biegl, 820 Stirrup Dr, Nashville, TN 37221 + ** [e-mail: csaba@vuse.vanderbilt.edu] + ** + ** This is a test/demo file of the GRX graphics library. + ** You can use GRX test/demo files as you want. + ** + ** The GRX graphics library is free software; you can redistribute it + ** and/or modify it under some conditions; see the "copying.grx" file + ** for details. + ** + ** 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. + ** + **) + +program polytest; + +uses gpc, grx, test; + +type EGA = array [0..63] of GrColor; + EGAPtr = ^EGA; + WrkString = string[80]; + +var f : text; + line : WrkString; + nb : integer; + convex,collect : boolean; + k : GrKeyType; + polygon : array [0..300] of PointType; + pEGA : EGAPtr; + black,white,red : GrColor; + +procedure TestPoly(n:integer; var points: array of PointType; convex:boolean); +begin + GrClearScreen(black); + GrPolygon(n,points,white); + GrFilledPolygon(n,points,(red or GrXOR)); + k:=GrKeyRead; + if convex or (n <= 3) then begin + GrClearScreen(black); + GrFilledPolygon(n,points,white); + GrFilledConvexPolygon(n,points,(red or GrXOR)); + k:=GrKeyRead; + end; +end; + +procedure SpeedTest; +var + pts : array[0..3,0..1] of integer; + ww : integer = GrSizeX div 10; + hh : integer = GrSizeY div 10; + sx : integer = (GrSizeX - 2*ww) div 32; + sy : integer = (GrSizeY - 2*hh) div 32; + ii,jj : integer; + color : GrColor; + t1,t2,t3,mu1,mu2,mu3: integer; +begin + GrClearScreen(black); + t1 := GetCPUTime(mu1); + pts[0][1] := 0; + pts[1][1] := hh; + pts[2][1] := 2*hh; + pts[3][1] := hh; + color := 0; + for ii := 0 to 31 do begin + pts[0][0] := ww; + pts[1][0] := 2*ww; + pts[2][0] := ww; + pts[3][0] := 0; + for jj := 0 to 31 do begin + GrFilledPolygon(4,pts, pEGA^[color] or GrXOR); + color := (color + 1) and 15; + inc(pts[0][0],sx); + inc(pts[1][0],sx); + inc(pts[2][0],sx); + inc(pts[3][0],sx); + end; + inc(pts[0][1],sy); + inc(pts[1][1],sy); + inc(pts[2][1],sy); + inc(pts[3][1],sy); + end; + t2 := GetCPUTime(mu2); + pts[0][1] := 0; + pts[1][1] := hh; + pts[2][1] := 2*hh; + pts[3][1] := hh; + color := 0; + for ii := 0 to 31 do begin + pts[0][0] := ww; + pts[1][0] := 2*ww; + pts[2][0] := ww; + pts[3][0] := 0; + for jj := 0 to 31 do begin + GrFilledConvexPolygon(4,pts, pEGA^[color] or GrXOR); + color := (color + 1) and 15; + inc(pts[0][0],sx); + inc(pts[1][0],sx); + inc(pts[2][0],sx); + inc(pts[3][0],sx); + end; + inc(pts[0][1],sy); + inc(pts[1][1],sy); + inc(pts[2][1],sy); + inc(pts[3][1],sy); + end; + t3 := GetCPUTime(mu3); + writestr(exit_message, + "Times to scan 1024 polygons\n", + ' with GrFilledPolygon: ',(t2+mu2/1e6)-(t1+mu1/1e6):0:2," (s)\n", + ' with GrFilledConvexPolygon: ',(t3+mu3/1e6)-(t2+mu2/1e6):0:2," (s)\n"); +end; + +begin + InitTest; + pEGA:=EGAPtr(GrAllocEgaColors); + black:=pEGA^[0]; red:=pEGA^[12]; white:=pEGA^[15]; + + assign(f,'../test/polytest.dat'); reset(f); + collect:=false; + while not eof(f) do begin + readln(f,line); + if not collect then begin + if Copy(line,1,5)='begin' then begin + collect:=true; + convex := line[6]='c'; + nb:=0; + end + end else begin + if Copy(line,1,3)='end' then begin + if nb>0 then TestPoly(nb,polygon,convex); + collect:=false; + end else begin + with polygon[nb] do readstr(line,X,Y); + inc(nb); + end; + end; + end; + close(f); + SpeedTest; + EndTest; +end. \ No newline at end of file diff -u -Nr grx243.franck/pascal/readme grx243/pascal/readme --- grx243.franck/pascal/readme Thu May 17 03:22:22 2001 +++ grx243/pascal/readme Sat Oct 6 16:37:30 2001 @@ -21,6 +21,7 @@ Press "4" to draw whatever you like :-) Press "0" to leave drawing-mode "Q" leaves vir_test. +* polytest.pas draws some polygons To build up the programs, either diff -u -Nr grx243.franck/pascal/test.pas grx243/pascal/test.pas --- grx243.franck/pascal/test.pas Thu Jan 1 00:00:00 1970 +++ grx243/pascal/test.pas Sat Oct 6 19:24:24 2001 @@ -0,0 +1,50 @@ +unit test; + +INTERFACE + +uses grx; + +var exit_message: string [1000]; + +procedure InitTest; +procedure EndTest; + +IMPLEMENTATION + +procedure InitTest; + var M,n,i: integer; + w,h,c: integer = 0; +begin + if ParamCount < 2 then + M := GrSetMode(GR_default_graphics,0,0,0,0,0) + else begin + for n:=1 to Paramcount do begin + readstr(Paramstr(n),i); + case Paramstr(n)[length(ParamStr(n))] of + 'k','K': i := i shl 10; + 'm','M': i := i shl 20; + end; + case n of + 1: w:=i; + 2: h:=i; + 3: c:=i; + end; + end; + if ParamCount = 2 then + M:=GrSetMode(GR_width_height_graphics,w,h,0,0,0) + else + M := GrSetMode(GR_width_height_color_graphics,w,h,c,0,0); + end; +end; + +procedure EndTest; + var M:integer; k:GrKeyType; +begin + M:=GrSetMode(GR_default_text,0,0,0,0,0); + if exit_message <> '' then begin + writeln(exit_message); + k:=GrKeyRead; + end; +end; + +end.