paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 08:09:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* several bugfixes for sector/ellipse/floodfill

Browse Source 
+ graphic driver mode const in interface G800x600x256...
  + added backput mode as in linux graph.pp
    (clears the background of textoutput)
This commit is contained in:
pierre 1998-11-19 15:09:33 +00:00
parent 4e8b8ef9f4
commit aaeb9b6a03
6 changed files with 127 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
rtl/dos/graph.pp
View File

@ -873,12 +873,12 @@ begin
_graphresult:=grNoInitGraph;;
exit;
end;
if (writemode and $7F<>xorput) and (writemode and $7F<>normalput) then
if ((writemode and 7)<>xorput) and ((writemode and 7)<>normalput) then
begin
_graphresult:=grError;
exit;
end;
aktwritemode:=(writemode and $F);
aktwritemode:=(writemode and 7);
if (writemode and BackPut)<>0 then
ClearText:=true
else
@ -932,7 +932,13 @@ end.
{
$Log$
Revision 1.8 1998-11-19 09:48:45 pierre
Revision 1.9 1998-11-19 15:09:33 pierre
* several bugfixes for sector/ellipse/floodfill
+ graphic driver mode const in interface G800x600x256...
+ added backput mode as in linux graph.pp
(clears the background of textoutput)
Revision 1.8 1998/11/19 09:48:45 pierre
+ added some functions missing like sector ellipse getarccoords
(the filling of sector and ellipse is still buggy
I use floodfill but sometimes the starting point

30
rtl/dos/ppi/arc.ppi
View File

@ -27,6 +27,7 @@
xp,yp : integer;
xradius,yradius : word;
first,ready : Boolean;
ofscount : byte;
procedure DrawArc(index1,index2,index3:byte);
var ende,incr:integer;
@ -55,6 +56,7 @@
if (((xp=xe[0]) or (xp=xe[1]) or (xp=xe[2])) and
((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) then
begin
putpixeli(xp,yp,aktcolor);
ready:=true;
exit;
end;
@ -67,7 +69,8 @@
begin
first:=true; ready:=false;
XRadius:=Radius; YRadius:=Radius;
XRadius:=(Radius*10000) div XAsp;
YRadius:=(Radius*10000) div YAsp;
alpha:=alpha mod 360; beta:=beta mod 360;
case alpha of
@ -76,7 +79,6 @@
180..269 : ofs:=2;
270..359 : ofs:=3;
end;
x:=x+aktviewport.x1; y:=y+aktviewport.y1;
xa[1]:=x+round(sin((alpha+90)*Pi/180) * XRadius);
ya[1]:=y+round(cos((alpha+90)*Pi/180) * YRadius);
xe[1]:=x+round(sin((beta+90)*Pi/180) * XRadius);
@ -90,29 +92,43 @@
xa[0]:=xa[1]-1; xa[2]:=xa[1]+1; ya[0]:=ya[1]-1; ya[2]:=ya[1]+1;
xe[0]:=xe[1]-1; xe[2]:=xe[1]+1; ye[0]:=ye[1]-1; ye[2]:=ye[1]+1;
index:=Calcellipse(x,y,Radius,Radius);
ofscount:=0;
repeat
DrawArc(i[ofs*3],i[ofs*3+1],i[ofs*3+2]);
ofs:=(ofs+1) mod 7;
until ready;
inc(ofscount);
until ready or (ofscount>7);
end;
procedure PieSlice(X,Y,alpha,beta:integer;Radius: Word);
var angle : real;
XRadius, YRadius : word;
begin
Arc(x,y,alpha,beta,Radius);
MoveTo(ActArcCoords.xstart,ActArcCoords.ystart);
LineTo(x,y);
LineTo(ActArcCoords.xend,ActArcCoords.yend);
alpha:=alpha mod 360; beta:=beta mod 360;
angle:=(alpha+beta)/2;
if alpha<=beta then
angle:=(alpha+beta)/2
else
angle:=(alpha-360+beta)/2;
{ fill from the point in the middle of the slice }
FloodFill(x+round(sin((angle+90)*Pi/180)*Radius/2),
y+round(cos((angle+90)*Pi/180)*Radius/2),truecolor);
XRadius:=(Radius*10000) div XAsp;
YRadius:=(Radius*10000) div YAsp;
FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
y+round(cos((angle+90)*Pi/180)*YRadius/2),truecolor);
end;
{
$Log$
Revision 1.3 1998-11-19 09:48:46 pierre
Revision 1.4 1998-11-19 15:09:35 pierre
* several bugfixes for sector/ellipse/floodfill
+ graphic driver mode const in interface G800x600x256...
+ added backput mode as in linux graph.pp
(clears the background of textoutput)
Revision 1.3 1998/11/19 09:48:46 pierre
+ added some functions missing like sector ellipse getarccoords
(the filling of sector and ellipse is still buggy
I use floodfill but sometimes the starting point

37
rtl/dos/ppi/ellipse.ppi
View File

@ -18,8 +18,9 @@
var aq,bq,xq,yq,abq : Longint;
xp,yp,count : integer;
begin
XRadius:=(XRadius*10000) div XAsp;
YRadius:=(YRadius*10000) div YAsp;
{XRadius:=(XRadius*10000) div XAsp;
YRadius:=(YRadius*10000) div YAsp; }
{ must be changed before !! }
aq :=XRadius * XRadius;
bq :=YRadius * YRadius;
abq:=aq * bq;
@ -75,6 +76,8 @@
exit;
end;
XRadius:=(XRadius*10000) div XAsp;
YRadius:=(YRadius*10000) div YAsp;
Count:=CalcEllipse(x,y,XRadius,YRadius);
if Count=0 then exit;
Count8:=Count-8;
@ -113,6 +116,7 @@
xp,yp : integer;
xradius,yradius : word;
first,ready : Boolean;
ofscount : byte;
procedure DrawArc(index1,index2,index3:byte);
var ende,incr:integer;
@ -141,6 +145,7 @@
if (((xp=xe[0]) or (xp=xe[1]) or (xp=xe[2])) and
((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) then
begin
putpixeli(xp,yp,aktcolor);
ready:=true;
exit;
end;
@ -154,6 +159,8 @@
begin
first:=true; ready:=false;
XRadius:=XRad; YRadius:=YRad;
XRadius:=(XRadius*10000) div XAsp;
YRadius:=(YRadius*10000) div YAsp;
alpha:=alpha mod 360; beta:=beta mod 360;
case alpha of
@ -162,7 +169,6 @@
180..269 : ofs:=2;
270..359 : ofs:=3;
end;
x:=x+aktviewport.x1; y:=y+aktviewport.y1;
xa[1]:=x+round(sin((alpha+90)*Pi/180) * XRadius);
ya[1]:=y+round(cos((alpha+90)*Pi/180) * YRadius);
xe[1]:=x+round(sin((beta+90)*Pi/180) * XRadius);
@ -176,10 +182,12 @@
xa[0]:=xa[1]-1; xa[2]:=xa[1]+1; ya[0]:=ya[1]-1; ya[2]:=ya[1]+1;
xe[0]:=xe[1]-1; xe[2]:=xe[1]+1; ye[0]:=ye[1]-1; ye[2]:=ye[1]+1;
index:=Calcellipse(x,y,XRadius,YRadius);
ofscount:=0;
repeat
DrawArc(i[ofs*3],i[ofs*3+1],i[ofs*3+2]);
ofs:=(ofs+1) mod 7;
until ready;
inc(ofscount);
until ready or (ofscount>7);
end;
procedure Sector(X,Y,alpha,beta:integer;XRadius,YRadius: Word);
@ -190,7 +198,10 @@
LineTo(x,y);
LineTo(ActArcCoords.xend,ActArcCoords.yend);
alpha:=alpha mod 360; beta:=beta mod 360;
angle:=(alpha+beta)/2;
if alpha<=beta then
angle:=(alpha+beta)/2
else
angle:=(alpha-360+beta)/2;
{$ifdef ExtDebug}
Writeln(stderr,'Center ',x,' ',y);
Writeln(stderr,'Start ',ActArcCoords.xstart,' ',ActArcCoords.ystart);
@ -199,11 +210,15 @@
y+round(cos((angle+90)*Pi/180)*YRadius/2));
{$endif ExtDebug}
{ fill from the point in the middle of the slice }
XRadius:=(XRadius*10000) div XAsp;
YRadius:=(YRadius*10000) div YAsp;
FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
y+round(cos((angle+90)*Pi/180)*YRadius/2),truecolor);
end;
procedure Circle(x,y:integer;radius:word);
var
xradius,yradius : word;
begin
_graphresult:=grOk;
if not isgraphmode then
@ -211,12 +226,20 @@
_graphresult:=grnoinitgraph;
exit;
end;
_Ellipse(CalcEllipse(x,y,radius,radius));
XRadius:=(Radius*10000) div XAsp;
YRadius:=(Radius*10000) div YAsp;
_Ellipse(CalcEllipse(x,y,xradius,yradius));
end;
{
$Log$
Revision 1.3 1998-11-19 09:48:47 pierre
Revision 1.4 1998-11-19 15:09:36 pierre
* several bugfixes for sector/ellipse/floodfill
+ graphic driver mode const in interface G800x600x256...
+ added backput mode as in linux graph.pp
(clears the background of textoutput)
Revision 1.3 1998/11/19 09:48:47 pierre
+ added some functions missing like sector ellipse getarccoords
(the filling of sector and ellipse is still buggy
I use floodfill but sometimes the starting point

32
rtl/dos/ppi/fill.ppi
View File

@ -33,14 +33,13 @@ var start,ende,xx : integer;
col : longint;
begin
{$ifdef ExtDebug}
Writeln(stderr,'Fill ',x,' ',y);
{$endif def ExtDebug}
xx:=x; col:=getpixel(xx,y);
{$ifdef ExtDebug}
Writeln(stderr,'Fill ',x,' ',y,' ',col);
{$endif def ExtDebug}
if (col=bordercol) or (col=fillcol) or (test_bkfill and (col=fillbkcol)) then exit;
if (col=bordercol) or (col=fillcol) or
(test_bkfill and (col=fillbkcol)) then
exit;
while (col<>bordercol) and (xx > viewport.x1) and
(col<>fillcol) and (not test_bkfill or (col<>fillbkcol))
do begin
@ -52,7 +51,8 @@ begin
else
start:=xx+1;
xx:=x+1; col:=getpixel(xx,y);
xx:=x;
col:=getpixel(xx,y);
while (col<>bordercol) and (xx < viewport.x2) and (col<>fillcol)
and (not test_bkfill or (col<>fillbkcol))
do begin
@ -88,7 +88,7 @@ begin
until xx > ende;
end;
if (y >= viewport.y1) and (y<viewport.y2) then
if (y<viewport.y2) then
begin
xx:=start;
repeat
@ -103,12 +103,17 @@ begin
end;
begin
fillchar(buffermem^,buffersize,0);
{fillchar(buffermem^,buffersize,0);
not used !! }
if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
viewport.x2:=viewport.x2-viewport.x1;
viewport.y2:=viewport.y2-viewport.y1;
viewport.x1:=0;
viewport.y1:=0;
{ reject invalid points !! }
if (x>viewport.x2) or (x<viewport.x1) or
(y>viewport.y2) or (y<viewport.y1) then
exit;
bordercol:=convert(border);
if BytesPerPixel=1
then begin
@ -117,7 +122,7 @@ begin
fillbkCol:=aktfillbkcolor and $FF;
end
{$ifdef TEST_24BPP}
else if BytesPerPixel=3
else if BytesPerPixel>=3
then begin
bordercol:=bordercol and $FFFFFF;
fillcol:=aktfillsettings.color and $FFFFFF;
@ -141,7 +146,8 @@ begin
else
test_bkfill:=true;
{$ifdef ExtDebug}
Writeln(stderr,'Fillcol ',fillcol,' bordercol',bordercol);
Writeln(stderr,'FloodFill(',x,',',y,') Fillcol ',fillcol);
Writeln(stderr,' bordercol ',bordercol,' fillbkcol ',fillbkcol);
{$endif def ExtDebug}
fill(x,y);
end;
@ -258,7 +264,13 @@ end;
{
$Log$
Revision 1.4 1998-11-19 09:48:48 pierre
Revision 1.5 1998-11-19 15:09:37 pierre
* several bugfixes for sector/ellipse/floodfill
+ graphic driver mode const in interface G800x600x256...
+ added backput mode as in linux graph.pp
(clears the background of textoutput)
Revision 1.4 1998/11/19 09:48:48 pierre
+ added some functions missing like sector ellipse getarccoords
(the filling of sector and ellipse is still buggy
I use floodfill but sometimes the starting point

37
rtl/dos/ppi/global.ppi
View File

@ -187,9 +187,44 @@
(0,0,0,0,0,0,0,0) { benutzerdefiniert }
);
G640x400x256 = $100;
G640x480x256 = $101;
G800x600x256 = $103;
G1024x768x256 = $105;
G1280x1024x256 = $107; { Additional modes. }
G640x480x32K = $110;
G640x480x64K = $111;
G640x480x16M = $112;
G800x600x32K = $113;
G800x600x64K = $114;
G800x600x16M = $115;
G1024x768x32K = $116;
G1024x768x64K = $117;
G1024x768x16M = $118;
G1280x1024x32K = $119;
G1280x1024x64K = $11A;
G1280x1024x16M = $11B;
(* G320x200x16M32 = 33; { 32-bit per pixel modes. }
G640x480x16M32 = 34;
G800x600x16M32 = 35;
G1024x768x16M32 = 36;
G1280x1024x16M32 = 37; *)
{
$Log$
Revision 1.4 1998-11-19 09:48:50 pierre
Revision 1.5 1998-11-19 15:09:38 pierre
* several bugfixes for sector/ellipse/floodfill
+ graphic driver mode const in interface G800x600x256...
+ added backput mode as in linux graph.pp
(clears the background of textoutput)
Revision 1.4 1998/11/19 09:48:50 pierre
+ added some functions missing like sector ellipse getarccoords
(the filling of sector and ellipse is still buggy
I use floodfill but sometimes the starting point

37
rtl/dos/ppi/modes.ppi
View File

@ -40,39 +40,16 @@ const
{$endif TEST_24BPP}
);
G640x400x256 = $100;
G640x480x256 = $101;
G800x600x256 = $103;
G1024x768x256 = $105;
G1280x1024x256 = $107; { Additional modes. }
G640x480x32K = $110;
G640x480x64K = $111;
G640x480x16M = $112;
G800x600x32K = $113;
G800x600x64K = $114;
G800x600x16M = $115;
G1024x768x32K = $116;
G1024x768x64K = $117;
G1024x768x16M = $118;
G1280x1024x32K = $119;
G1280x1024x64K = $11A;
G1280x1024x16M = $11B;
(* G320x200x16M32 = 33; { 32-bit per pixel modes. }
G640x480x16M32 = 34;
G800x600x16M32 = 35;
G1024x768x16M32 = 36;
G1280x1024x16M32 = 37; *)
{
$Log$
Revision 1.3 1998-11-18 09:34:36 pierre
Revision 1.4 1998-11-19 15:09:39 pierre
* several bugfixes for sector/ellipse/floodfill
+ graphic driver mode const in interface G800x600x256...
+ added backput mode as in linux graph.pp
(clears the background of textoutput)
Revision 1.3 1998/11/18 09:34:36 pierre
* wrong VesaNumber with 24 bit modes
Revision 1.2 1998/11/18 09:31:38 pierre