mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 19:29:26 +02:00
* move graph.inc to the target dir
This commit is contained in:
peter
parent
df694c76e8
commit
6dac8462c5
@ -45,7 +45,10 @@ asm
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1999-07-12 13:27:10 jonas
|
||||
Revision 1.1 1999-11-08 11:15:21 peter
|
||||
* move graph.inc to the target dir
|
||||
|
||||
Revision 1.2 1999/07/12 13:27:10 jonas
|
||||
+ added Log and Id tags
|
||||
* added first FPC support, only VGA works to some extend for now
|
||||
* use -dasmgraph to use assembler routines, otherwise Pascal
|
||||
@ -2,6 +2,10 @@
|
||||
$Id$
|
||||
}
|
||||
|
||||
{$ifdef DPMI}
|
||||
{$i vesah.inc}
|
||||
{$endif DPMI}
|
||||
|
||||
{$ifndef fpc}
|
||||
{$ifndef noasmgraph}
|
||||
{$define asmgraph}
|
||||
@ -2460,7 +2464,10 @@ const CrtAddress: word = 0;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.26 1999-11-05 12:18:23 jonas
|
||||
Revision 1.1 1999-11-08 11:15:21 peter
|
||||
* move graph.inc to the target dir
|
||||
|
||||
Revision 1.26 1999/11/05 12:18:23 jonas
|
||||
* fixed pascal version of (direct)putpixelx
|
||||
|
||||
Revision 1.25 1999/11/03 20:23:01 florian
|
||||
1077
rtl/go32v2/graph.pp
1077
rtl/go32v2/graph.pp
File diff suppressed because it is too large
Load Diff
@ -1,218 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
procedure GetArcCoords(var ArcCoords:ArcCoordsType);
|
||||
begin
|
||||
ArcCoords:=ActArcCoords;
|
||||
end;
|
||||
|
||||
procedure Arc(x,y,alpha,beta:Integer;Radius:word);
|
||||
|
||||
const i:Array[0..20]of Byte=
|
||||
(0,3,0, 2,3,1, 2,1,0, 0,1,1, 0,3,0, 2,3,1, 2,1,0);
|
||||
|
||||
var counter,index : integer;
|
||||
endofs,ofs : integer;
|
||||
xa,ya,xe,ye : Array[0..2]of Integer;
|
||||
xp,yp : integer;
|
||||
xradius,yradius : word;
|
||||
first,ready : Boolean;
|
||||
ofscount : byte;
|
||||
|
||||
procedure DrawArc(index1,index2,index3:byte);
|
||||
var ende,incr:integer;
|
||||
begin
|
||||
if index3=0 then begin
|
||||
counter:=index;
|
||||
ende:=0;
|
||||
incr:=-4;
|
||||
end else begin
|
||||
counter:=-4;
|
||||
ende:=index-4;
|
||||
incr:=4;
|
||||
end;
|
||||
if first then begin
|
||||
repeat
|
||||
first:=false;
|
||||
counter:=counter+incr;
|
||||
xp:=PInteger(BufferMem)[counter+index1];
|
||||
yp:=PInteger(BufferMem)[counter+index2];
|
||||
until (counter=ende) or
|
||||
(((xp=xa[0]) or (xp=xa[1]) or (xp=xa[2])) and
|
||||
((yp=ya[0]) or (yp=ya[1]) or (yp=ya[2])));
|
||||
if Counter=Ende then exit else putpixeli(xp,yp,aktcolor);
|
||||
end;
|
||||
repeat
|
||||
if (((xp=xe[0]) or (xp=xe[1]) or (xp=xe[2])) and
|
||||
((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) and
|
||||
((ofs mod 4)=endofs) then
|
||||
begin
|
||||
putpixeli(xp,yp,aktcolor);
|
||||
ready:=true;
|
||||
exit;
|
||||
end;
|
||||
counter:=counter+incr;
|
||||
xp:=PInteger(BufferMem)[counter+index1];
|
||||
yp:=PInteger(BufferMem)[counter+index2];
|
||||
putpixeli(xp,yp,aktcolor);
|
||||
until counter=Ende;
|
||||
end;
|
||||
|
||||
begin
|
||||
first:=true; ready:=false;
|
||||
XRadius:=(Radius*10000) div XAsp;
|
||||
YRadius:=(Radius*10000) div YAsp;
|
||||
|
||||
alpha:=alpha mod 360; beta:=beta mod 360;
|
||||
case alpha of
|
||||
0.. 89 : ofs:=0;
|
||||
90..179 : ofs:=1;
|
||||
180..269 : ofs:=2;
|
||||
270..359 : ofs:=3;
|
||||
end;
|
||||
case beta of
|
||||
0.. 89 : endofs:=0;
|
||||
90..179 : endofs:=1;
|
||||
180..269 : endofs:=2;
|
||||
270..359 : endofs:=3;
|
||||
end;
|
||||
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);
|
||||
ye[1]:=y+round(cos((beta+90)*Pi/180) * YRadius);
|
||||
ActArcCoords.x:=x;
|
||||
ActArcCoords.y:=y;
|
||||
ActArcCoords.xstart:=xa[1];
|
||||
ActArcCoords.ystart:=ya[1];
|
||||
ActArcCoords.xend:=xe[1];
|
||||
ActArcCoords.yend:=ye[1];
|
||||
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;
|
||||
inc(ofscount);
|
||||
until ready or (ofscount>16);
|
||||
end;
|
||||
|
||||
procedure PieSlice(X,Y,alpha,beta:integer;Radius: Word);
|
||||
var angle : real;
|
||||
XRadius, YRadius : word;
|
||||
stline : LineSettingsType;
|
||||
writemode : word;
|
||||
begin
|
||||
Arc(x,y,alpha,beta,Radius);
|
||||
GetLineSettings(stline);
|
||||
writemode:=aktwritemode;
|
||||
aktwritemode:=normalput;
|
||||
SetLineStyle(SolidLn,0,NormWidth);
|
||||
MoveTo(ActArcCoords.xstart,ActArcCoords.ystart);
|
||||
LineTo(x,y);
|
||||
LineTo(ActArcCoords.xend,ActArcCoords.yend);
|
||||
PutPixeli(ActArcCoords.xstart,ActArcCoords.ystart,aktcolor);
|
||||
PutPixeli(x,y,aktcolor);
|
||||
PutPixeli(ActArcCoords.xend,ActArcCoords.yend,aktcolor);
|
||||
alpha:=alpha mod 360; beta:=beta mod 360;
|
||||
if alpha<=beta then
|
||||
angle:=(alpha+beta)/2
|
||||
else
|
||||
angle:=(alpha-360+beta)/2;
|
||||
{ fill from the point in the middle of the slice }
|
||||
XRadius:=(Radius*10000) div XAsp;
|
||||
YRadius:=(Radius*10000) div YAsp;
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'Arc Center ',x,' ',y);
|
||||
Writeln(stderr,'Radii ',xradius,' ',yradius);
|
||||
Writeln(stderr,'Start ',ActArcCoords.xstart,' ',ActArcCoords.ystart);
|
||||
if not ColorsEqual(truecolor,getpixel(ActArcCoords.xstart,ActArcCoords.ystart)) then
|
||||
Writeln('Start error not set');
|
||||
Writeln(stderr,'End ',ActArcCoords.xend,' ',ActArcCoords.yend);
|
||||
if not ColorsEqual(truecolor,getpixel(ActArcCoords.xend,ActArcCoords.yend)) then
|
||||
Writeln('End error not set');
|
||||
Writeln(stderr,'Fill start ',x+round(sin((angle+90)*Pi/180)*XRadius/2),' ',
|
||||
y+round(cos((angle+90)*Pi/180)*YRadius/2));
|
||||
{$endif GraphDebug}
|
||||
{ avoid rounding errors }
|
||||
if abs(ActArcCoords.xstart-ActArcCoords.xend)
|
||||
+abs(ActArcCoords.ystart-ActArcCoords.yend)>2 then
|
||||
FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
|
||||
y+round(cos((angle+90)*Pi/180)*YRadius/2),truecolor);
|
||||
aktwritemode:=writemode;
|
||||
aktlineinfo:=stline;
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:03 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.6 1998/11/23 10:04:17 pierre
|
||||
* pieslice and sector work now !!
|
||||
* bugs in text writing removed
|
||||
+ scaling for defaultfont added
|
||||
+ VertDir for default font added
|
||||
* RestoreCRTMode corrected
|
||||
|
||||
Revision 1.5 1998/11/20 18:42:05 pierre
|
||||
* many bugs related to floodfill and ellipse fixed
|
||||
|
||||
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
|
||||
is outside !!)
|
||||
* fixed a bug in floodfill for patterns
|
||||
(still has problems !!)
|
||||
|
||||
Revision 1.2 1998/11/18 09:31:30 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:58:53 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/arc.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:27; author: michael; state: Exp; lines: +13 -0
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,216 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
{ COLORS.PPI }
|
||||
|
||||
{ GetBkColor , SetBkColor , GetColor , SetColor , GetMaxColor }
|
||||
|
||||
|
||||
function Convert(Color:longint):longint;
|
||||
var c,r,g,b:longint;
|
||||
begin
|
||||
if BytesPerPixel = 1 then
|
||||
begin
|
||||
if (Color and $FF000000)=0 then
|
||||
begin
|
||||
C:=Color and $FF;
|
||||
Convert:=(C shl 24) + (C shl 16) + (C shl 8) + C;
|
||||
end else
|
||||
begin
|
||||
SetRGBPalette(((Color and $FF000000) shr 24),
|
||||
((Color and $00FF0000) shr 16),
|
||||
((Color and $0000FF00) shr 8),
|
||||
(Color and $000000FF));
|
||||
C:=(Color and $FF000000);
|
||||
Convert:=(C shr 24) + (C shr 16) + (C shr 8) + C;
|
||||
end;
|
||||
end else if BytesPerPixel>2 then
|
||||
Convert:=Color and $FFFFFF
|
||||
else
|
||||
begin
|
||||
R:=(Color and $00FF0000) shr (24-VESAInfo.rm_size);
|
||||
G:=(Color and $0000FF00) shr (16-VESAInfo.gm_size);
|
||||
B:=(Color and $000000FF) shr (8-VESAInfo.bm_size);
|
||||
C:=(R shl VESAInfo.rf_pos) or (G shl VESAInfo.gf_pos) or
|
||||
(B shl VESAInfo.bf_pos);
|
||||
if BytesPerPixel = 2 then
|
||||
Convert:=(C shl 16) or C;
|
||||
end;
|
||||
end;
|
||||
|
||||
function Unconvert(Color:longint):longint;
|
||||
var c,r,g,b:longint;
|
||||
begin
|
||||
if BytesPerPixel=1 then
|
||||
begin
|
||||
UnConvert:=Color and $FF;
|
||||
end
|
||||
else if BytesPerPixel>2 then
|
||||
Unconvert:=Color and $FFFFFF
|
||||
else
|
||||
begin
|
||||
C:=Color shr VesaInfo.bf_pos;
|
||||
b:= C and ( (1 shl (VesaInfo.bm_size))-1);
|
||||
b:= b shl (8-VesaInfo.bm_size);
|
||||
C:=Color shr VesaInfo.gf_pos;
|
||||
g:= C and ( (1 shl (VesaInfo.gm_size))-1);
|
||||
g:= g shl (8-VesaInfo.gm_size);
|
||||
C:=Color shr VesaInfo.rf_pos;
|
||||
r:= C and ( (1 shl (VesaInfo.rm_size))-1);
|
||||
r:= r shl (8-VesaInfo.rm_size);
|
||||
Unconvert:= r*$10000+g*$100+b;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetColor : longint;
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grNoInitGraph;
|
||||
exit;
|
||||
end;
|
||||
getcolor:=truecolor;
|
||||
end;
|
||||
|
||||
{ ----------------------------------------------------------------------- }
|
||||
|
||||
procedure SetColor(color : Longint);
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grNoInitGraph;
|
||||
exit;
|
||||
end;
|
||||
truecolor:=color;
|
||||
aktcolor:=convert(Color);
|
||||
end;
|
||||
|
||||
{ ----------------------------------------------------------------------- }
|
||||
|
||||
function GetBkColor : longint;
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grNoInitGraph;
|
||||
exit;
|
||||
end;
|
||||
getbkcolor:=truebackcolor;
|
||||
end;
|
||||
|
||||
procedure SetBkColor(Color : longint);
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grNoInitGraph;
|
||||
exit;
|
||||
end;
|
||||
truebackcolor:=color;
|
||||
aktbackcolor:=convert(Color);
|
||||
end;
|
||||
|
||||
function GetMaxColor : longint;
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grNoInitGraph;;
|
||||
exit;
|
||||
end;
|
||||
getmaxcolor:=(1 shl VESAInfo.BitsPerPixel)-1;
|
||||
end;
|
||||
|
||||
procedure setstdcolors;
|
||||
|
||||
begin
|
||||
if bytesperpixel>1 then
|
||||
begin
|
||||
black := stdcolors[0];
|
||||
blue := stdcolors[1];
|
||||
green := stdcolors[2];
|
||||
cyan := stdcolors[3];
|
||||
red := stdcolors[4];
|
||||
magenta := stdcolors[5];
|
||||
brown := stdcolors[6];
|
||||
lightgray := stdcolors[7];
|
||||
darkgray := stdcolors[8];
|
||||
lightblue := stdcolors[9];
|
||||
lightgreen := stdcolors[10];
|
||||
lightcyan := stdcolors[11];
|
||||
lightred := stdcolors[12];
|
||||
lightmagenta := stdcolors[13];
|
||||
yellow := stdcolors[14];
|
||||
white := stdcolors[15];
|
||||
end
|
||||
else
|
||||
begin
|
||||
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;
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:03 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.2 1998/11/18 09:31:31 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:57:43 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/colors.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:28; author: michael; state: Exp; lines: +13 -0
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,56 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
procedure Get_RAW_Switch_Address;
|
||||
begin
|
||||
asm
|
||||
movw $0x306,%ax
|
||||
int $0x31
|
||||
shll $0x10,%ebx
|
||||
movw %cx,%bx
|
||||
movl %ebx,_SWITCHRAW2DPMI
|
||||
movl %edi,_SWITCHDPMI2RAW
|
||||
movw %si,_SWITCHSEG
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:03 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:57:47 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/dpmi2raw.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:28; author: michael; state: Exp; lines: +14 -0
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,342 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
var
|
||||
ActArcCoords : ArcCoordsType;
|
||||
|
||||
function CalcEllipse(x,y:Integer;XRadius,YRadius:word):Integer;
|
||||
var aq,bq,xq,yq,abq : Longint;
|
||||
xp,yp,count : integer;
|
||||
i : integer;
|
||||
begin
|
||||
{XRadius:=(XRadius*10000) div XAsp;
|
||||
YRadius:=(YRadius*10000) div YAsp; }
|
||||
{ must be changed before !! }
|
||||
aq :=XRadius * XRadius;
|
||||
bq :=YRadius * YRadius;
|
||||
abq:=aq * bq;
|
||||
yp:=YRadius;
|
||||
xp:=0;
|
||||
count:=0;
|
||||
|
||||
{ Berechnung nach : X^2 / A^2 + Y^2 / B^2 = 1 }
|
||||
{ umgestellt : X^2 * Y^2 * A^2 * B^2 = A^2*B^2 }
|
||||
{ dadurch werden evtuelle Divisionen durch 0 vermieden }
|
||||
{ und Integerarithmetik moeglich }
|
||||
{ was buggy for B=0 !! }
|
||||
if YRadius=0 then
|
||||
begin
|
||||
for i:=0 to XRadius do
|
||||
begin
|
||||
PWord(buffermem)[count ]:=x + i;
|
||||
PWord(buffermem)[count+1]:=y;
|
||||
PWord(buffermem)[count+2]:=x - i;
|
||||
PWord(buffermem)[count+3]:=y;
|
||||
Count:=Count+4;
|
||||
end;
|
||||
for i:=Xradius-1 downto 1 do
|
||||
begin
|
||||
PWord(buffermem)[count ]:=x + i;
|
||||
PWord(buffermem)[count+1]:=y;
|
||||
PWord(buffermem)[count+2]:=x - i;
|
||||
PWord(buffermem)[count+3]:=y;
|
||||
Count:=Count+4;
|
||||
end;
|
||||
end
|
||||
else repeat
|
||||
PWord(buffermem)[count ]:=x + xp;
|
||||
PWord(buffermem)[count+1]:=y + yp;
|
||||
PWord(buffermem)[count+2]:=x - xp;
|
||||
PWord(buffermem)[count+3]:=y - yp;
|
||||
xq:=xp * xp; yq:=yp * yp;
|
||||
if xq * bq + yq * aq >= abq then yp:=yp-1 else xp:=xp+1;
|
||||
Count:=Count+4;
|
||||
until yp < 0;
|
||||
CalcEllipse:=Count;
|
||||
end;
|
||||
|
||||
Procedure _Ellipse(Count:Integer);
|
||||
const aq:Integer=0;
|
||||
begin
|
||||
|
||||
{ Das Zeichnen der Ellipse erfolgt in zwei Schleifen, um systematisch }
|
||||
{ von oben nach unten zu zeichnen und somit ein staendiges Bank- }
|
||||
{ umschalten zu verhindern }
|
||||
|
||||
while aq <> count do begin
|
||||
PutPixeli( PWord(buffermem)[aq] ,PWord(buffermem)[aq+3],aktcolor);
|
||||
PutPixeli( PWord(buffermem)[aq+2],PWord(buffermem)[aq+3],aktcolor);
|
||||
aq:=aq+4;
|
||||
end;
|
||||
while aq <> 0 do begin
|
||||
aq:=aq-4;
|
||||
PutPixeli( PWord(buffermem)[aq] ,PWord(buffermem)[aq+1],aktcolor);
|
||||
PutPixeli( PWord(buffermem)[aq+2],PWord(buffermem)[aq+1],aktcolor);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure Fillellipse(x,y:Integer;XRadius,YRadius:word);
|
||||
var Count,index:Word;
|
||||
Count8:Word;
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
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;
|
||||
index:=0;
|
||||
|
||||
while index < count do begin
|
||||
while (PWord(buffermem)[index+1]=PWord(buffermem)[index+5]) and
|
||||
(index < count8) do Index:=Index+4;
|
||||
PatternLine(PWord(buffermem)[index],PWord(buffermem)[index+2],
|
||||
PWord(buffermem)[index+3]);
|
||||
Index:=Index+4;
|
||||
end;
|
||||
|
||||
while index > 0 do begin
|
||||
index:=index-4;
|
||||
PatternLine(PWord(buffermem)[index],PWord(buffermem)[index+2],
|
||||
PWord(buffermem)[index+1]);
|
||||
while (PWord(buffermem)[index+1]=PWord(buffermem)[index-3]) and
|
||||
(index > 4 ) do Index:=Index-4;
|
||||
end;
|
||||
|
||||
if (aktColor <> aktFillSettings.Color) or (aktFillSettings.Pattern<>1)
|
||||
then _Ellipse(Count);
|
||||
end;
|
||||
|
||||
|
||||
{ allmost same code than Arc, should be squeezed together !! }
|
||||
|
||||
procedure Ellipse(x,y,alpha,beta:Integer;XRad,YRad:word);
|
||||
|
||||
const i:Array[0..20]of Byte=
|
||||
(0,3,0, 2,3,1, 2,1,0, 0,1,1, 0,3,0, 2,3,1, 2,1,0);
|
||||
|
||||
var counter,index : integer;
|
||||
ofs,endofs : integer;
|
||||
xa,ya,xe,ye : Array[0..2] of Integer;
|
||||
xp,yp : integer;
|
||||
xradius,yradius : word;
|
||||
first,ready : Boolean;
|
||||
ofscount : byte;
|
||||
|
||||
procedure DrawArc(index1,index2,index3:byte);
|
||||
var ende,incr:integer;
|
||||
begin
|
||||
if index3=0 then begin
|
||||
counter:=index;
|
||||
ende:=0;
|
||||
incr:=-4;
|
||||
end else begin
|
||||
counter:=-4;
|
||||
ende:=index-4;
|
||||
incr:=4;
|
||||
end;
|
||||
if first then begin
|
||||
repeat
|
||||
first:=false;
|
||||
counter:=counter+incr;
|
||||
xp:=PInteger(BufferMem)[counter+index1];
|
||||
yp:=PInteger(BufferMem)[counter+index2];
|
||||
until (counter=ende) or
|
||||
(((xp=xa[0]) or (xp=xa[1]) or (xp=xa[2])) and
|
||||
((yp=ya[0]) or (yp=ya[1]) or (yp=ya[2])));
|
||||
if Counter=Ende then exit else putpixeli(xp,yp,aktcolor);
|
||||
end;
|
||||
repeat
|
||||
if (((xp=xe[0]) or (xp=xe[1]) or (xp=xe[2])) and
|
||||
((yp=ye[0]) or (yp=ye[1]) or (yp=ye[2]))) and
|
||||
((ofs mod 4)=endofs) then
|
||||
begin
|
||||
putpixeli(xp,yp,aktcolor);
|
||||
ready:=true;
|
||||
exit;
|
||||
end;
|
||||
counter:=counter+incr;
|
||||
xp:=PInteger(BufferMem)[counter+index1];
|
||||
yp:=PInteger(BufferMem)[counter+index2];
|
||||
putpixeli(xp,yp,aktcolor);
|
||||
until counter=Ende;
|
||||
end;
|
||||
|
||||
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
|
||||
0.. 89 : ofs:=0;
|
||||
90..179 : ofs:=1;
|
||||
180..269 : ofs:=2;
|
||||
270..359 : ofs:=3;
|
||||
end;
|
||||
case beta of
|
||||
0.. 89 : endofs:=0;
|
||||
90..179 : endofs:=1;
|
||||
180..269 : endofs:=2;
|
||||
270..359 : endofs:=3;
|
||||
end;
|
||||
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);
|
||||
ye[1]:=y+round(cos((beta+90)*Pi/180) * YRadius);
|
||||
ActArcCoords.x:=x;
|
||||
ActArcCoords.y:=y;
|
||||
ActArcCoords.xstart:=xa[1];
|
||||
ActArcCoords.ystart:=ya[1];
|
||||
ActArcCoords.xend:=xe[1];
|
||||
ActArcCoords.yend:=ye[1];
|
||||
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;
|
||||
inc(ofscount);
|
||||
until ready or (ofscount>16);
|
||||
end;
|
||||
|
||||
procedure Sector(X,Y,alpha,beta:integer;XRadius,YRadius: Word);
|
||||
var angle : real;
|
||||
stline : LineSettingsType;
|
||||
writemode : word;
|
||||
begin
|
||||
Ellipse(x,y,alpha,beta,XRadius,YRadius);
|
||||
GetLineSettings(stline);
|
||||
SetLineStyle(SolidLn,0,NormWidth);
|
||||
writemode:=aktwritemode;
|
||||
aktwritemode:=normalput;
|
||||
MoveTo(ActArcCoords.xstart,ActArcCoords.ystart);
|
||||
LineTo(x,y);
|
||||
LineTo(ActArcCoords.xend,ActArcCoords.yend);
|
||||
PutPixeli(ActArcCoords.xstart,ActArcCoords.ystart,aktcolor);
|
||||
PutPixeli(x,y,aktcolor);
|
||||
PutPixeli(ActArcCoords.xend,ActArcCoords.yend,aktcolor);
|
||||
alpha:=alpha mod 360; beta:=beta mod 360;
|
||||
if alpha<=beta then
|
||||
angle:=(alpha+beta)/2
|
||||
else
|
||||
angle:=(alpha-360+beta)/2;
|
||||
{ fill from the point in the middle of the slice }
|
||||
XRadius:=(XRadius*10000) div XAsp;
|
||||
YRadius:=(YRadius*10000) div YAsp;
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'Sector Center ',x,' ',y);
|
||||
Writeln(stderr,'Radii ',xradius,' ',yradius);
|
||||
Writeln(stderr,'Start ',ActArcCoords.xstart,' ',ActArcCoords.ystart);
|
||||
if not ColorsEqual(truecolor,getpixel(ActArcCoords.xstart,ActArcCoords.ystart)) then
|
||||
Writeln('Start error not set');
|
||||
Writeln(stderr,'End ',ActArcCoords.xend,' ',ActArcCoords.yend);
|
||||
if not ColorsEqual(truecolor,getpixel(ActArcCoords.xend,ActArcCoords.yend)) then
|
||||
Writeln('End error not set');
|
||||
Writeln(stderr,'Fill start ',x+round(sin((angle+90)*Pi/180)*XRadius/2),' ',
|
||||
y+round(cos((angle+90)*Pi/180)*YRadius/2));
|
||||
{$endif GraphDebug}
|
||||
{ avoid rounding errors }
|
||||
if abs(ActArcCoords.xstart-ActArcCoords.xend)
|
||||
+abs(ActArcCoords.ystart-ActArcCoords.yend)>2 then
|
||||
FloodFill(x+round(sin((angle+90)*Pi/180)*XRadius/2),
|
||||
y+round(cos((angle+90)*Pi/180)*YRadius/2),truecolor);
|
||||
aktwritemode:=writemode;
|
||||
aktlineinfo:=stline;
|
||||
end;
|
||||
|
||||
procedure Circle(x,y:integer;radius:word);
|
||||
var
|
||||
xradius,yradius : word;
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
XRadius:=(Radius*10000) div XAsp;
|
||||
YRadius:=(Radius*10000) div YAsp;
|
||||
_Ellipse(CalcEllipse(x,y,xradius,yradius));
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:03 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.6 1998/11/23 10:04:18 pierre
|
||||
* pieslice and sector work now !!
|
||||
* bugs in text writing removed
|
||||
+ scaling for defaultfont added
|
||||
+ VertDir for default font added
|
||||
* RestoreCRTMode corrected
|
||||
|
||||
Revision 1.5 1998/11/20 18:42:06 pierre
|
||||
* many bugs related to floodfill and ellipse fixed
|
||||
|
||||
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
|
||||
is outside !!)
|
||||
* fixed a bug in floodfill for patterns
|
||||
(still has problems !!)
|
||||
|
||||
Revision 1.2 1998/11/18 09:31:32 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:57:54 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/ellipse.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:29; author: michael; state: Exp; lines: +13 -1
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,475 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{$ifopt S+}
|
||||
{$define StackCkeckOn}
|
||||
{$endif opt S+}
|
||||
|
||||
procedure floodfill(x,y:integer; border:longint);
|
||||
|
||||
var bordercol : longint;
|
||||
fillcol,fillbkcol : longint;
|
||||
viewport : viewporttype;
|
||||
offset : longint;
|
||||
test_bkfill : boolean;
|
||||
|
||||
{$S+}
|
||||
{ Fill is very recursive !! }
|
||||
{ And it fails sometimes !! }
|
||||
|
||||
procedure fill(x,y:integer);
|
||||
var start,ende,xx : integer;
|
||||
col : longint;
|
||||
|
||||
begin
|
||||
{$ifdef GraphDebug}
|
||||
if (x>viewport.x2) or (x<viewport.x1) or
|
||||
(y>viewport.y2) or (y<viewport.y1) then
|
||||
begin
|
||||
Writeln(stderr,'Wrong value in Fill(',x,',',y,')');
|
||||
exit;
|
||||
end;
|
||||
{$endif def GraphDebug}
|
||||
xx:=x; col:=getpixeli(xx,y);
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'Fill ',x,' ',y,' ',hexstr(col,8));
|
||||
{$endif def GraphDebug}
|
||||
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
|
||||
xx:=xx-1; col:=getpixeli(xx,y);
|
||||
end;
|
||||
if (col<>bordercol) and (col<>fillcol) and
|
||||
(not test_bkfill or (col<>fillbkcol)) then
|
||||
start:=xx
|
||||
else
|
||||
start:=xx+1;
|
||||
|
||||
xx:=x;
|
||||
col:=getpixeli(xx,y);
|
||||
while (col<>bordercol) and (xx < viewport.x2) and (col<>fillcol)
|
||||
and (not test_bkfill or (col<>fillbkcol))
|
||||
do begin
|
||||
xx:=xx+1; col:=getpixeli(xx,y);
|
||||
end;
|
||||
if (col<>bordercol) and (col<>fillcol) and
|
||||
(not test_bkfill or (col<>fillbkcol)) then
|
||||
ende:=xx
|
||||
else
|
||||
ende:=xx-1;
|
||||
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'Pattern ',start,' ',ende,' ',y);
|
||||
{$endif def GraphDebug}
|
||||
patternline(start,ende,y);
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'Fill after Patterline ',x,' ',y,' ',hexstr(getpixel(x,y),8));
|
||||
{$endif def GraphDebug}
|
||||
offset:=(y * _maxy + start) shr 8;
|
||||
|
||||
if (y > viewport.y1)
|
||||
then begin
|
||||
xx:=start;
|
||||
repeat
|
||||
col:=getpixeli(xx,y-1);
|
||||
if (col<>bordercol) and (col<>fillcol) and
|
||||
(not test_bkfill or (col<>fillbkcol))
|
||||
then begin
|
||||
fill(xx,y-1);
|
||||
break;
|
||||
end;
|
||||
xx:=xx+1;
|
||||
until xx > ende;
|
||||
end;
|
||||
|
||||
if (y<viewport.y2) then
|
||||
begin
|
||||
xx:=start;
|
||||
repeat
|
||||
col:=getpixeli(xx,y+1);
|
||||
if (col<>bordercol) and (col<>fillcol) and
|
||||
(not test_bkfill or (col<>fillbkcol)) then
|
||||
fill(xx,y+1);
|
||||
xx:=xx+1;
|
||||
until xx > ende;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'FloodFill start ',x,' ',y);
|
||||
{$endif def GraphDebug}
|
||||
{$ifdef NOFILL}
|
||||
exit;
|
||||
{$endif NOFILL}
|
||||
{fillchar(buffermem^,buffersize,0);
|
||||
not used !! }
|
||||
if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
|
||||
{ reject invalid points !! }
|
||||
|
||||
viewport.x2:=viewport.x2-viewport.x1;
|
||||
viewport.y2:=viewport.y2-viewport.y1;
|
||||
viewport.x1:=0;
|
||||
viewport.y1:=0;
|
||||
|
||||
if (x>viewport.x2) or (x<viewport.x1) or
|
||||
(y>viewport.y2) or (y<viewport.y1) then
|
||||
begin
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'Error Wrong values for FloodFill');
|
||||
Writeln(stderr,'xmax ',viewport.x2);
|
||||
Writeln(stderr,'ymax ',viewport.y2);
|
||||
{$endif def GraphDebug}
|
||||
exit;
|
||||
end;
|
||||
bordercol:=convert(border) and ColorMask;
|
||||
fillcol:=aktfillsettings.color and ColorMask;
|
||||
fillbkCol:=aktfillbkcolor and ColorMask;
|
||||
if aktfillsettings.pattern=emptyfill then
|
||||
begin
|
||||
fillcol:=fillbkcol;
|
||||
test_bkfill:=false;
|
||||
end
|
||||
else if aktfillsettings.pattern=solidfill then
|
||||
test_bkfill:=false
|
||||
else
|
||||
test_bkfill:=true;
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'FloodFill(',x,',',y,') Fillcol ',hexstr(unconvert(fillcol),8));
|
||||
Writeln(stderr,' bordercol ',hexstr(unconvert(bordercol),8),
|
||||
' fillbkcol ',hexstr(unconvert(fillbkcol),8));
|
||||
{$endif def GraphDebug}
|
||||
fill(x,y);
|
||||
end;
|
||||
|
||||
{$ifndef StackCkeckOn}
|
||||
{$S-} { return to normal state }
|
||||
{$else }
|
||||
{$undef StackCheckOn}
|
||||
{$endif }
|
||||
|
||||
procedure GetFillSettings(var Fillinfo:Fillsettingstype);
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
Fillinfo:=aktfillsettings;
|
||||
Fillinfo.color:=unconvert(aktfillsettings.color);
|
||||
end;
|
||||
|
||||
procedure GetFillPattern(var FillPattern:FillPatternType);
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
FillPattern:=aktfillpattern;
|
||||
end;
|
||||
|
||||
procedure SetFillPattern(pattern : FillPatternType;color : longint);
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
fillpattern[12]:=pattern;
|
||||
SetFillStyle(12,color);
|
||||
end;
|
||||
|
||||
procedure SetFillStyle(pattern : word ;color : longint);
|
||||
var i,j:Integer;
|
||||
mask:Byte;
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
{ g<>ltige Paramter ? }
|
||||
if (pattern<0) or (pattern>12) then
|
||||
begin
|
||||
_graphresult:=grError;
|
||||
exit;
|
||||
end;
|
||||
{ Muster laden }
|
||||
aktfillpattern:=fillpattern[pattern];
|
||||
aktfillsettings.pattern:=pattern;
|
||||
aktfillsettings.color:=convert(color);
|
||||
aktfillbkcolor:=aktbackcolor;
|
||||
i:=1; j:=0;
|
||||
repeat
|
||||
mask:=$80;
|
||||
repeat
|
||||
if (aktfillpattern[i] and mask) = 0
|
||||
then PatternBuffer[j]:=aktbackcolor else PatternBuffer[j]:=aktfillsettings.color;
|
||||
mask:=mask shr 1;
|
||||
j:=j+1;
|
||||
until mask=0;
|
||||
i:=i+1;
|
||||
until i > 8;
|
||||
end;
|
||||
|
||||
procedure GetLineSettings(var LineInfo : LineSettingsType);
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
lineinfo:=aktlineinfo;
|
||||
end;
|
||||
|
||||
{ this procedure is rather confuse
|
||||
but I admit that I wrote it by try-error !! PM }
|
||||
|
||||
procedure FillPoly(points : word;var polypoints);
|
||||
{$R-}
|
||||
type PointTypeArray = Array[0..0] of PointType;
|
||||
|
||||
{ Used to find the horizontal lines that
|
||||
must be filled }
|
||||
TLineSegmentInfo = Record
|
||||
{range for check }
|
||||
ymin,ymax,
|
||||
{ line equation consts }
|
||||
xcoef,ycoef,_const,
|
||||
lastvalue : longint;
|
||||
use_in_line : boolean;
|
||||
End;
|
||||
LineSegmentInfoArray = Array[0..0] of TLineSegmentInfo;
|
||||
|
||||
var
|
||||
xmin,xmax,ymin,ymax : longint;
|
||||
x1,x2,y1,y2,y,xdeb : longint;
|
||||
i,j,curx,cury : longint;
|
||||
newvalue : longint;
|
||||
LineInfo : ^LineSegmentInfoArray;
|
||||
PreviousInside,inside,side : boolean;
|
||||
viewport : viewporttype;
|
||||
begin
|
||||
GetMem(LineInfo,(points+1)*SizeOf(TlineSegmentInfo));
|
||||
xmax:=$80000000;xmin:=$7fffffff;
|
||||
ymax:=$80000000;ymin:=$7fffffff;
|
||||
for i:=0 to points-1 do
|
||||
begin
|
||||
if i=points-1 then
|
||||
j:=0
|
||||
else
|
||||
j:=i+1;
|
||||
x1:=PointTypeArray(polypoints)[i].x;
|
||||
y1:=PointTypeArray(polypoints)[i].y;
|
||||
x2:=PointTypeArray(polypoints)[j].x;
|
||||
y2:=PointTypeArray(polypoints)[j].y;
|
||||
if x1>xmax then
|
||||
xmax:=x1;
|
||||
if x1<xmin then
|
||||
xmin:=x1;
|
||||
if y1>ymax then
|
||||
ymax:=y1;
|
||||
if y1<ymin then
|
||||
ymin:=y1;
|
||||
if y1<y2 then
|
||||
begin
|
||||
LineInfo^[i].ymin:=y1;
|
||||
LineInfo^[i].ymax:=y2;
|
||||
end
|
||||
else
|
||||
begin
|
||||
LineInfo^[i].ymin:=y2;
|
||||
LineInfo^[i].ymax:=y1;
|
||||
end;
|
||||
LineInfo^[i].xcoef:=y2-y1;
|
||||
LineInfo^[i].ycoef:=x1-x2;
|
||||
LineInfo^[i]._const:=y1*x2-x1*y2;
|
||||
end; { setting of LineInfo }
|
||||
|
||||
side:=true;
|
||||
for i:=0 to points-1 do
|
||||
begin
|
||||
cury:=LineInfo^[i].ymin;
|
||||
newvalue:=LineInfo^[i].xcoef*(xmin-1)+
|
||||
LineInfo^[i].ycoef*cury+LineInfo^[i]._const;
|
||||
if (newvalue<0) then
|
||||
side:=not side;
|
||||
end;
|
||||
if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
|
||||
{ reject invalid points !! }
|
||||
|
||||
viewport.x2:=viewport.x2-viewport.x1;
|
||||
viewport.y2:=viewport.y2-viewport.y1;
|
||||
viewport.x1:=0;
|
||||
viewport.y1:=0;
|
||||
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'Rectangle (',xmin,',',ymin,'),(',xmax,',',ymax,')');
|
||||
{$endif def GraphDebug}
|
||||
if xmin<0 then xmin:=0;
|
||||
if ymin<0 then ymin:=0;
|
||||
if xmax>viewport.x2 then xmax:=viewport.x2;
|
||||
if ymax>viewport.y2 then ymax:=viewport.y2;
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'Rectangle (',xmin,',',ymin,'),(',xmax,',',ymax,')');
|
||||
{$endif def GraphDebug}
|
||||
|
||||
for cury:=ymin to ymax do
|
||||
begin
|
||||
xdeb:=xmin;
|
||||
PreviousInside:=true;
|
||||
for i:=0 to points-1 do
|
||||
begin
|
||||
if cury<LineInfo^[i].ymin then
|
||||
y:=LineInfo^[i].ymin
|
||||
else if cury>LineInfo^[i].ymax then
|
||||
y:=LineInfo^[i].ymax
|
||||
else
|
||||
y:=cury;
|
||||
newvalue:=LineInfo^[i].xcoef*(xmin-1)+
|
||||
LineInfo^[i].ycoef*y+LineInfo^[i]._const;
|
||||
LineInfo^[i].lastvalue:=newvalue;
|
||||
if (newvalue<0) then
|
||||
PreviousInside:=not PreviousInside;
|
||||
if (cury<LineInfo^[i].ymin) or (cury>=LineInfo^[i].ymax) then
|
||||
LineInfo^[i].use_in_line:=false
|
||||
else
|
||||
LineInfo^[i].use_in_line:=true;
|
||||
end;
|
||||
PreviousInside:=(side<>PreviousInside);
|
||||
inside:=PreviousInside;
|
||||
for curx:=xmin to xmax do
|
||||
begin
|
||||
for i:=0 to points-1 do
|
||||
if LineInfo^[i].use_in_line then
|
||||
begin
|
||||
newvalue:=LineInfo^[i].lastvalue+LineInfo^[i].xcoef;
|
||||
if ((LineInfo^[i].lastvalue<0) and (newvalue>=0)) or
|
||||
((LineInfo^[i].lastvalue>0) and (newvalue<=0)) then
|
||||
begin
|
||||
inside:=not inside;
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'Line ',i,' crossed (',curx,',',cury,')');
|
||||
Writeln(stderr,'Line x*',LineInfo^[i].xcoef,'+y*',
|
||||
LineInfo^[i].ycoef,'+',LineInfo^[i]._const,'=0');
|
||||
Writeln(stderr,'Old ',LineInfo^[i].lastvalue,' new ',newvalue);
|
||||
{$endif def GraphDebug}
|
||||
end;
|
||||
LineInfo^[i].lastvalue:=newvalue;
|
||||
end;
|
||||
if inside<>PreviousInside then
|
||||
if inside then
|
||||
xdeb:=curx
|
||||
else
|
||||
begin
|
||||
patternline(xdeb,curx,cury);
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'Pattern (',xdeb,',',curx,') at ',cury);
|
||||
{$endif def GraphDebug}
|
||||
end;
|
||||
PreviousInside:=inside;
|
||||
end;
|
||||
if inside then
|
||||
begin
|
||||
patternline(xdeb,xmax,cury);
|
||||
{$ifdef GraphDebug}
|
||||
Writeln(stderr,'Pattern (',xdeb,',',xmax,') at ',cury);
|
||||
{$endif def GraphDebug}
|
||||
end;
|
||||
end;
|
||||
|
||||
FreeMem(LineInfo,(points+1)*SizeOf(TlineSegmentInfo));
|
||||
{ simply call drawpoly instead (PM) }
|
||||
DrawPoly(points,polypoints);
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:03 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.8 1998/11/25 22:59:24 pierre
|
||||
* fillpoly works
|
||||
|
||||
Revision 1.7 1998/11/25 13:04:44 pierre
|
||||
+ added multi page support
|
||||
|
||||
Revision 1.6 1998/11/20 18:42:07 pierre
|
||||
* many bugs related to floodfill and ellipse fixed
|
||||
|
||||
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
|
||||
is outside !!)
|
||||
* fixed a bug in floodfill for patterns
|
||||
(still has problems !!)
|
||||
|
||||
Revision 1.3 1998/11/18 13:23:34 pierre
|
||||
* floodfill got into an infinite loop !!
|
||||
+ added partial support for fillpoly
|
||||
(still wrong if the polygon is not convex)
|
||||
Simply make a floodfill from the barycenter !
|
||||
* some 24BPP code changed (still does not work for my S3VBE program !)
|
||||
|
||||
Revision 1.2 1998/11/18 09:31:33 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:57:57 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/fill.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:29; author: michael; state: Exp; lines: +13 -1
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,85 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
var
|
||||
defaultfontdata : array[0..2047] of byte;
|
||||
|
||||
function getfontpointer(b : byte):longint;
|
||||
begin
|
||||
dregs.RealSS:=0;
|
||||
dregs.RealSP:=0;
|
||||
dregs.RealEAX:=$1130;
|
||||
dregs.RealEBX:=longint(b shl 8);
|
||||
RealIntr($10,dregs);
|
||||
getfontpointer:=(longint(dregs.RealES) shl 4) + dregs.RealEBP and $FFFF;
|
||||
end;
|
||||
|
||||
procedure getdefaultfont;
|
||||
var Sel : Word;
|
||||
linaddr : longint;
|
||||
|
||||
begin
|
||||
{ 8x8-Defaultfont aus BIOS laden }
|
||||
if isDPMI then begin
|
||||
SEL:=allocate_ldt_descriptors(1);
|
||||
linaddr:=getfontpointer(3);
|
||||
{ I got problems because the fonts were at real mode segment $ffff
|
||||
so the address is above 1Mo and thus not locked !! }
|
||||
if linaddr+1024>$100000 then
|
||||
linaddr:=get_linear_addr(linaddr,1024);
|
||||
Set_segment_base_address(SEL,linaddr);
|
||||
Set_segment_limit(SEL,1024);
|
||||
movelong(sel,@defaultfontdata[0],$3FF);
|
||||
linaddr:=getfontpointer(4);
|
||||
if linaddr+1024>$100000 then
|
||||
linaddr:=get_linear_addr(linaddr,1024);
|
||||
Set_segment_base_address(SEL,linaddr);
|
||||
Set_segment_limit(SEL,1024);
|
||||
movelong(sel,@defaultfontdata[1024],$3FF);
|
||||
free_ldt_descriptor(SEL);
|
||||
end else begin
|
||||
move(pointer(getfontpointer(3)+core)^,defaultfontdata[0],1024);
|
||||
move(pointer(getfontpointer(4)+core)^,defaultfontdata[1024],1024);
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:03 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:58:02 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/font.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:29; author: michael; state: Exp; lines: +14 -0
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,277 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
{$PACKRECORDS NORMAL}
|
||||
|
||||
const
|
||||
{ error codes }
|
||||
grOk = 0;
|
||||
grNoInitGraph = -1;
|
||||
grNotDetected = -2;
|
||||
grFileNotFound = -3;
|
||||
grInvalidDriver = -4;
|
||||
grNoLoadMem = -5;
|
||||
grNoScanMem = -6;
|
||||
grNoFloodMem = -7;
|
||||
grFontNotFound = -8;
|
||||
grNoFontMem = -9;
|
||||
grInvalidMode = -10;
|
||||
grError = -11;
|
||||
grIOerror = -12;
|
||||
grInvalidFont = -13;
|
||||
grInvalidFontNum = -14;
|
||||
grInvalidVersion = -18;
|
||||
|
||||
{ graphic drivers }
|
||||
CurrentDriver = -128;
|
||||
Detect = 0;
|
||||
|
||||
{ graph modes }
|
||||
Default = 0;
|
||||
|
||||
{ Farben f<>r setpalette und setallpalette }
|
||||
black : longint = 0;
|
||||
blue : longint = 1;
|
||||
green : longint = 2;
|
||||
cyan : longint = 3;
|
||||
red : longint = 4;
|
||||
magenta : longint = 5;
|
||||
brown : longint = 6;
|
||||
lightgray : longint = 7;
|
||||
darkgray : longint = 8;
|
||||
lightblue : longint = 9;
|
||||
lightgreen : longint = 10;
|
||||
lightcyan : longint = 11;
|
||||
lightred : longint = 12;
|
||||
lightmagenta : longint = 13;
|
||||
yellow : longint = 14;
|
||||
white : longint = 15;
|
||||
|
||||
{ Linenart f<>r Get/SetLineStyle: }
|
||||
SolidLn = 0;
|
||||
DottedLn = 1;
|
||||
CenterLn = 2;
|
||||
DashedLn = 3;
|
||||
UserBitLn = 4;
|
||||
|
||||
NormWidth = 1;
|
||||
ThickWidth = 3;
|
||||
|
||||
{ Set/GetTextStyle Konstanten: }
|
||||
DefaultFont = 0;
|
||||
TriplexFont = 1;
|
||||
SmallFont = 2;
|
||||
SansSerifFont = 3;
|
||||
GothicFont = 4;
|
||||
ScriptFont = 5;
|
||||
SimpleFont = 6;
|
||||
TSCRFont = 7;
|
||||
LCOMFont = 8;
|
||||
EuroFont = 9;
|
||||
BoldFont = 10;
|
||||
|
||||
HorizDir = 0;
|
||||
VertDir = 1;
|
||||
|
||||
UserCharSize = 0;
|
||||
|
||||
ClipOn = true;
|
||||
ClipOff = false;
|
||||
|
||||
{ Bar3D constants }
|
||||
TopOn = true;
|
||||
TopOff = false;
|
||||
|
||||
{ fill pattern for Get/SetFillStyle: }
|
||||
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;
|
||||
|
||||
{ bitblt operators }
|
||||
NormalPut = 0;
|
||||
CopyPut = 0;
|
||||
XORPut = 1;
|
||||
OrPut = 2;
|
||||
AndPut = 3;
|
||||
NotPut = 4;
|
||||
BackPut = 8;
|
||||
|
||||
{ SetTextJustify constants }
|
||||
LeftText = 0;
|
||||
CenterText = 1;
|
||||
RightText = 2;
|
||||
|
||||
BottomText = 0;
|
||||
TopText = 2;
|
||||
|
||||
type
|
||||
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;
|
||||
|
||||
FillPatternType = array[1..8] of byte;
|
||||
|
||||
PointType = record
|
||||
x,y : integer;
|
||||
end;
|
||||
|
||||
ViewPortType = record
|
||||
x1,y1,x2,y2 : integer;
|
||||
Clip : boolean;
|
||||
end;
|
||||
|
||||
ArcCoordsType = record
|
||||
x,y : integer;
|
||||
xstart,ystart : integer;
|
||||
xend,yend : integer;
|
||||
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 }
|
||||
);
|
||||
|
||||
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.1 1998-12-21 13:07:03 peter
|
||||
* use -FE
|
||||
|
||||
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
|
||||
is outside !!)
|
||||
* fixed a bug in floodfill for patterns
|
||||
(still has problems !!)
|
||||
|
||||
Revision 1.3 1998/11/18 09:31:34 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.2 1998/03/26 10:41:15 florian
|
||||
* some warnings fixed
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.4 1998/03/03 22:48:42 florian
|
||||
+ graph.drawpoly procedure
|
||||
+ putimage with xorput uses mmx if available
|
||||
|
||||
Revision 1.3 1998/01/26 11:58:05 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/global.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:30; author: michael; state: Exp; lines: +13 -0
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,406 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
function DetectVESA:Boolean;
|
||||
var Result_:longint;
|
||||
begin
|
||||
Result_:=Global_dos_alloc($0200);
|
||||
Sel:=word(Result_);
|
||||
Seg:=word(Result_ shr 16);
|
||||
dregs.RealSP:=0; dregs.RealSS:=0;
|
||||
dregs.RealES:=Seg; dregs.RealEDI:=0;
|
||||
dregs.RealEAX:=$4F00; RealIntr($10,dregs);
|
||||
if isDPMI
|
||||
then MoveLong(sel,@VGAInfo,256)
|
||||
else Move(pointer((seg shl 4)+core)^,VGAInfo,256);
|
||||
global_dos_free(sel);
|
||||
DetectVesa:=(dregs.RealEAX and $FF=$4F);
|
||||
isVESA2:=VGAInfo.VESAHiVersion=2;
|
||||
end;
|
||||
|
||||
function GetVESAInfo( Mode : WORD ):Boolean;
|
||||
var Result_:longint;
|
||||
St : string;
|
||||
{$ifdef Test_linear}
|
||||
Temp : longint;
|
||||
{$endif Test_linear}
|
||||
|
||||
begin
|
||||
Result_:=Global_dos_alloc($0200);
|
||||
Sel:=word(Result_);
|
||||
Seg:=word(Result_ shr 16);
|
||||
dregs.RealECX:=mode;
|
||||
dregs.RealSP:=0; dregs.RealSS:=0;
|
||||
dregs.RealES:=Seg; dregs.RealEDI:=0;
|
||||
dregs.RealEAX:=$4F01; RealIntr($10,dregs);
|
||||
if isDPMI
|
||||
then MoveLong(sel,@VESAInfo,256)
|
||||
else Move(Pointer((seg shl 4)+core)^,VESAINFO,256);
|
||||
global_dos_free(sel);
|
||||
|
||||
{ this is wrong because AH is set to one if mode not detected !!!
|
||||
if (dregs.RealEAX and $ff) =$4F then must be replaced by }
|
||||
if (dregs.RealEAX and $1ff) =$4F then
|
||||
begin
|
||||
GetVESAInfo:=true;
|
||||
{ mode is supported only if bit 0 in modeAttributes is set }
|
||||
if (VESAInfo.ModeAttributes and 1)=0 then
|
||||
GetVESAInfo:=false;
|
||||
BytesPerLine:=VESAInfo.BPL;
|
||||
case VESAInfo.BitsPerPixel of
|
||||
8 : begin
|
||||
BytesPerPixel:=1;
|
||||
ColorMask:=$ff;
|
||||
end;
|
||||
15,16 : begin
|
||||
BytesPerPixel:=2;
|
||||
ColorMask:=$ffff;
|
||||
end;
|
||||
{$ifdef TEST_24BPP}
|
||||
24 : begin
|
||||
BytesPerPixel:=3;
|
||||
ColorMask:=$ffffff;
|
||||
end;
|
||||
32 : begin
|
||||
BytesPerPixel:=4;
|
||||
ColorMask:=$ffffff;
|
||||
end;
|
||||
{$endif TEST_24BPP}
|
||||
else begin
|
||||
str(VESAInfo.BitsPerPixel,St);
|
||||
GraphFault(St+'-Bit Mode not implemented !');
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
_maxx:=VESAInfo.XResolution;
|
||||
_maxy:=VESAInfo.YResolution;
|
||||
|
||||
{$ifdef TEST_24BPP}
|
||||
{ problem with pseudo 32 bit modes !! }
|
||||
if BytesPerPixel*VESAInfo.XResolution<>BytesPerLine then
|
||||
begin
|
||||
GraphFault('Unconsistant VESA data');
|
||||
{ GetVesaInfo:=False; }
|
||||
BytesPerPixel:=BytesPerLine div VESAInfo.XResolution;
|
||||
end;
|
||||
{$endif TEST_24BPP}
|
||||
WinSize:=VESAInfo.Winsize*1024;
|
||||
WinLoMask:=WinSize-1;
|
||||
case VESAInfo.WinSize of
|
||||
64 : WinShift:=16; { x div 65536 = x shr 16 }
|
||||
32 : WinShift:=15; { x div 32768 = x shr 15 }
|
||||
16 : WinShift:=14; { ... }
|
||||
8 : WinShift:=13;
|
||||
4 : WinShift:=12;
|
||||
2 : WinShift:=11;
|
||||
1 : WinShift:=10;
|
||||
end;
|
||||
Granularity:=VESAInfo.WinGranularity;
|
||||
Granular:=VESAInfo.WinSize div Granularity;
|
||||
case Granular of
|
||||
256 : GranShift:=8;
|
||||
128 : GranShift:=7;
|
||||
64 : GranShift:=6;
|
||||
32 : GranShift:=5;
|
||||
16 : GranShift:=4;
|
||||
8 : GranShift:=3;
|
||||
4 : GranShift:=2;
|
||||
2 : GranShift:=1;
|
||||
1 : GranShift:=0;
|
||||
end;
|
||||
(* { on my ATI rage pro card these field are zeroed !! (PM) }
|
||||
|
||||
if VesaInfo.rf_pos=VesaInfo.bf_pos then
|
||||
begin
|
||||
VesaInfo.rm_size:=VESAInfo.BitsPerPixel div 3;
|
||||
VesaInfo.bm_size:=VESAInfo.BitsPerPixel div 3;
|
||||
VesaInfo.gm_size:=VESAInfo.BitsPerPixel -2*VesaInfo.bm_size;
|
||||
VesaInfo.bf_pos:=0;
|
||||
VesaInfo.gf_pos:=VesaInfo.bm_size;
|
||||
VesaInfo.rf_pos:=VesaInfo.bm_size+VesaInfo.gm_size;
|
||||
end; *)
|
||||
|
||||
if isDPMI then begin
|
||||
set_segment_base_address(seg_write,$A000 shl 4);
|
||||
set_segment_limit(seg_write,$FFFF);
|
||||
set_segment_base_address(seg_read,$A000 shl 4);
|
||||
set_segment_limit(seg_read,$FFFF);
|
||||
end;
|
||||
{ read and write window can be different !!! PM }
|
||||
if ((VESAInfo.WinAAttributes and 5)=5) then
|
||||
AW_Window:=AWindow
|
||||
else if ((VESAInfo.WinBAttributes and 5)=5) then
|
||||
AW_Window:=BWindow
|
||||
else GraphFault('No write window !! ');
|
||||
if ((VESAInfo.WinAAttributes and 3)=3) then
|
||||
AR_Window:=AWindow
|
||||
else if ((VESAInfo.WinBAttributes and 3)=3) then
|
||||
AR_Window:=BWindow
|
||||
else GraphFault('No read window !! ');
|
||||
if AW_Window=AR_Window then
|
||||
same_window:=true
|
||||
else
|
||||
same_window:=false;
|
||||
|
||||
if (VESAInfo.ModeAttributes and $80)=$80 then
|
||||
LinearFrameBufferSupported:=true
|
||||
else
|
||||
LinearFrameBufferSupported:=false;
|
||||
|
||||
{$ifdef Test_linear}
|
||||
(* bug was due to alignment problem in VesaInfoBlock !! PM
|
||||
{ try to swap the FrameBuffer Physical Address }
|
||||
if switch_physical_address then
|
||||
begin
|
||||
w:=VESAInfo.PhysAddress and $FFFF;
|
||||
VESAInfo.PhysAddress:=(w shl 16) or (VESAInfo.PhysAddress shr 16);
|
||||
end; *)
|
||||
If LinearFrameBufferSupported then
|
||||
begin
|
||||
FrameBufferLinearAddress:=Get_linear_addr(VESAInfo.PhysAddress and $FFFF0000,VGAInfo.TotalMem shl 16);
|
||||
if int31error<>0 then
|
||||
writeln(stderr,'Error in get linear address for ',hexstr(VESAInfo.PhysAddress,8));
|
||||
end
|
||||
else
|
||||
{$endif Test_linear}
|
||||
FrameBufferLinearAddress:=$A0000;
|
||||
|
||||
{$ifdef Test_linear}
|
||||
If isDPMI and LinearFrameBufferSupported and UseLinear then
|
||||
UseLinearFrameBuffer:=true
|
||||
else
|
||||
UseLinearFrameBuffer:=false;
|
||||
if UseLinearFrameBuffer then
|
||||
begin
|
||||
set_segment_base_address(seg_write,FrameBufferLinearAddress);
|
||||
set_segment_limit(seg_write,(VGAInfo.TotalMem shl 16)-1);
|
||||
set_segment_base_address(seg_read,FrameBufferLinearAddress);
|
||||
set_segment_limit(seg_read,(VGAInfo.TotalMem shl 16)-1);
|
||||
WinSize:=(VGAInfo.TotalMem shl 16);
|
||||
WinLoMask:=(VGAInfo.TotalMem shl 16)-1;
|
||||
WinShift:=15;
|
||||
Temp:=VGAInfo.TotalMem;
|
||||
while Temp>0 do
|
||||
begin
|
||||
inc(WinShift);
|
||||
Temp:=Temp shr 1;
|
||||
end;
|
||||
end;
|
||||
{$endif Test_linear}
|
||||
SwitchCS:=hi(VESAInfo.RealWinFuncPtr);
|
||||
SwitchIP:=lo(VESAInfo.RealWinFuncPtr);
|
||||
{ usefull for boundary problems }
|
||||
if BytesPerPixel=3 then
|
||||
WinLoMaskMinusPixelSize:=WinLoMask-4
|
||||
else
|
||||
WinLoMaskMinusPixelSize:=WinLoMask-BytesPerPixel;
|
||||
end else GetVESAInfo:=false;
|
||||
end;
|
||||
|
||||
function SetVESAMode(Mode:WORD):Boolean;
|
||||
begin
|
||||
dregs.RealEBX:=Mode;
|
||||
dregs.RealSP:=0; dregs.RealSS:=0;
|
||||
dregs.RealEAX:=$4F02; RealIntr($10,dregs);
|
||||
{ idem as above !!! }
|
||||
if (dregs.RealEAX and $1FF) <> $4F then begin
|
||||
writeln('Couldn''t initialize VESAMode ',HexStr(mode,4));
|
||||
SetVESAMode:=false;
|
||||
end
|
||||
else SetVESAMode:=true;
|
||||
end;
|
||||
|
||||
procedure SetDisplayPage(PageNum : word);
|
||||
|
||||
begin
|
||||
dregs.RealSP:=0; dregs.RealSS:=0;
|
||||
dregs.RealEAX:=$0500+(PageNum and $FF);
|
||||
RealIntr($10,dregs);
|
||||
end;
|
||||
|
||||
function SetVESADisplayStart(PageNum : word;x,y : integer):Boolean;
|
||||
begin
|
||||
if PageNum>VesaInfo.NumberOfPages then
|
||||
PageNum:=0;
|
||||
{$ifdef DEBUG}
|
||||
if PageNum>0 then
|
||||
writeln(stderr,'Setting Display Page ',PageNum);
|
||||
{$endif DEBUG}
|
||||
dregs.RealEBX:=0{ $80 for Wait for retrace };
|
||||
dregs.RealECX:=x;
|
||||
dregs.RealEDX:=y+PageNum*_maxy;
|
||||
dregs.RealSP:=0; dregs.RealSS:=0;
|
||||
dregs.RealEAX:=$4F07; RealIntr($10,dregs);
|
||||
{ idem as above !!! }
|
||||
if (dregs.RealEAX and $1FF) <> $4F then
|
||||
begin
|
||||
writeln(stderr,'Set Display start error');
|
||||
SetVESADisplayStart:=false;
|
||||
end
|
||||
else
|
||||
SetVESADisplayStart:=true;
|
||||
end;
|
||||
|
||||
function GetVESAMode:Integer;
|
||||
begin
|
||||
dregs.RealSP:=0; dregs.RealSS:=0;
|
||||
dregs.RealEAX:=$4F03; RealIntr($10,dregs);
|
||||
GetVESAMode:=lo(dregs.RealEBX);
|
||||
end;
|
||||
|
||||
procedure InitVESA;
|
||||
var RM:Word;
|
||||
begin
|
||||
isDPMI:=false;
|
||||
rm:=get_run_mode;
|
||||
{$ifdef Debug}
|
||||
case rm of
|
||||
0 : writeln('unknown mode');
|
||||
1 : writeln('RAW mode');
|
||||
2 : writeln('XMS detected');
|
||||
3 : writeln('VCPI detected');
|
||||
4 : writeln('DPMI detected');
|
||||
end; { case }
|
||||
{$endif Debug}
|
||||
if rm=4 then
|
||||
isDPMI:=true;
|
||||
if isDPMI then begin
|
||||
seg_write:=allocate_ldt_descriptors(1);
|
||||
seg_read:=allocate_ldt_descriptors(1);
|
||||
end else begin
|
||||
seg_write:=get_DS;
|
||||
seg_read:=get_DS;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoneVESA;
|
||||
begin
|
||||
if isDPMI then begin
|
||||
free_ldt_descriptor(seg_read);
|
||||
free_ldt_descriptor(seg_write);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Switchbank(bank:longint);
|
||||
begin
|
||||
with dregs do
|
||||
begin
|
||||
a_bank:=bank;
|
||||
realedx:=bank shl granshift;
|
||||
realcs:=switchcs;
|
||||
realip:=switchip;
|
||||
realebx:=aw_window;
|
||||
realss:=0;
|
||||
realsp:=0;
|
||||
end;
|
||||
asm
|
||||
leal _DREGS,%edi
|
||||
xorl %ecx,%ecx
|
||||
movl %ecx,%ebx
|
||||
movw $0x0301,%ax
|
||||
int $0x31
|
||||
end;
|
||||
if not same_window then
|
||||
with dregs do
|
||||
begin
|
||||
realedx:=bank shl granshift;
|
||||
realcs:=switchcs;
|
||||
realip:=switchip;
|
||||
realebx:=ar_window;
|
||||
realss:=0;
|
||||
realsp:=0;
|
||||
asm
|
||||
leal _DREGS,%edi
|
||||
xorl %ecx,%ecx
|
||||
movl %ecx,%ebx
|
||||
movw $0x0301,%ax
|
||||
int $0x31
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 1999-05-04 17:17:32 florian
|
||||
* some explicit language removed
|
||||
|
||||
Revision 1.2 1998/12/21 14:06:03 pierre
|
||||
* var declaration was missing ??
|
||||
|
||||
Revision 1.1 1998/12/21 13:07:03 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.7 1998/11/25 13:04:46 pierre
|
||||
+ added multi page support
|
||||
|
||||
Revision 1.6 1998/11/20 18:42:08 pierre
|
||||
* many bugs related to floodfill and ellipse fixed
|
||||
|
||||
Revision 1.5 1998/11/20 10:16:02 pierre
|
||||
* Found out the LinerFrameBuffer problem
|
||||
Was an alignment problem in VesaInfoBlock (see graph.pp file)
|
||||
Compile with -dDEBUG and answer 'y' to 'Use Linear ?' to test
|
||||
|
||||
Revision 1.4 1998/11/18 12:12:54 pierre
|
||||
* WinShift was wrong for LinearBuffer
|
||||
|
||||
Revision 1.3 1998/11/18 09:31:35 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.2 1998/10/09 10:26:36 peter
|
||||
* rename result -> result_
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.6 1998/01/26 11:58:09 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/ibm.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.5
|
||||
date: 1997/12/11 11:26:54; author: pierre; state: Exp; lines: +165 -165
|
||||
* forgot dtou !!
|
||||
----------------------------
|
||||
revision 1.4
|
||||
date: 1997/12/11 11:24:19; author: pierre; state: Exp; lines: +165 -165
|
||||
* bug in string at line 103 corrected
|
||||
----------------------------
|
||||
revision 1.3
|
||||
date: 1997/12/04 08:52:35; author: florian; state: Exp; lines: +4 -4
|
||||
+ vesa mode 1280x1024x256 added
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:30; author: michael; state: Exp; lines: +13 -1
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,236 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
procedure GetImage(x1,y1,x2,y2 : integer;var BitMap);
|
||||
|
||||
var
|
||||
i,linesize,target : longint;
|
||||
ofs1,ofs2,bank1,bank2,diff : longint;
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
|
||||
x1:=x1+aktviewport.x1;
|
||||
y1:=y1+aktviewport.y1;
|
||||
x2:=x2+aktviewport.x1;
|
||||
y2:=y2+aktviewport.y1;
|
||||
|
||||
if (x1>_maxx) or (y1>_maxy) or (x2<0) or (y2<0) then exit;
|
||||
|
||||
target:=longint(@bitmap)+4;
|
||||
pinteger(@bitmap)^:=x2-x1+1;
|
||||
pinteger(@bitmap+2)^:=y2-y1+1;
|
||||
linesize:=(x2-x1+1)*BytesPerPixel;
|
||||
|
||||
for i:=y1 to y2 do
|
||||
begin
|
||||
ofs1:=Y_ARRAY[i]+X_ARRAY[x1];
|
||||
ofs2:=Y_ARRAY[i]+X_ARRAY[x2];
|
||||
bank1:=ofs1 shr WinShift;
|
||||
bank2:=ofs2 shr WinShift;
|
||||
if bank1 <> A_BANK then
|
||||
begin
|
||||
Switchbank(bank1);
|
||||
end;
|
||||
if bank1=bank2
|
||||
then ScreenToMem(ofs1 and WinLoMask,target,linesize)
|
||||
else begin
|
||||
diff:=(bank2 shl winshift)-ofs2;
|
||||
ScreenToMem(ofs1 and WinLoMask,target,diff-BytesPerPixel);
|
||||
Switchbank(bank2);
|
||||
ScreenToMem((ofs1+diff) and WinLoMask,target+diff,linesize-diff);
|
||||
end;
|
||||
target:=target+linesize;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure PutImage(x,y : integer;var BitMap;BitBlt : word);
|
||||
|
||||
var
|
||||
height,width : integer;
|
||||
diff : integer;
|
||||
increment,i : longint;
|
||||
source,o1,o2 : longint;
|
||||
offset : longint;
|
||||
viewport : viewporttype;
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
|
||||
source:=longint(@bitmap)+4;
|
||||
Width:=pinteger(@bitmap)^;
|
||||
Increment:=longint(Width);
|
||||
height:=pinteger(@bitmap+2)^;
|
||||
{ wenn ausserhalb des Screens Procedur verlassen }
|
||||
x:=x+aktviewport.x1;
|
||||
y:=y+aktviewport.y1;
|
||||
|
||||
if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
|
||||
if (x > viewport.x2 ) or
|
||||
(y > viewport.y2 ) or
|
||||
(x+Increment < viewport.x1) or
|
||||
(y+height < viewport.y1) then exit;
|
||||
|
||||
{ Clip oben }
|
||||
if y < viewport.y1 then
|
||||
begin
|
||||
diff:=viewport.y1-y;
|
||||
height:=height-diff;
|
||||
source:=source+Increment*diff;
|
||||
y:=viewport.y1;
|
||||
end;
|
||||
{ Clip unten }
|
||||
|
||||
if y+height > viewport.y2 then
|
||||
height:=viewport.y2-y;
|
||||
|
||||
{ Clip links }
|
||||
if x < viewport.x1 then
|
||||
begin
|
||||
diff:=viewport.x1-x;
|
||||
Width:=Increment-diff;
|
||||
source:=source+diff;
|
||||
x:=viewport.x1;
|
||||
end;
|
||||
|
||||
{ clip rechts }
|
||||
if x+width > viewport.x2 then
|
||||
begin
|
||||
diff:=x+width-viewport.x2;
|
||||
Width:=Increment-diff;
|
||||
end;
|
||||
|
||||
Increment:=Increment*BytesPerPixel;
|
||||
Width:=Width*BytesPerPixel;
|
||||
for i:=y to y+height-1 do
|
||||
begin
|
||||
offset:=Y_ARRAY[i] + X_ARRAY[x];
|
||||
o1:=offset shr winshift;
|
||||
o2:=( offset + width ) shr winshift;
|
||||
if o1 <> A_BANK then
|
||||
begin
|
||||
Switchbank(o1);
|
||||
end;
|
||||
if o1 = o2 then
|
||||
begin
|
||||
case bitblt of
|
||||
normalput : MemToScreen (source,offset and WinLoMask,width);
|
||||
andput : MemAndScreen(source,offset and WinLoMask,width);
|
||||
orput : MemOrScreen (source,offset and WinLoMask,width);
|
||||
xorput : MemXorScreen(source,offset and WinLoMask,width);
|
||||
notput : MemNotScreen(source,offset and WinLoMask,width);
|
||||
end;
|
||||
end else begin
|
||||
{ Bankswitching }
|
||||
diff:=((o2 shl winshift)-offset);
|
||||
case bitblt of
|
||||
normalput : begin
|
||||
MemToScreen (source,offset and WinLoMask,diff-BytesPerPixel);
|
||||
Switchbank(o2);
|
||||
MemToScreen (source+diff,(offset+diff) and WinLoMask,width-diff);
|
||||
end;
|
||||
andput : begin
|
||||
MemAndScreen (source,offset and WinLoMask,diff-BytesPerPixel);
|
||||
Switchbank(o2);
|
||||
MemAndScreen (source+diff,(offset+diff) and WinLoMask,width-diff);
|
||||
end;
|
||||
orput : begin
|
||||
MemOrScreen (source,offset and WinLoMask,diff-BytesPerPixel);
|
||||
Switchbank(o2);
|
||||
MemOrScreen (source++diff,(offset+diff) and WinLoMask,width-diff);
|
||||
end;
|
||||
xorput : begin
|
||||
MemXorScreen(source,offset and WinLoMask,diff-BytesPerPixel);
|
||||
Switchbank(o2);
|
||||
MemXorScreen(source+diff,(offset+diff) and WinLoMask,width-diff);
|
||||
end;
|
||||
notput : begin
|
||||
MemNotScreen(source,offset and WinLoMask,diff-BytesPerPixel);
|
||||
Switchbank(o2);
|
||||
MemNotScreen(source+diff,(offset+diff) and WinLoMask,width-diff);
|
||||
end;
|
||||
end; { case }
|
||||
end; { else }
|
||||
source:=source+Increment;
|
||||
end; { for i }
|
||||
{ clear the mmx state }
|
||||
if is_mmx_cpu then
|
||||
emms;
|
||||
end;
|
||||
|
||||
|
||||
function ImageSize(x1,y1,x2,y2 : integer) : longint;
|
||||
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
ImageSize:=(x2-x1+1)*(y2-y1+1)*BytesPerPixel+4;
|
||||
{ 4 bytes for Height and width in words at the beginning }
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:03 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.2 1998/11/18 09:31:36 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.5 1998/03/03 22:48:42 florian
|
||||
+ graph.drawpoly procedure
|
||||
+ putimage with xorput uses mmx if available
|
||||
|
||||
Revision 1.4 1998/01/26 11:58:14 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/image.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.3
|
||||
date: 1997/12/19 11:47:08; author: florian; state: Exp; lines: +3 -3
|
||||
*** empty log message ***
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:30; author: michael; state: Exp; lines: +13 -1
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,702 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
procedure DrawPattern(x1,x2,y:integer);
|
||||
begin
|
||||
if BytesPerPixel=3 then
|
||||
{ big problem one point can be across boundary !! }
|
||||
begin
|
||||
if ((Y_Array[y]+X_array[x1]) and winlomask)+3 > winlomask then
|
||||
begin
|
||||
{ special point !! }
|
||||
{ not implemented yet !! }
|
||||
inc(x1);
|
||||
end;
|
||||
end;
|
||||
|
||||
asm
|
||||
movswl x1,%ebx
|
||||
movswl x2,%ecx
|
||||
movswl y,%edx
|
||||
subl %ebx,%ecx
|
||||
incl %ecx
|
||||
movl _X_ARRAY(,%ebx,4),%eax
|
||||
movl _Y_ARRAY(,%edx,4),%edi // { Offset in %edi }
|
||||
addl %eax,%edi
|
||||
andl _WINLOMASK,%edi
|
||||
andl $0x7,%edx // { y and $7 }
|
||||
shll $0x5,%edx // { y * 8 * sizeof(longint) }
|
||||
leal _PATTERNBUFFER,%esi //
|
||||
addl %edx,%esi // { Offset in Patternbuffer }
|
||||
movl $0x7,%edx
|
||||
addl _WBUFFER,%edi
|
||||
pushw %es
|
||||
movw _SEG_WRITE,%ax
|
||||
movw %ax,%es
|
||||
testw $1,_AKTWRITEMODE
|
||||
jnz .Lpl_xord
|
||||
.Lpl_movd:
|
||||
cmpw $2,_BYTESPERPIXEL
|
||||
je .Lpl_movdw
|
||||
jb .Lpl_movdb
|
||||
|
||||
{$ifdef TEST_24BPP}
|
||||
cmpw $3,_BYTESPERPIXEL
|
||||
je .Lpl_movd24BPP
|
||||
.align 4,0x90
|
||||
.Lpl_movd32BPP:
|
||||
andl $7,%ebx
|
||||
movl (%esi,%ebx,4),%eax
|
||||
movl %eax,%es:(%edi)
|
||||
addl $4,%edi
|
||||
{ should not be necessary !! }
|
||||
cmpl _WINLOMASKMINUSPIXELSIZE,%edi
|
||||
ja .Lpl_d_exit
|
||||
incl %ebx
|
||||
decl %ecx
|
||||
jnz .Lpl_movd32BPP
|
||||
jz .Lpl_d_exit
|
||||
.align 4,0x90
|
||||
.Lpl_movd24BPP:
|
||||
andl $7,%ebx
|
||||
movl (%esi,%ebx,4),%eax
|
||||
andl $0x00FFFFFF,%eax
|
||||
movl %es:(%edi),%edx
|
||||
andl $0xFF000000,%edx
|
||||
orl %edx,%eax
|
||||
movl %eax,%es:(%edi)
|
||||
addl $3,%edi
|
||||
cmpl _WINLOMASKMINUSPIXELSIZE,%edi
|
||||
ja .Lpl_d_exit
|
||||
incl %ebx
|
||||
decl %ecx
|
||||
jnz .Lpl_movd24BPP
|
||||
jz .Lpl_d_exit
|
||||
{$endif TEST_24BPP}
|
||||
.align 4,0x90
|
||||
.Lpl_movdb:
|
||||
andl %edx,%ebx
|
||||
movb (%esi,%ebx,4),%al
|
||||
movb %al,%es:(%edi)
|
||||
incl %edi
|
||||
incl %ebx
|
||||
decl %ecx
|
||||
jnz .Lpl_movdb
|
||||
jz .Lpl_d_exit
|
||||
|
||||
.align 4,0x90
|
||||
.Lpl_movdw:
|
||||
andl %edx,%ebx
|
||||
movw (%esi,%ebx,4),%ax
|
||||
movw %ax,%es:(%edi)
|
||||
addl $2,%edi
|
||||
incl %ebx
|
||||
decl %ecx
|
||||
jnz .Lpl_movdw
|
||||
jz .Lpl_d_exit
|
||||
.Lpl_xord:
|
||||
cmpw $2,_BYTESPERPIXEL
|
||||
je .Lpl_xordw
|
||||
jb .Lpl_xordb
|
||||
|
||||
{$ifdef TEST_24BPP}
|
||||
cmpw $3,_BYTESPERPIXEL
|
||||
je .Lpl_xord24BPP
|
||||
.align 4,0x90
|
||||
.Lpl_xord32BPP:
|
||||
andl $7,%ebx
|
||||
movl (%esi,%ebx,4),%eax
|
||||
movl %es:(%edi),%edx
|
||||
xorl %edx,%eax
|
||||
movl %eax,%es:(%edi)
|
||||
addl $4,%edi
|
||||
cmpl _WINLOMASKMINUSPIXELSIZE,%edi
|
||||
ja .Lpl_d_exit
|
||||
incl %ebx
|
||||
decl %ecx
|
||||
jnz .Lpl_xord32BPP
|
||||
jz .Lpl_d_exit
|
||||
.align 4,0x90
|
||||
.Lpl_xord24BPP:
|
||||
andl $7,%ebx
|
||||
movl (%esi,%ebx,4),%eax
|
||||
andl $0x00FFFFFF,%eax
|
||||
movl %es:(%edi),%edx
|
||||
xorl %edx,%eax
|
||||
movl %eax,%es:(%edi)
|
||||
addl $3,%edi
|
||||
cmpl _WINLOMASKMINUSPIXELSIZE,%edi
|
||||
ja .Lpl_d_exit
|
||||
incl %ebx
|
||||
decl %ecx
|
||||
jnz .Lpl_xord24BPP
|
||||
jz .Lpl_d_exit
|
||||
{$endif TEST_24BPP}
|
||||
.align 4,0x90
|
||||
.Lpl_xordb:
|
||||
andl %edx,%ebx
|
||||
movb (%esi,%ebx,4),%al
|
||||
xorb %al,%es:(%edi)
|
||||
incl %edi
|
||||
incl %ebx
|
||||
decl %ecx
|
||||
jnz .Lpl_xordb
|
||||
jz .Lpl_d_exit
|
||||
.align 4,0x90
|
||||
.Lpl_xordw:
|
||||
andl %edx,%ebx
|
||||
movw (%esi,%ebx,4),%ax
|
||||
xorw %ax,%es:(%edi)
|
||||
addl $2,%edi
|
||||
incl %ebx
|
||||
decl %ecx
|
||||
jnz .Lpl_xordw
|
||||
.Lpl_d_exit:
|
||||
popw %es
|
||||
.Lpl_exit:
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure PatternLine(x1,x2,y:integer);
|
||||
var bank1,bank2 : longint;
|
||||
ofs1,ofs2 : longint;
|
||||
diff : integer;
|
||||
viewport : ViewPortType;
|
||||
begin
|
||||
x1:= x1 + aktviewport.x1 ;
|
||||
y:= y + aktviewport.y1 ;
|
||||
x2:= x2 + aktviewport.x1 ;
|
||||
|
||||
if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
|
||||
if (y < viewport.y1) or (y > viewport.y2) then exit;
|
||||
if x1 > x2 then begin diff:=x2; x2:=x1; x1:=diff; end;
|
||||
if (x1> viewport.x2) or (x2< viewport.x1) then exit;
|
||||
if x1 < viewport.x1 then x1:=viewport.x1;
|
||||
if x2 > viewport.x2 then x2:=viewport.x2;
|
||||
ofs1:= Y_ARRAY[y];
|
||||
ofs2:= ofs1 + X_ARRAY[x2];
|
||||
ofs1:= ofs1 + X_ARRAY[x1];
|
||||
bank1:=ofs1 shr winshift;
|
||||
bank2:=ofs2 shr winshift;
|
||||
if bank1 <> A_BANK then
|
||||
begin
|
||||
Switchbank(bank1);
|
||||
end;
|
||||
if bank1 <> bank2 then begin
|
||||
diff:=(((bank2 shl winshift)-ofs1) div BytesPerPixel)+x1;
|
||||
DrawPattern(x1,diff-1,y);
|
||||
Switchbank(bank2);
|
||||
DrawPattern(diff,x2,y);
|
||||
end else DrawPattern(x1,x2,y);
|
||||
end;
|
||||
|
||||
|
||||
procedure HorizontalLine(x1,x2,y:integer);
|
||||
{ without bankswitching }
|
||||
{ nothing for 24BPP yet (PM) }
|
||||
{$ifdef TEST_24BPP}
|
||||
var i,j : longint;
|
||||
{$endif TEST_24BPP}
|
||||
begin
|
||||
{$ifdef TEST_24BPP}
|
||||
if BytesPerPixel=3 then
|
||||
{ big problem one point can be across boundary !! }
|
||||
begin
|
||||
if ((Y_Array[y]+X_array[x1]) and winlomask)+3 > winlomask then
|
||||
begin
|
||||
{ special point !! }
|
||||
{ not implemented yet !! }
|
||||
inc(x1);
|
||||
end;
|
||||
j:=Y_array[y]+X_array[x1];
|
||||
for i:=x1 to x2 do
|
||||
begin
|
||||
if aktwritemode=normalput then
|
||||
pixel(j)
|
||||
else
|
||||
begin
|
||||
putpixeli(i,y,aktcolor xor getpixel(i,y));
|
||||
end;
|
||||
inc(j,3);
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
{$endif TEST_24BPP}
|
||||
|
||||
asm
|
||||
movw %es,%dx
|
||||
movzwl y,%ebx
|
||||
movzwl x1,%eax
|
||||
movzwl x2,%ecx
|
||||
incl %ecx
|
||||
movl _X_ARRAY(,%eax,4),%eax
|
||||
movl _X_ARRAY(,%ecx,4),%ecx
|
||||
movl _Y_ARRAY(,%ebx,4),%edi // { Offset in %edi }
|
||||
subl %eax,%ecx // { Counter }
|
||||
addl %eax,%edi
|
||||
andl _WINLOMASK,%edi
|
||||
movl _AKTCOLOR,%eax
|
||||
movzwl _AKTWRITEMODE,%esi
|
||||
addl _WBUFFER,%edi
|
||||
movw _SEG_WRITE,%bx
|
||||
movw %bx,%es
|
||||
testl %esi,%esi // { Writemode ? }
|
||||
jnz .Lhl_xor
|
||||
shrl %ecx
|
||||
jnc .L_movw
|
||||
stosb
|
||||
.L_movw:
|
||||
shrl %ecx
|
||||
jnc .L_movd
|
||||
stosw
|
||||
.L_movd:
|
||||
rep
|
||||
stosl
|
||||
jmp .Lhl_exit
|
||||
|
||||
.Lhl_xor: // -------------------------------------------------
|
||||
|
||||
movl $4,%esi
|
||||
shrl %ecx
|
||||
jnc .Lhl_xorw
|
||||
xorb %al,%es:(%edi)
|
||||
incl %edi
|
||||
.Lhl_xorw:
|
||||
shrl %ecx
|
||||
jnc .Lhl_xord
|
||||
xorw %ax,%es:(%edi)
|
||||
addl $2,%edi
|
||||
.Lhl_xord:
|
||||
jecxz .Lhl_exit
|
||||
.align 4,0x90
|
||||
.Lhl_xorloop:
|
||||
xorl %eax,%es:(%edi)
|
||||
addl %esi,%edi
|
||||
decl %ecx
|
||||
jnz .Lhl_xorloop
|
||||
.Lhl_exit:
|
||||
movw %dx,%es
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Line(x1,y1,x2,y2: integer);
|
||||
var dx,dy,d : longint;
|
||||
i,j : integer;
|
||||
ofs,ofs2 : longint;
|
||||
i1,i2,ix : longint;
|
||||
x,y : Integer;
|
||||
flag,dontcheck : Boolean;
|
||||
viewport : ViewPortType;
|
||||
begin
|
||||
|
||||
x1:= x1 + aktviewport.x1 ;
|
||||
y1:= y1 + aktviewport.y1 ;
|
||||
x2:= x2 + aktviewport.x1 ;
|
||||
y2:= y2 + aktviewport.y1 ;
|
||||
if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
|
||||
|
||||
{ ************ Horizontalline ************** }
|
||||
|
||||
if y1=y2 then begin
|
||||
if x1>x2 then begin d:=x1; x1:=x2; x2:=d; end;
|
||||
if aktlineinfo.thickness=3 then y1:=y1-1;
|
||||
i:=0;
|
||||
if x1 < viewport.x1 then x1:=viewport.x1;
|
||||
if x2 > viewport.x2 then x2:=viewport.x2;
|
||||
if (y1 > viewport.y2) or (x1 > x2 ) then exit;
|
||||
repeat
|
||||
if (y1 >= viewport.y1) and (y1 <=viewport.y2)
|
||||
then begin
|
||||
ofs:= Y_ARRAY[y1];
|
||||
ofs2:=ofs+X_ARRAY[x2];
|
||||
ofs:= ofs+X_ARRAY[x1];
|
||||
i1:=ofs shr winshift; i2:=ofs2 shr winshift;
|
||||
if i1 <> a_bank then
|
||||
begin
|
||||
switchbank(i1);
|
||||
end;
|
||||
if i1=i2 then Horizontalline(x1,x2,y1)
|
||||
else
|
||||
begin
|
||||
dx:=((i2 shl winshift)-ofs) div BytesPerPixel;
|
||||
horizontalline(x1,x1+dx-1,y1);
|
||||
Switchbank(i2);
|
||||
horizontalline(dx+x1,x2,y1);
|
||||
end;
|
||||
end;
|
||||
i:=i+1; y1:=y1+1;
|
||||
until i=aktlineinfo.thickness;
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ *********** End Horizontalline *********** }
|
||||
|
||||
if y1 > y2 then begin
|
||||
x:=x1; x1:=x2; x2:=x;
|
||||
y:=y1; y1:=y2; y2:=y;
|
||||
end;
|
||||
|
||||
{ ************** Verticalline ************** }
|
||||
|
||||
if x1=x2 then
|
||||
begin
|
||||
if y1 < viewport.y1 then y1:=viewport.y1;
|
||||
if y2 > viewport.y2 then y2:=viewport.y2;
|
||||
if ( y1 > y2) or (x1 < viewport.x1) or (x1 > viewport.x2) then exit;
|
||||
ofs:= Y_Array[y2]+X_Array[x1];
|
||||
ofs2:=Y_Array[y1]+X_Array[x1];
|
||||
while ofs >= ofs2 do begin
|
||||
pixel(ofs);
|
||||
if aktlineinfo.thickness=3 then begin
|
||||
if x1>viewport.x1 then pixel(ofs-1);
|
||||
if x1<viewport.x2 then pixel(ofs+1);
|
||||
end;
|
||||
ofs:=ofs-BytesPerLine;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ ************ End Verticalline ************ }
|
||||
|
||||
dy:=y2-y1;
|
||||
dx:=abs(x2-x1);
|
||||
if x1>x2 then ix:=-1 else ix:= 1;
|
||||
if dx<dy then begin d:=dx; dx:=dy; dy:=d; Flag:=true end else Flag:=false;
|
||||
i1:=dy shl 1;
|
||||
d:=i1 - dx;
|
||||
i2:=(dx shl 1)-i1;
|
||||
|
||||
{ for 24BPP use slow checking code,easy and poor implementation ! PM }
|
||||
dontcheck:=(y1>=viewport.y1) and (y2<=viewport.y2) and
|
||||
(x1>=viewport.x1) and (x1<=viewport.x2) and
|
||||
(x2>=viewport.x1) and (x2<=viewport.x2) and
|
||||
(BytesPerPixel<3);
|
||||
|
||||
if aktlineinfo.thickness=3 then
|
||||
|
||||
{ *************************************** }
|
||||
{ **** Thickness=3 with rangechecking *** }
|
||||
{ *************************************** }
|
||||
|
||||
begin
|
||||
repeat
|
||||
for i:=y1-1 to y1+1 do
|
||||
for j:=x1-1 to x1+1 do
|
||||
if (i>=viewport.y1) and (j>=viewport.x1) and
|
||||
(j<=viewport.x2) and (i<=viewport.y2) then pixel(X_ARRAY[j]+Y_ARRAY[i]);
|
||||
if d < 0
|
||||
then begin
|
||||
if Flag then y1:=y1+1 else x1:=x1+ix;
|
||||
d:=d+i1;
|
||||
end
|
||||
else begin
|
||||
d:=d-i2; x1:=x1+ix; y1:=y1+1;
|
||||
end;
|
||||
dx:=dx-1;
|
||||
until ( dx=0 ) or ( y1 > viewport.y2 )
|
||||
end else
|
||||
if dontcheck then
|
||||
|
||||
{ *************************************** }
|
||||
{ ** Thickness=1 without rangechecking ** }
|
||||
{ *************************************** }
|
||||
|
||||
begin
|
||||
asm
|
||||
pushw %gs
|
||||
movw _SEG_WRITE,%ax
|
||||
movw %ax,%gs // { ScreenSelector }
|
||||
|
||||
// selfmodify to speedup Code
|
||||
xorl %ebx,%ebx
|
||||
movl ix,%eax
|
||||
testl %eax,%eax
|
||||
jns line1_inc
|
||||
movl $0x08,%ebx
|
||||
line1_inc:
|
||||
addl $0x43,%ebx // Opcode incl %ebx
|
||||
movb %bl,inc_dec1
|
||||
movb %bl,inc_dec2
|
||||
movl i1,%eax
|
||||
movl %eax,i1long1
|
||||
movl %eax,i1long2
|
||||
movl i2,%eax
|
||||
movl %eax,i2long
|
||||
movl _WBUFFER,%eax
|
||||
movl %eax,.Lwbuffer
|
||||
movzbl _WINSHIFT,%eax
|
||||
movb %al,.Lwinshift
|
||||
movl _WINLOMASK,%eax
|
||||
movl %eax,.Lwinlomask
|
||||
movb $0x90,operandprefix // Opcade nop
|
||||
testw $1,_AKTWRITEMODE
|
||||
jnz line1XOR
|
||||
movb $0x88,linemode // Opcode movb
|
||||
jmp linedepth
|
||||
line1XOR:
|
||||
movb $0x30,linemode // Opcode xorb
|
||||
linedepth:
|
||||
testw $1,_BYTESPERPIXEL
|
||||
jnz is_byte
|
||||
movb $0x66,operandprefix // Prefix for operandsize
|
||||
incb linemode // incr. for wordacces
|
||||
is_byte:
|
||||
movl dx,%ecx
|
||||
movl _AKTCOLOR,%eax
|
||||
movzwl y1,%esi
|
||||
movzwl x1,%ebx
|
||||
movswl d,%edx
|
||||
//----------------//
|
||||
// Linemainloop //
|
||||
//----------------//
|
||||
.align 4,0x90
|
||||
line1_loop:
|
||||
pushl %ecx
|
||||
pushl %eax
|
||||
movl _Y_ARRAY(,%esi,4),%edi
|
||||
addl _X_ARRAY(,%ebx,4),%edi
|
||||
movl %edi,%eax
|
||||
.byte 0x81,0xe7 // andl ..,%edi
|
||||
.Lwinlomask: //
|
||||
.long 0x88888888 // _WINLOMASK
|
||||
.byte 0xc1,0xe8 // shrl ..,%eax
|
||||
.Lwinshift: //
|
||||
.byte 0x88 // _WINSHIFT
|
||||
|
||||
pushl %edi
|
||||
cmpl _A_BANK,%eax
|
||||
je line1_dontswitch
|
||||
|
||||
pushl %ebx
|
||||
pushl %edx
|
||||
pushl %esi
|
||||
pushl %eax
|
||||
movl _BANKSWITCHPTR,%eax
|
||||
call %eax
|
||||
popl %esi
|
||||
popl %edx
|
||||
popl %ebx
|
||||
.align 4,0x90
|
||||
line1_dontswitch:
|
||||
popl %edi
|
||||
popl %eax
|
||||
popl %ecx
|
||||
.byte 0x81,0xc7 // addl ..,%edi
|
||||
.Lwbuffer: //
|
||||
.long 0x88888888 // _WBUFFER
|
||||
operandprefix:
|
||||
.byte 0x90 // Operandprefix (nop for Byte,$66 for Word)
|
||||
.byte 0x65 // Segmentprefix %gs:
|
||||
linemode:
|
||||
.byte 0x88,0x07 // modified OpCode<movb,xorb...>,%edi
|
||||
decl %ecx
|
||||
jz line1_end
|
||||
testl %edx,%edx // { if d < 0 then }
|
||||
jns is_positive
|
||||
testb $1,flag // { if flag then }
|
||||
jz no_flag
|
||||
incl %esi // { y1:=y1+1 }
|
||||
.byte 0x81,0xc2
|
||||
i1long1:
|
||||
.long 0x88888888 // { d:=d+i1 }
|
||||
jmp line1_loop
|
||||
.align 4,0x90
|
||||
no_flag:
|
||||
inc_dec1:
|
||||
.byte 0x88 // { x1:=x1+ix }
|
||||
.byte 0x81,0xc2
|
||||
i1long2:
|
||||
.long 0x88888888 // { d:=d+i1 }
|
||||
jmp line1_loop
|
||||
.align 4,0x90
|
||||
is_positive:
|
||||
inc_dec2:
|
||||
.byte 0x88 // { x1:=x1+ix }
|
||||
incl %esi // { y1:=y1+1 }
|
||||
.byte 0x81,0xea
|
||||
i2long:
|
||||
.long 0x88888888 // { d:=d-i2 }
|
||||
jmp line1_loop
|
||||
line1_end:
|
||||
popw %gs
|
||||
end;
|
||||
end else
|
||||
|
||||
{ *************************************** }
|
||||
{ **** Thickness=1 with rangechecking *** }
|
||||
{ *************************************** }
|
||||
|
||||
begin
|
||||
repeat
|
||||
if y1 > viewport.y2 then exit;
|
||||
if (y1>=viewport.y1) and (x1>=viewport.x1) and
|
||||
(x1<=viewport.x2) then pixel(Y_ARRAY[y1]+X_ARRAY[x1]);
|
||||
if d < 0
|
||||
then begin
|
||||
if Flag then y1:=y1+1 else x1:=x1+ix;
|
||||
d:=d+i1;
|
||||
end
|
||||
else begin
|
||||
d:=d-i2; x1:=x1+ix; y1:=y1+1;
|
||||
end;
|
||||
dx:=dx-1;
|
||||
until dx=0 ;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MoveTo(x,y : integer);
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
curx:=x;
|
||||
cury:=y;
|
||||
end;
|
||||
|
||||
procedure MoveRel(dx,dy : integer);
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
curx:=curx+dx;
|
||||
cury:=cury+dy;
|
||||
end;
|
||||
|
||||
procedure LineTo(x,y : integer);
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
Line(curx,cury,x,y);
|
||||
MoveTo(x,y);
|
||||
end;
|
||||
|
||||
procedure LineRel(dx,dy : integer);
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
Line(curx,cury,curx+dx,cury+dy);
|
||||
curx:=curx+dx;
|
||||
cury:=cury+dy;
|
||||
end;
|
||||
|
||||
procedure SetLineStyle(LineStyle : word;pattern : word;thickness : word);
|
||||
const
|
||||
linepatterns : array[0..3] of word =
|
||||
($ffff,$aaaa,$fafa,$ffff);
|
||||
|
||||
begin
|
||||
if (linestyle<0) or (linestyle>4) or
|
||||
((thickness<>1) and (thickness<>3)) then
|
||||
begin
|
||||
_graphresult:=grerror;
|
||||
exit;
|
||||
end;
|
||||
aktlineinfo.linestyle:=linestyle;
|
||||
if aktlineinfo.linestyle=UserBitLn then
|
||||
aktlineinfo.pattern:=pattern
|
||||
else
|
||||
aktlineinfo.pattern:=linepatterns[aktlineinfo.linestyle];
|
||||
aktlineinfo.thickness:=thickness;
|
||||
end;
|
||||
|
||||
procedure DrawPoly(points : word;var polypoints);
|
||||
|
||||
type
|
||||
ppointtype = ^pointtype;
|
||||
|
||||
var
|
||||
i : longint;
|
||||
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
line(ppointtype(@polypoints)[points-1].x,
|
||||
ppointtype(@polypoints)[points-1].y,
|
||||
ppointtype(@polypoints)[0].x,
|
||||
ppointtype(@polypoints)[0].y);
|
||||
for i:=0 to points-2 do
|
||||
line(ppointtype(@polypoints)[i].x,
|
||||
ppointtype(@polypoints)[i].y,
|
||||
ppointtype(@polypoints)[i+1].x,
|
||||
ppointtype(@polypoints)[i+1].y);
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:03 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.4 1998/11/18 13:23:35 pierre
|
||||
* floodfill got into an infinite loop !!
|
||||
+ added partial support for fillpoly
|
||||
(still wrong if the polygon is not convex)
|
||||
Simply make a floodfill from the barycenter !
|
||||
* some 24BPP code changed (still does not work for my S3VBE program !)
|
||||
|
||||
Revision 1.3 1998/11/18 09:31:37 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.2 1998/09/02 08:16:00 pierre
|
||||
* local asm labels with global variable names removed !!
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.4 1998/03/03 22:48:43 florian
|
||||
+ graph.drawpoly procedure
|
||||
+ putimage with xorput uses mmx if available
|
||||
|
||||
Revision 1.3 1998/01/26 11:58:18 michael
|
||||
+ Added log at the end
|
||||
|
||||
Working file: rtl/dos/ppi/line.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:31; author: michael; state: Exp; lines: +14 -0
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,98 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
const
|
||||
{$ifndef TEST_24BPP}
|
||||
VESANumber=13;
|
||||
{$else TEST_24BPP}
|
||||
VESANumber=17;
|
||||
{$endif TEST_24BPP}
|
||||
VESAModes : Array[0..VESANumber-1] of word=
|
||||
( $100 { 640x400x256 }
|
||||
,$101 { 640x480x256 }
|
||||
,$110 { 640x480x32K }
|
||||
,$111 { 640x480x64k }
|
||||
,$103 { 800x600x256 }
|
||||
,$113 { 800x600x32k }
|
||||
,$114 { 800x600x64k }
|
||||
,$105 { 1024x768x256 }
|
||||
,$116 { 1024x768x32k }
|
||||
,$117 { 1024x768x64k }
|
||||
,$107 { 1280x1024x256 }
|
||||
,$119 { 1280x1024x32K }
|
||||
,$11A { 1280x1024x64K }
|
||||
{$ifdef TEST_24BPP}
|
||||
,$112 { 640x480x16M }
|
||||
,$115 { 800x600x16M }
|
||||
,$118 { 1024x768x16M }
|
||||
,$11B { 1280x1024x16M }
|
||||
{$endif TEST_24BPP}
|
||||
);
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:04 peter
|
||||
* use -FE
|
||||
|
||||
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
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.5 1998/01/26 11:58:22 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/modes.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.4
|
||||
date: 1997/12/04 08:52:35; author: florian; state: Exp; lines: +14 -13
|
||||
+ vesa mode 1280x1024x256 added
|
||||
----------------------------
|
||||
revision 1.3
|
||||
date: 1997/12/03 15:24:20; author: florian; state: Exp; lines: +2 -2
|
||||
Graph.SetGraphMode for DOS added
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:31; author: michael; state: Exp; lines: +14 -0
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,289 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
procedure MoveLong(selector:word;dst:pointer;cnt:longint);
|
||||
begin
|
||||
asm
|
||||
movw %fs,%dx
|
||||
movw selector,%ax
|
||||
movw %ax,%fs
|
||||
xorl %esi,%esi
|
||||
movl DST,%edi
|
||||
movl CNT,%ecx
|
||||
shrl $0x2,%ecx
|
||||
MOVE1:
|
||||
movl %fs:(%esi,%ecx,4),%eax
|
||||
movl %eax,(%edi,%ecx,4)
|
||||
decl %ecx
|
||||
jns MOVE1
|
||||
movw %dx,%fs
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ScreenToMem(Source,Target,Counter:longint);
|
||||
begin
|
||||
asm
|
||||
pushw %ds
|
||||
movl counter,%ecx
|
||||
movl %ecx,%ebx
|
||||
shrl $0x2,%ecx
|
||||
andl $0x3,%ebx
|
||||
movl target,%edi
|
||||
movl source,%esi
|
||||
addl _WBUFFER,%esi
|
||||
movw _SEG_WRITE,%ax
|
||||
movw %ax,%ds
|
||||
rep
|
||||
movsl
|
||||
movl %ebx,%ecx
|
||||
rep
|
||||
movsb
|
||||
popw %ds
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MemToScreen(Source,Target,Counter:longint);
|
||||
begin
|
||||
asm
|
||||
movw %es,%dx
|
||||
movl counter,%ecx
|
||||
movl %ecx,%ebx
|
||||
shrl $0x2,%ecx
|
||||
andl $0x3,%ebx
|
||||
movl target,%edi
|
||||
movl source,%esi
|
||||
addl _WBUFFER,%edi
|
||||
movw _SEG_WRITE,%ax
|
||||
movw %ax,%es
|
||||
rep
|
||||
movsl
|
||||
movl %ebx,%ecx
|
||||
rep
|
||||
movsb
|
||||
movw %dx,%es
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MemAndScreen(Source,Target,Counter:longint);
|
||||
begin
|
||||
asm
|
||||
pushw %es
|
||||
movl counter,%ecx
|
||||
movl %ecx,%ebx
|
||||
shrl $0x2,%ecx
|
||||
andl $0x3,%ebx
|
||||
movl target,%edi
|
||||
movl source,%esi
|
||||
movl $4,%edx
|
||||
addl _WBUFFER,%edi
|
||||
movw _SEG_WRITE,%ax
|
||||
movw %ax,%es
|
||||
mas_lloop:
|
||||
movl (%esi),%eax
|
||||
andl %eax,%es:(%edi)
|
||||
addl %edx,%edi
|
||||
addl %edx,%esi
|
||||
decl %ecx
|
||||
jnz mas_lloop
|
||||
orl %ebx,%ecx
|
||||
jz mas_end
|
||||
mas_bloop:
|
||||
movb (%esi),%al
|
||||
andb %al,%es:(%edi)
|
||||
incl %esi
|
||||
incl %edi
|
||||
decl %ecx
|
||||
jnz mas_bloop
|
||||
mas_end:
|
||||
popw %es
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MemOrScreen(Source,Target,Counter:longint);
|
||||
begin
|
||||
asm
|
||||
pushw %es
|
||||
movl counter,%ecx
|
||||
movl %ecx,%ebx
|
||||
shrl $0x2,%ecx
|
||||
andl $0x3,%ebx
|
||||
movl target,%edi
|
||||
movl source,%esi
|
||||
addl _WBUFFER,%edi
|
||||
movw _SEG_WRITE,%ax
|
||||
movw %ax,%es
|
||||
mos_lloop:
|
||||
movl (%esi),%eax
|
||||
orl %eax,%es:(%edi)
|
||||
addl $4,%edi
|
||||
addl $4,%esi
|
||||
decl %ecx
|
||||
jnz mos_lloop
|
||||
orl %ebx,%ecx
|
||||
jz mos_end
|
||||
mos_bloop:
|
||||
movb (%esi),%al
|
||||
orb %al,%es:(%edi)
|
||||
incl %esi
|
||||
incl %edi
|
||||
decl %ecx
|
||||
jnz mos_bloop
|
||||
mos_end:
|
||||
popw %es
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MemXorScreen(Source,Target,Counter:longint);
|
||||
begin
|
||||
if is_mmx_cpu and (counter>50) then
|
||||
asm
|
||||
movw %es,%dx
|
||||
movl counter,%ecx
|
||||
movl %ecx,%ebx
|
||||
shrl $0x3,%ecx
|
||||
andl $0x7,%ebx
|
||||
movl target,%edi
|
||||
movl source,%esi
|
||||
addl _WBUFFER,%edi
|
||||
movw _SEG_WRITE,%ax
|
||||
movw %ax,%es
|
||||
jecxz mmxmxs_b
|
||||
mmxmxs_lloop:
|
||||
movq (%esi),%mm0
|
||||
addl $8,%esi
|
||||
pxor %es:(%edi),%mm0
|
||||
movq %mm0,%es:(%edi)
|
||||
addl $8,%edi
|
||||
decl %ecx
|
||||
jnz mmxmxs_lloop
|
||||
mmxmxs_b:
|
||||
orl %ebx,%ecx
|
||||
jz mmxmxs_end
|
||||
mmxmxs_bloop:
|
||||
movb (%esi),%al
|
||||
xorb %al,%es:(%edi)
|
||||
incl %esi
|
||||
incl %edi
|
||||
decl %ecx
|
||||
jnz mmxmxs_bloop
|
||||
mmxmxs_end:
|
||||
movw %dx,%es
|
||||
end
|
||||
else
|
||||
asm
|
||||
movw %es,%dx
|
||||
movl counter,%ecx
|
||||
movl %ecx,%ebx
|
||||
shrl $0x2,%ecx
|
||||
andl $0x3,%ebx
|
||||
movl target,%edi
|
||||
movl source,%esi
|
||||
addl _WBUFFER,%edi
|
||||
movw _SEG_WRITE,%ax
|
||||
movw %ax,%es
|
||||
jecxz mxs_b
|
||||
mxs_lloop:
|
||||
movl (%esi),%eax
|
||||
xorl %eax,%es:(%edi)
|
||||
addl $4,%edi
|
||||
addl $4,%esi
|
||||
decl %ecx
|
||||
jnz mxs_lloop
|
||||
mxs_b:
|
||||
orl %ebx,%ecx
|
||||
jz mxs_end
|
||||
mxs_bloop:
|
||||
movb (%esi),%al
|
||||
xorb %al,%es:(%edi)
|
||||
incl %esi
|
||||
incl %edi
|
||||
decl %ecx
|
||||
jnz mxs_bloop
|
||||
mxs_end:
|
||||
movw %dx,%es
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MemNotScreen(Source,Target,Counter:longint);
|
||||
begin
|
||||
asm
|
||||
pushw %es
|
||||
movl counter,%ecx
|
||||
movl %ecx,%ebx
|
||||
shrl $0x2,%ecx
|
||||
andl $0x3,%ebx
|
||||
movl target,%edi
|
||||
movl source,%esi
|
||||
addl _WBUFFER,%edi
|
||||
movw _SEG_WRITE,%ax
|
||||
movw %ax,%es
|
||||
jecxz mns_b
|
||||
mns_lloop:
|
||||
movl (%esi),%eax
|
||||
notl %eax
|
||||
movl %eax,%es:(%edi)
|
||||
addl $4,%edi
|
||||
addl $4,%esi
|
||||
decl %ecx
|
||||
jnz mns_lloop
|
||||
mns_b:
|
||||
orl %ebx,%ecx
|
||||
jz mns_end
|
||||
mns_bloop:
|
||||
movb (%esi),%al
|
||||
notb %al
|
||||
movb %al,%es:(%edi)
|
||||
incl %esi
|
||||
incl %edi
|
||||
decl %ecx
|
||||
jnz mns_bloop
|
||||
mns_end:
|
||||
popw %es
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:04 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.4 1998/03/03 22:48:43 florian
|
||||
+ graph.drawpoly procedure
|
||||
+ putimage with xorput uses mmx if available
|
||||
|
||||
Revision 1.3 1998/01/26 11:58:25 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/move.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:32; author: michael; state: Exp; lines: +14 -0
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,160 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{ GetRGBPalette,SetRGBPalette,SetAllPalette,GetPalette }
|
||||
|
||||
{ Bei saemtlichen Palettefunktionen nicht auf Grafikmodus testen }
|
||||
{ funktionieren auch im TextModus }
|
||||
|
||||
procedure SetAllPalette(var Palette:PaletteType);
|
||||
begin
|
||||
asm
|
||||
movl Palette,%esi
|
||||
movl $767,%ecx
|
||||
xorl %eax,%eax
|
||||
movl $2,%ebx
|
||||
movw $0x03c8,%dx
|
||||
outb %al,%dx
|
||||
incw %dx
|
||||
sp_loop:
|
||||
movb (%esi,%ebx,1),%al
|
||||
shrb $2,%al
|
||||
outb %al,%dx
|
||||
incl %ebx
|
||||
decl %ecx
|
||||
jnz sp_loop
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetRGBPalette(ColorNum,RedValue,GreenValue,BlueValue:byte);
|
||||
begin
|
||||
asm
|
||||
movw $0x3c8,%DX
|
||||
movb ColorNum,%al
|
||||
outb %AL,%DX
|
||||
incw %DX
|
||||
movb RedValue,%al
|
||||
shrb $2,%al
|
||||
outb %AL,%DX
|
||||
movb GreenValue,%al
|
||||
shrb $2,%al
|
||||
outb %AL,%DX
|
||||
movb BlueValue,%al
|
||||
shrb $2,%al
|
||||
outb %AL,%DX
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GetRGBPalette(ColorNum:byte; var RedValue,GreenValue,BlueValue:byte);
|
||||
begin
|
||||
asm
|
||||
movw $0x3c7,%DX
|
||||
movb ColorNum,%ax
|
||||
outb %AL,%DX
|
||||
addw $2,%DX
|
||||
xorl %eax,%eax
|
||||
inb %DX,%AL
|
||||
shlb $2,%al
|
||||
movb %al,RedValue
|
||||
inb %DX,%AL
|
||||
shlb $2,%al
|
||||
movb %al,GreenValue
|
||||
inb %DX,%AL
|
||||
shlb $2,%al
|
||||
movb %al,BlueValue
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Getpalette(var Palette:PaletteType);
|
||||
begin
|
||||
asm
|
||||
movl palette,%edi
|
||||
movw $0,(%edi)
|
||||
cmpl $2,_BYTESPERPIXEL
|
||||
jge gp_end
|
||||
movw $0x100,(%edi)
|
||||
movl $767,%ecx
|
||||
xorl %eax,%eax
|
||||
movl $2,%ebx
|
||||
movl $0x03c7,%dx
|
||||
outb %al,%dx
|
||||
addw $2,%dx
|
||||
gp_loop:
|
||||
inb %dx,%al
|
||||
shlb $2,%al
|
||||
movb %al,(%edi,%ebx,1)
|
||||
incl %ebx
|
||||
decl %ecx
|
||||
jnz gp_loop
|
||||
gp_end:
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetPalette(ColorNum:word;Color:byte);
|
||||
|
||||
begin
|
||||
SetRGBPalette(ColorNum,(StdColors[Color] shr 16) and $FF,
|
||||
(StdColors[Color] shr 8) and $FF,StdColors[Color] and $FF);
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:04 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.4 1998/11/19 09:48:51 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
|
||||
is outside !!)
|
||||
* fixed a bug in floodfill for patterns
|
||||
(still has problems !!)
|
||||
|
||||
Revision 1.3 1998/11/18 09:31:39 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.2 1998/07/18 21:29:59 carl
|
||||
* bugfix of palette setting with wrong asm counter
|
||||
(from Ingemar Ragnemalm)
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:58:29 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/palette.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:32; author: michael; state: Exp; lines: +13 -1
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,338 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{ internal put pixel with colour in internal format }
|
||||
procedure putpixeli(x,y:integer;colour:longint);
|
||||
var viewport:viewporttype;
|
||||
begin
|
||||
if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
|
||||
asm
|
||||
xorl %eax,%eax
|
||||
movl %eax,%ebx
|
||||
movw x,%bx
|
||||
movw y,%ax
|
||||
addw _AKTVIEWPORT,%bx
|
||||
addw _AKTVIEWPORT+2,%ax
|
||||
(* cmpw viewport,%bx
|
||||
jl p_exit // wenn x < x1 Ende
|
||||
cmpw -8(%ebp),%bx
|
||||
jg p_exit // wenn x > x2 Ende
|
||||
cmpw -10(%ebp),%ax
|
||||
jl p_exit // wenn y < y1 Ende
|
||||
cmpw -6(%ebp),%ax
|
||||
jg p_exit // wenn y > y2 Ende
|
||||
assumes wrong placement of viewport !!! PM *)
|
||||
lea viewport,%edx
|
||||
cmpw (%edx),%bx
|
||||
jl p_exit // wenn x < x1 Ende
|
||||
cmpw 4(%edx),%bx
|
||||
jg p_exit // wenn x > x2 Ende
|
||||
cmpw 2(%edx),%ax
|
||||
jl p_exit // wenn y < y1 Ende
|
||||
cmpw 6(%edx),%ax
|
||||
jg p_exit // wenn y > y2 Ende
|
||||
movl _Y_ARRAY(,%eax,4),%eax
|
||||
addl _X_ARRAY(,%ebx,4),%eax
|
||||
movl %eax,%esi
|
||||
movzbl _WINSHIFT,%ecx // { offset / winsize }
|
||||
shrl %cl,%eax //
|
||||
cmpl _A_BANK,%eax // { same bank ? }
|
||||
je p_dont_switch // { yep }
|
||||
pushl %esi
|
||||
pushl %eax //
|
||||
movl _BANKSWITCHPTR,%eax // { switchbank }
|
||||
call %eax //
|
||||
popl %esi
|
||||
p_dont_switch:
|
||||
andl _WINLOMASK,%esi
|
||||
movl colour,%eax
|
||||
addl _WBUFFER,%esi
|
||||
movw _SEG_WRITE,%bx
|
||||
movw _BYTESPERPIXEL,%cx
|
||||
movw %bx,%gs
|
||||
cmpl $2,%ecx
|
||||
je pp_16BPP
|
||||
jb pp_8BPP
|
||||
{$ifdef TEST_24BPP}
|
||||
cmpl $3,%ecx
|
||||
je pp_24BPP
|
||||
pp_32BPP:
|
||||
movl %eax,%gs:(%esi)
|
||||
jmp pp_exit
|
||||
pp_24BPP:
|
||||
movl _WINLOMASKMINUSPIXELSIZE,%edi
|
||||
cmpl %edi,%esi
|
||||
ja pp_exit
|
||||
movl %gs:(%esi),%edi
|
||||
andl $0xFF000000,%edi
|
||||
andl $0x00FFFFFF,%eax
|
||||
orl %edi,%eax
|
||||
movl %eax,%gs:(%esi)
|
||||
jmp pp_exit
|
||||
{$endif TEST_24BPP}
|
||||
pp_8BPP:
|
||||
movb %al,%gs:(%esi)
|
||||
jmp pp_exit
|
||||
pp_16BPP:
|
||||
movw %ax,%gs:(%esi)
|
||||
pp_exit:
|
||||
(* movw %dx,%ds use %gs now
|
||||
does not need to be kept constant PM *)
|
||||
p_exit:
|
||||
end;
|
||||
end; { proc }
|
||||
|
||||
procedure putpixel(x,y:integer;colour:longint);
|
||||
begin
|
||||
colour:=convert(colour);
|
||||
putpixeli(x,y,colour);
|
||||
end;
|
||||
|
||||
procedure pixel(offset:longint);
|
||||
{ wird nur intern aufgerufen, umrechnung auf Viewport und Range- }
|
||||
{ checking muessen von aufrufender Routine bereits erledigt sein }
|
||||
{ Bankswitching wird durchgefuehrt }
|
||||
begin
|
||||
asm
|
||||
movl offset,%eax
|
||||
movl %eax,%esi
|
||||
movzbl _WINSHIFT,%ecx // { offset / winsize }
|
||||
shrl %cl,%eax //
|
||||
cmpl _A_BANK,%eax // { same bank ? }
|
||||
je dont_switch // { yep }
|
||||
pushl %esi
|
||||
pushl %eax //
|
||||
movl _BANKSWITCHPTR,%eax // { switchbank }
|
||||
call %eax //
|
||||
popl %esi
|
||||
dont_switch:
|
||||
movl _WINLOMASK,%eax
|
||||
andl %eax,%esi
|
||||
movl _AKTCOLOR,%eax
|
||||
movzwl _AKTWRITEMODE,%ecx
|
||||
movw _BYTESPERPIXEL,%bx
|
||||
addl _WBUFFER,%esi
|
||||
movw _SEG_WRITE,%dx
|
||||
movw %dx,%gs
|
||||
testl %ecx,%ecx
|
||||
jz dmove
|
||||
cmpl $2,%ebx
|
||||
je dxor16BPP
|
||||
jb dxor8BPP
|
||||
{$ifdef TEST_24BPP}
|
||||
cmpl $3,%ebx
|
||||
je dxor24BPP
|
||||
dxor32BPP:
|
||||
movl %gs:(%esi),%edx
|
||||
xorl %edx,%eax
|
||||
movl %eax,%gs:(%esi)
|
||||
jmp pd_exit
|
||||
dxor24BPP:
|
||||
movl _WINLOMASKMINUSPIXELSIZE,%ecx
|
||||
cmpl %ecx,%esi
|
||||
ja pd_exit
|
||||
movl %gs:(%esi),%edx
|
||||
andl $0x00FFFFFF,%eax
|
||||
xorl %edx,%eax
|
||||
movl %eax,%gs:(%esi)
|
||||
jmp pd_exit
|
||||
{$endif TEST_24BPP}
|
||||
dxor8BPP:
|
||||
xorb %al,%gs:(%esi)
|
||||
jmp pd_exit
|
||||
dxor16BPP:
|
||||
xorw %ax,%gs:(%esi)
|
||||
jmp pd_exit
|
||||
dmove:
|
||||
cmpl $2,%ebx
|
||||
je dmove16BPP
|
||||
jb dmove8BPP
|
||||
{$ifdef TEST_24BPP}
|
||||
cmpl $3,%ebx
|
||||
je dmove24BPP
|
||||
dmove32BPP:
|
||||
movl %eax,%gs:(%esi)
|
||||
jmp pd_exit
|
||||
dmove24BPP:
|
||||
movl _WINLOMASKMINUSPIXELSIZE,%ecx
|
||||
cmpl %ecx,%esi
|
||||
ja pd_exit
|
||||
movl %gs:(%esi),%edx
|
||||
andl $0xFF000000,%edx
|
||||
andl $0x00FFFFFF,%eax
|
||||
orl %edx,%eax
|
||||
movl %eax,%gs:(%esi)
|
||||
jmp pd_exit
|
||||
{$endif TEST_24BPP}
|
||||
dmove8BPP:
|
||||
movb %al,%gs:(%esi)
|
||||
jmp pd_exit
|
||||
dmove16BPP:
|
||||
movw %ax,%gs:(%esi)
|
||||
pd_exit:
|
||||
end;
|
||||
end; { proc }
|
||||
|
||||
function getpixeli(x,y:integer):longint;
|
||||
var viewport:viewporttype;
|
||||
col : longint;
|
||||
begin
|
||||
if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
|
||||
asm
|
||||
movswl x,%ebx
|
||||
movswl y,%eax
|
||||
addw _AKTVIEWPORT,%bx
|
||||
addw _AKTVIEWPORT+2,%ax
|
||||
(* cmpw viewport,%bx
|
||||
jl gp_exit // wenn x < x1 Ende
|
||||
cmpw -8(%ebp),%bx
|
||||
jg gp_exit // wenn x > x2 Ende
|
||||
cmpw -10(%ebp),%ax
|
||||
jl gp_exit // wenn y < y1 Ende
|
||||
cmpw -6(%ebp),%ax
|
||||
jg gp_exit // wenn y > y2 Ende
|
||||
same error : viewport is assumed to be at -12
|
||||
that depends on alignment settings !! PM *)
|
||||
lea viewport,%edx
|
||||
cmpw (%edx),%bx
|
||||
jl gp_eexit // wenn x < x1 Ende
|
||||
cmpw 4(%edx),%bx
|
||||
jg gp_eexit // wenn x > x2 Ende
|
||||
cmpw 2(%edx),%ax
|
||||
jl gp_eexit // wenn y < y1 Ende
|
||||
cmpw 6(%edx),%ax
|
||||
jg gp_eexit // wenn y > y2 Ende
|
||||
movl _Y_ARRAY(,%eax,4),%eax
|
||||
addl _X_ARRAY(,%ebx,4),%eax
|
||||
movl %eax,%esi
|
||||
movzbl _WINSHIFT,%ecx // { offset / winsize }
|
||||
shrl %cl,%eax //
|
||||
cmpl _A_BANK,%eax // { same bank ? }
|
||||
je g_dont_switch // { yep }
|
||||
pushl %esi // { save Offset }
|
||||
pushl %eax //
|
||||
movl _BANKSWITCHPTR,%eax // { switchbank }
|
||||
call %eax //
|
||||
popl %esi // { restore Offset }
|
||||
g_dont_switch:
|
||||
movl _WINLOMASK,%eax
|
||||
andl %eax,%esi
|
||||
xorl %eax,%eax
|
||||
movzwl _BYTESPERPIXEL,%edx
|
||||
addl _WBUFFER,%esi
|
||||
movw _SEG_READ,%bx
|
||||
movw %bx,%gs
|
||||
cmpl $2,%edx // { 1 or 2 BytesPerPixel ? }
|
||||
je g_16BPP
|
||||
jb g_8BPP
|
||||
{$ifdef TEST_24BPP}
|
||||
cmpl $3,%edx // { 1 or 2 BytesPerPixel ? }
|
||||
je g_24BPP
|
||||
g_32BPP:
|
||||
movl %gs:(%esi),%eax
|
||||
andl $0x00FFFFFF,%eax
|
||||
jmp g_Result
|
||||
g_24BPP:
|
||||
movl _WINLOMASKMINUSPIXELSIZE,%edi
|
||||
cmpl %edi,%esi
|
||||
ja g_ErrorResult
|
||||
movl %gs:(%esi),%eax
|
||||
andl $0x00FFFFFF,%eax
|
||||
jmp g_Result
|
||||
g_ErrorResult:
|
||||
movl $-3,%edi
|
||||
addl _WINLOMASK,%edi
|
||||
cmpl %edi,%esi
|
||||
ja g_nohope
|
||||
decl %esi
|
||||
movl %gs:(%esi),%eax
|
||||
shrl $8,%eax
|
||||
jmp g_Result
|
||||
g_nohope:
|
||||
movl $0xABCDEF,%eax
|
||||
jmp g_Result
|
||||
{$endif TEST_24BPP}
|
||||
g_16BPP:
|
||||
movzwl %gs:(%esi),%eax
|
||||
jmp g_Result
|
||||
g_8BPP:
|
||||
movzbl %gs:(%esi),%eax
|
||||
jmp g_Result
|
||||
gp_eexit:
|
||||
xorl %eax,%eax
|
||||
jmp gp_exit
|
||||
g_Result:
|
||||
gp_exit:
|
||||
movl %eax,col
|
||||
end;
|
||||
getpixeli:=col;
|
||||
end; { proc getpixeli }
|
||||
|
||||
function getpixel(x,y:integer):longint;
|
||||
begin
|
||||
getpixel:=unconvert(getpixeli(x,y));
|
||||
end; { proc }
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:04 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.5 1998/11/20 18:42:09 pierre
|
||||
* many bugs related to floodfill and ellipse fixed
|
||||
|
||||
Revision 1.4 1998/11/18 13:23:36 pierre
|
||||
* floodfill got into an infinite loop !!
|
||||
+ added partial support for fillpoly
|
||||
(still wrong if the polygon is not convex)
|
||||
Simply make a floodfill from the barycenter !
|
||||
* some 24BPP code changed (still does not work for my S3VBE program !)
|
||||
|
||||
Revision 1.3 1998/11/18 09:31:40 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.2 1998/10/22 08:22:06 pierre
|
||||
* mandel problem fixed !!
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:58:33 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/pixel.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:32; author: michael; state: Exp; lines: +13 -1
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,119 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
const stdColors:array[0..255]of longint=
|
||||
(
|
||||
$00000000,$010000A8,$0200A800,$0300A8A8,
|
||||
$04A80000,$05A800A8,$06A85400,$07A8A8A8,
|
||||
$08545454,$095454FC,$0A54FC54,$0B54FCFC,
|
||||
$0CFC5454,$0DFC54FC,$0EFCFC54,$0FFCFCFC,
|
||||
$10000000,$11141414,$12202020,$132C2C2C,
|
||||
$14383838,$15444444,$16505050,$17606060,
|
||||
$18707070,$19808080,$1A909090,$1BA0A0A0,
|
||||
$1CB4B4B4,$1DC8C8C8,$1EE0E0E0,$1FFCFCFC,
|
||||
$200000FC,$214000FC,$227C00FC,$23BC00FC,
|
||||
$24FC00FC,$25FC00BC,$26FC007C,$27FC0040,
|
||||
$28FC0000,$29FC4000,$2AFC7C00,$2BFCBC00,
|
||||
$2CFCFC00,$2DBCFC00,$2E7CFC00,$2F40FC00,
|
||||
$3000FC00,$3100FC40,$3200FC7C,$3300FCBC,
|
||||
$3400FCFC,$3500BCFC,$36007CFC,$370040FC,
|
||||
$387C7CFC,$399C7CFC,$3ABC7CFC,$3BDC7CFC,
|
||||
$3CFC7CFC,$3DFC7CDC,$3EFC7CBC,$3FFC7C9C,
|
||||
$40FC7C7C,$41FC9C7C,$42FCBC7C,$43FCDC7C,
|
||||
$44FCFC7C,$45DCFC7C,$46BCFC7C,$479CFC7C,
|
||||
$487CFC7C,$497CFC9C,$4A7CFCBC,$4B7CFCDC,
|
||||
$4C7CFCFC,$4D7CDCFC,$4E7CBCFC,$4F7C9CFC,
|
||||
$50B4B4FC,$51C4B4FC,$52D8B4FC,$53E8B4FC,
|
||||
$54FCB4FC,$55FCB4E8,$56FCB4D8,$57FCB4C4,
|
||||
$58FCB4B4,$59FCC4B4,$5AFCD8B4,$5BFCE8B4,
|
||||
$5CFCFCB4,$5DE8FCB4,$5ED8FCB4,$5FC4FCB4,
|
||||
$60B4FCB4,$61B4FCC4,$62B4FCD8,$63B4FCE8,
|
||||
$64B4FCFC,$65B4E8FC,$66B4D8FC,$67B4C4FC,
|
||||
$68000070,$691C0070,$6A380070,$6B540070,
|
||||
$6C700070,$6D700054,$6E700038,$6F70001C,
|
||||
$70700000,$71701C00,$72703800,$73705400,
|
||||
$74707000,$75547000,$76387000,$771C7000,
|
||||
$78007000,$7900701C,$7A007038,$7B007054,
|
||||
$7C007070,$7D005470,$7E003870,$7F001C70,
|
||||
$80383870,$81443870,$82543870,$83603870,
|
||||
$84703870,$85703860,$86703854,$87703844,
|
||||
$88703838,$89704438,$8A705438,$8B706038,
|
||||
$8C707038,$8D607038,$8E547038,$8F447038,
|
||||
$90387038,$91387044,$92387054,$93387060,
|
||||
$94387070,$95386070,$96385470,$97384470,
|
||||
$98505070,$99585070,$9A605070,$9B685070,
|
||||
$9C705070,$9D705068,$9E705060,$9F705058,
|
||||
$A0705050,$A1705850,$A2706050,$A3706850,
|
||||
$A4707050,$A5687050,$A6607050,$A7587050,
|
||||
$A8507050,$A9507058,$AA507060,$AB507068,
|
||||
$AC507070,$AD506870,$AE506070,$AF505870,
|
||||
$B0000040,$B1100040,$B2200040,$B3300040,
|
||||
$B4400040,$B5400030,$B6400020,$B7400010,
|
||||
$B8400000,$B9401000,$BA402000,$BB403000,
|
||||
$BC404000,$BD304000,$BE204000,$BF104000,
|
||||
$C0004000,$C1004010,$C2004020,$C3004030,
|
||||
$C4004040,$C5003040,$C6002040,$C7001040,
|
||||
$C8202040,$C9282040,$CA302040,$CB382040,
|
||||
$CC402040,$CD402038,$CE402030,$CF402028,
|
||||
$D0402020,$D1402820,$D2403020,$D3403820,
|
||||
$D4404020,$D5384020,$D6304020,$D7284020,
|
||||
$D8204020,$D9204028,$DA204030,$DB204038,
|
||||
$DC204040,$DD203840,$DE203040,$DF202840,
|
||||
$E02C2C40,$E1302C40,$E2342C40,$E33C2C40,
|
||||
$E4402C40,$E5402C3C,$E6402C34,$E7402C30,
|
||||
$E8402C2C,$E940302C,$EA40342C,$EB403C2C,
|
||||
$EC40402C,$ED3C402C,$EE34402C,$EF30402C,
|
||||
$F02C402C,$F12C4030,$F22C4034,$F32C403C,
|
||||
$F42C4040,$F52C3C40,$F62C3440,$F72C3040,
|
||||
$F8000000,$F9000000,$FA000000,$FB000000,
|
||||
$FC000000,$FD000000,$FE000000,$FF000000
|
||||
);
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:04 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.2 1998/11/18 09:31:41 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:58:38 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/stdcolor.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:33; author: michael; state: Exp; lines: +13 -0
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,528 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{***************************************************************************}
|
||||
{ Textausgabe }
|
||||
{***************************************************************************}
|
||||
|
||||
const
|
||||
{ maximal 16 Vektorfonts unterst<73>tzen }
|
||||
{ um mehr Fonts laden zu k”nnen, muá }
|
||||
{ diese Variable erh”ht werden }
|
||||
maxfonts = 16;
|
||||
fontdivs:array[0..maxfonts]of integer=
|
||||
(1,4,3,4,4,4,4,4,4,3,3,1,1,1,1,1,1);
|
||||
|
||||
type
|
||||
pbyte = ^byte;
|
||||
|
||||
{$PACKRECORDS 1}
|
||||
pfontdata = ^tfontdata;
|
||||
|
||||
tfontdata = record
|
||||
filetyp : char;
|
||||
nr_chars : word;
|
||||
undefined1 : byte;
|
||||
value_first_char : byte;
|
||||
undefined2 : array[1..3] of byte;
|
||||
dist_origin_top : shortint;
|
||||
dist_origin_baseline : shortint;
|
||||
dist_origin_bottom : shortint;
|
||||
undefined3 : array[1..5] of byte;
|
||||
end;
|
||||
|
||||
{$PACKRECORDS NORMAL}
|
||||
|
||||
tfontrec = record
|
||||
name : string[8];
|
||||
data : pointer;
|
||||
header : pfontdata;
|
||||
offsets : pword;
|
||||
widths : pbyte;
|
||||
instr : pbyte;
|
||||
end;
|
||||
|
||||
var
|
||||
fonts : array[1..maxfonts] of tfontrec;
|
||||
installedfonts : longint;
|
||||
|
||||
{$I FONT.PPI}
|
||||
|
||||
{ gibt true zur<75>ck, wenn p auf eine g<>ltige Fontdatei zeigt }
|
||||
|
||||
function testfont(p : pointer) : boolean;
|
||||
|
||||
begin
|
||||
testfont:=(pchar(p)^='P') and
|
||||
(pchar(p+1)^='K') and
|
||||
(pchar(p+2)^=#8) and
|
||||
(pchar(p+3)^=#8);
|
||||
end;
|
||||
|
||||
{ setzt die Hilfsdaten f<>r den Font mit der Nr. font }
|
||||
{ der Zeiger data muá schon gesetzt sein }
|
||||
|
||||
function setupfont(font : word) : integer;
|
||||
|
||||
begin
|
||||
setupfont:=grOK;
|
||||
fonts[font].header:=fonts[font].data+$80;
|
||||
if fonts[font].header^.filetyp<>'+' then
|
||||
begin
|
||||
setupfont:=grInvalidFont;
|
||||
exit;
|
||||
end;
|
||||
fonts[font].offsets:=fonts[font].data+$90;
|
||||
fonts[font].widths:=pbyte(fonts[font].offsets+fonts[font].header^.nr_chars*2);
|
||||
fonts[font].instr:=fonts[font].widths+fonts[font].header^.nr_chars;
|
||||
end;
|
||||
|
||||
function InstallUserFont(const FontFileName : string) : integer;
|
||||
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
{ es muá kein Graphikmodus gesetzt sein! }
|
||||
{ ist noch Platz f<>r einen Font ? }
|
||||
if installedfonts=maxfonts then
|
||||
begin
|
||||
_graphresult:=grError;
|
||||
exit;
|
||||
end;
|
||||
inc(installedfonts);
|
||||
fonts[installedfonts].name:=FontFileName;
|
||||
fonts[installedfonts].data:=nil;
|
||||
InstallUserFont:=installedfonts;
|
||||
end;
|
||||
|
||||
function RegisterBGIfont(font : pointer) : integer;
|
||||
|
||||
var
|
||||
hp : pbyte;
|
||||
b : word;
|
||||
name : string[12];
|
||||
|
||||
begin
|
||||
{ noch nicht garantiert, daá alles klappt }
|
||||
RegisterBGIfont:=grInvalidFontNum;
|
||||
{ es muá kein Graphikmodus gesetzt sein! }
|
||||
if testfont(font) then
|
||||
begin
|
||||
hp:=pbyte(font);
|
||||
{ Ende des Textheaders suchen }
|
||||
while hp^<>$1a do
|
||||
hp:=hp+1;
|
||||
{ auf Start des Names springen }
|
||||
hp:=hp+3;
|
||||
{ Namen lesen }
|
||||
name:='';
|
||||
for b:=0 to 3 do
|
||||
name:=name+char((hp+b)^);
|
||||
{ richtigen Font suchen }
|
||||
for b:=1 to installedfonts do
|
||||
begin
|
||||
if fonts[b].name=name then
|
||||
begin
|
||||
fonts[b].data:=font;
|
||||
RegisterBGIfont:=grOK;
|
||||
RegisterBGIfont:=setupfont(b);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
RegisterBGIFont:=grInvalidFont;
|
||||
end;
|
||||
|
||||
procedure GetTextSettings(var TextInfo : TextSettingsType);
|
||||
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
textinfo:=akttextinfo;
|
||||
end;
|
||||
|
||||
procedure OutText(const TextString : string);
|
||||
var x,y:integer;
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
x:=curx; y:=cury;
|
||||
OutTextXY(curx,cury,TextString);
|
||||
{ wenn horizontal und linksb<73>ndig ausgegeben wird, dann }
|
||||
{ Grafikcursor nachf<68>hren }
|
||||
if (akttextinfo.direction=HorizDir) and
|
||||
(akttextinfo.horiz=LeftText) then
|
||||
inc(x,textwidth(TextString));
|
||||
curx:=x; cury:=y; { LineTo manipuliert den GrafikCursor !! }
|
||||
end;
|
||||
|
||||
procedure outtext(const charakter : char);
|
||||
var s:string;
|
||||
x,y:integer;
|
||||
begin
|
||||
s:=charakter;
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
x:=curx; y:=cury;
|
||||
OutTextXY(curx,cury,s);
|
||||
{ wenn horizontal und linksb<73>ndig ausgegeben wird, dann }
|
||||
{ Grafikcursor nachf<68>hren }
|
||||
{ if (akttextinfo.direction=HorizDir) and
|
||||
(akttextinfo.horiz=LeftText) then }
|
||||
inc(x,textwidth(s));
|
||||
curx:=x; cury:=y; { LineTo manipuliert den GrafikCursor !! }
|
||||
end;
|
||||
|
||||
procedure OutTextXY(x,y : integer;const TextString : string);
|
||||
|
||||
var
|
||||
b1,b2 : shortint;
|
||||
c,instr,mask : byte;
|
||||
i,j,jj,k,l : longint;
|
||||
oldvalues : linesettingstype;
|
||||
nextpos : word;
|
||||
xpos,ypos,offs: longint;
|
||||
FontPtr : Pointer;
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ wirkliche x- und y-Startposition berechnen }
|
||||
if akttextinfo.direction=horizdir then
|
||||
begin
|
||||
case akttextinfo.horiz of
|
||||
centertext : XPos:=(textwidth(textstring) shr 1);
|
||||
lefttext : XPos:=0;
|
||||
righttext : XPos:=textwidth(textstring);
|
||||
end;
|
||||
case akttextinfo.vert of
|
||||
centertext : YPos:=(textheight(textstring) shr 1);
|
||||
bottomtext : YPos:=0;
|
||||
toptext : YPos:=textheight(textstring);
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
case akttextinfo.horiz of
|
||||
centertext : XPos:=(textheight(textstring) shr 1);
|
||||
lefttext : XPos:=0;
|
||||
righttext : XPos:=textheight(textstring);
|
||||
end;
|
||||
case akttextinfo.vert of
|
||||
centertext : YPos:=(textwidth(textstring) shr 1);
|
||||
bottomtext : YPos:=0;
|
||||
toptext : YPos:=textwidth(textstring);
|
||||
end;
|
||||
end;
|
||||
X:=X-XPos;
|
||||
Y:=Y+YPos;
|
||||
XPos:=X; YPos:=Y;
|
||||
|
||||
if akttextinfo.font=DefaultFont then begin
|
||||
if akttextinfo.direction=horizdir then
|
||||
ypos:=ypos-6*akttextinfo.charsize
|
||||
{else
|
||||
xpos:=xpos-6*akttextinfo.charsize};
|
||||
(* c:=textwidth(textstring) div 8 - 1; { Charcounter }
|
||||
gave wrong values if charsize<>1 PM *)
|
||||
c:=length(textstring); { Charcounter }
|
||||
FontPtr:=@defaultfontdata;
|
||||
|
||||
for i:=1 to c do begin
|
||||
offs:=ord(textString[i]) shl 3; { Offset des Chars in Data }
|
||||
for j:=0 to 7 do begin
|
||||
mask:=$80;
|
||||
b1:=defaultfontdata[offs+j]; { Offset der Charzeile }
|
||||
jj:=j*akttextinfo.charsize;
|
||||
if akttextinfo.direction=horizdir then
|
||||
xpos:=x+((i-1) shl 3)*akttextinfo.charsize
|
||||
else
|
||||
ypos:=y-((i-1) shl 3)*akttextinfo.charsize;
|
||||
for k:=0 to {7}8*akttextinfo.charsize-1 do
|
||||
begin
|
||||
if (b1 and mask) <> 0 then
|
||||
for l:=0 to akttextinfo.charsize-1 do
|
||||
if akttextinfo.direction=horizdir then
|
||||
putpixeli(xpos+k,jj+ypos+l,aktcolor)
|
||||
else
|
||||
putpixeli(xpos+jj+l,ypos-k,aktcolor)
|
||||
else if ClearText then
|
||||
for l:=0 to akttextinfo.charsize-1 do
|
||||
if akttextinfo.direction=horizdir then
|
||||
putpixeli(xpos+k,jj+ypos+l,aktbackcolor)
|
||||
else
|
||||
putpixeli(xpos+jj+l,ypos-k,aktbackcolor);
|
||||
if (k mod akttextinfo.charsize) = akttextinfo.charsize-1 then
|
||||
mask:=mask shr 1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end else
|
||||
|
||||
begin
|
||||
{ Linienstil setzen }
|
||||
getlinesettings(oldvalues);
|
||||
setlinestyle(solidln,oldvalues.pattern,normwidth);
|
||||
if akttextinfo.direction=vertdir then xpos:=xpos + Textheight(textstring);
|
||||
curx:=xpos; cury:=ypos; x:=xpos; y:=ypos;
|
||||
for i:=1 to length(textstring) do
|
||||
begin
|
||||
c:=byte(textstring[i]);
|
||||
c:=c-fonts[akttextinfo.font].header^.value_first_char;
|
||||
{ definiertes Zeichen ? }
|
||||
if (c<0) or (c>=fonts[akttextinfo.font].header^.nr_chars) then continue;
|
||||
nextpos:=fonts[akttextinfo.font].offsets[c];
|
||||
while true do
|
||||
begin
|
||||
b1:=fonts[akttextinfo.font].instr[nextpos];
|
||||
nextpos:=nextpos+1;
|
||||
b2:=fonts[akttextinfo.font].instr[nextpos];
|
||||
nextpos:=nextpos+1;
|
||||
instr:=((b1 and $80) shr 6)+((b2 and $80) shr 7);
|
||||
b1:=b1 and $7f;
|
||||
b2:=b2 and $7f;
|
||||
{ Vorzeichen erweitern }
|
||||
if (b1 and $40)<>0 then b1:=b1 or $80;
|
||||
if (b2 and $40)<>0 then b2:=b2 or $80;
|
||||
{ neue Stiftposition berechnen und skalieren }
|
||||
if akttextinfo.direction=VertDir then
|
||||
begin
|
||||
xpos:=x-((b2*aktmultx) div aktdivx);
|
||||
ypos:=y-((b1*aktmulty) div aktdivy);
|
||||
end
|
||||
else
|
||||
begin
|
||||
xpos:=x+((b1*aktmultx) div aktdivx) ;
|
||||
ypos:=y-((b2*aktmulty) div aktdivy) ;
|
||||
end;
|
||||
case instr of
|
||||
0 : break;
|
||||
2 : begin curx:=xpos; cury:=ypos; end;
|
||||
3 : begin line(curx,cury,xpos,ypos);
|
||||
curx:=xpos; cury:=ypos;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if akttextinfo.direction=VertDir then
|
||||
y:=y-(fonts[akttextinfo.font].widths[c]*aktmultx div aktdivx)
|
||||
else
|
||||
x:=x+(fonts[akttextinfo.font].widths[c]*aktmultx div aktdivx) ;
|
||||
end;
|
||||
setlinestyle( oldvalues.linestyle, oldvalues.pattern, oldvalues.thickness);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure outtextxy(x,y: Integer;const charakter : char);
|
||||
var s:string;
|
||||
begin
|
||||
s:=charakter;
|
||||
outtextXY(x,y,s);
|
||||
end;
|
||||
|
||||
function TextHeight(const TextString : string) : word;
|
||||
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
if akttextinfo.font=DefaultFont
|
||||
then TextHeight:=6+akttextinfo.charsize
|
||||
else
|
||||
TextHeight:=(((fonts[akttextinfo.font].header^.dist_origin_top-
|
||||
fonts[akttextinfo.font].header^.dist_origin_bottom) * aktmulty) div aktdivy) ;
|
||||
end;
|
||||
|
||||
function TextWidth(const TextString : string) : word;
|
||||
var i,x : Integer;
|
||||
c : byte;
|
||||
begin
|
||||
_graphresult:=grOk; x:=0;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
if akttextinfo.font = Defaultfont then
|
||||
TextWidth:=length(TextString)*8*akttextinfo.charsize
|
||||
else begin
|
||||
for i:=1 to length(TextString) do begin
|
||||
c:=byte(textstring[i]);
|
||||
dec(c,fonts[akttextinfo.font].header^.value_first_char);
|
||||
{ definiertes Zeichen ? }
|
||||
if (c<0) or (c>=fonts[akttextinfo.font].header^.nr_chars) then
|
||||
continue;
|
||||
x:=x+fonts[akttextinfo.font].widths[c];
|
||||
end;
|
||||
TextWidth:=((x * aktmultx) div aktdivx) ;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetTextJustify(horiz,vert : word);
|
||||
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
if (horiz<0) or (horiz>2) or
|
||||
(vert<0) or (vert>2) then
|
||||
begin
|
||||
_graphresult:=grError;
|
||||
exit;
|
||||
end;
|
||||
akttextinfo.horiz:=horiz;
|
||||
akttextinfo.vert:=vert;
|
||||
end;
|
||||
|
||||
procedure SetTextStyle(font,direction : word;charsize : word);
|
||||
|
||||
var
|
||||
f : file;
|
||||
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
{ Parameter auf G<>ltigkeit <20>berpr<70>fen }
|
||||
if font>installedfonts then
|
||||
begin
|
||||
_graphresult:=grInvalidFontNum;
|
||||
exit;
|
||||
end;
|
||||
akttextinfo.font:=font;
|
||||
if (direction<>HorizDir) and (direction<>VertDir) then
|
||||
direction:=HorizDir;
|
||||
akttextinfo.direction:=direction;
|
||||
akttextinfo.charsize:=charsize;
|
||||
if (charsize <> usercharsize) then begin
|
||||
aktmultx:=charsize;
|
||||
aktdivx:=fontdivs[font];
|
||||
aktmulty:=charsize;
|
||||
aktdivy:=fontdivs[font];
|
||||
end;
|
||||
{ Fontdatei laden ? }
|
||||
if (font>0) and not assigned(fonts[font].data) then
|
||||
begin
|
||||
assign(f,bgipath+fonts[font].name+'.CHR');
|
||||
reset(f,1);
|
||||
if ioresult<>0 then
|
||||
begin
|
||||
_graphresult:=grFontNotFound;
|
||||
akttextinfo.font:=DefaultFont;
|
||||
exit;
|
||||
end;
|
||||
getmem(fonts[font].data,filesize(f));
|
||||
if not assigned(fonts[font].data) then
|
||||
begin
|
||||
_graphresult:=grNoFontMem;
|
||||
akttextinfo.font:=DefaultFont;
|
||||
exit;
|
||||
end;
|
||||
blockread(f,fonts[font].data^,filesize(f));
|
||||
|
||||
if testfont(fonts[font].data) then
|
||||
_graphresult:=setupfont(font)
|
||||
else
|
||||
begin
|
||||
_graphresult:=grInvalidFont;
|
||||
akttextinfo.font:=DefaultFont;
|
||||
freemem(fonts[font].data,filesize(f));
|
||||
end;
|
||||
close(f);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
|
||||
|
||||
begin
|
||||
_graphresult:=grOk;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
aktmultx:=Multx;
|
||||
aktdivx:=Divx;
|
||||
aktmulty:=Multy;
|
||||
aktdivy:=Divy;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:05 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.3 1998/11/23 10:04:19 pierre
|
||||
* pieslice and sector work now !!
|
||||
* bugs in text writing removed
|
||||
+ scaling for defaultfont added
|
||||
+ VertDir for default font added
|
||||
* RestoreCRTMode corrected
|
||||
|
||||
Revision 1.2 1998/11/18 09:31:42 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:58:41 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/text.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:34; author: michael; state: Exp; lines: +14 -0
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,85 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
procedure Triangle(A,B,C:PointType);
|
||||
|
||||
var temp : PointType;
|
||||
yc,yl : Integer;
|
||||
x1,x2,x3 : Integer;
|
||||
y1,y2,y3 : Integer;
|
||||
begin
|
||||
if B.Y < A.Y then begin Temp:=A; A:=B; B:=Temp; end;
|
||||
if C.Y < B.Y then begin Temp:=B; B:=C; C:=Temp; end;
|
||||
if B.Y < A.Y then begin Temp:=A; A:=B; B:=Temp; end;
|
||||
x1:=b.x-a.x; y1:=b.y-a.y;
|
||||
x2:=c.x-b.x; y2:=c.y-b.y;
|
||||
x3:=c.x-a.x; y3:=c.y-a.y;
|
||||
yl:=b.y-a.y;
|
||||
if y1 <> 0 then
|
||||
for yc:=0 to y1 do
|
||||
begin
|
||||
patternline(a.x + yc * x1 div y1,a.x+ yc * x3 div y3,a.y+yc);
|
||||
end;
|
||||
if y2 <> 0 then
|
||||
for yc:=0 to y2 do
|
||||
begin
|
||||
patternline(c.x - yc * x2 div y2,c.x - yc * x3 div y3,c.y-yc);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Filltriangle(A,B,C:PointType);
|
||||
begin
|
||||
_graphresult:=grOK;
|
||||
if not isgraphmode then
|
||||
begin
|
||||
_graphresult:=grnoinitgraph;
|
||||
exit;
|
||||
end;
|
||||
Triangle(A,B,C);
|
||||
if (aktcolor<>aktfillsettings.color) or (aktfillsettings.pattern<>1) then
|
||||
begin
|
||||
line(a.x,a.y,b.x,b.y);
|
||||
line(b.x,b.y,c.x,c.y);
|
||||
line(c.x,c.y,a.x,a.y);
|
||||
end;
|
||||
end;
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:05 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:58:45 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/triangle.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:34; author: michael; state: Exp; lines: +13 -1
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:52; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:52; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1,124 +0,0 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program 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.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{ VESADEB.INC - contains Debuginformations for the VESA.PPU }
|
||||
|
||||
writeln('VESA-Signature : ',
|
||||
VGAInfo.VESASignature[1],VGAInfo.VESASignature[2],VGAInfo.VESASignature[3],
|
||||
VGAInfo.VESASignature[4],VGAInfo.VESAhiVersion,'.',VGAInfo.VESAloVersion);
|
||||
writeln('Memory installed : ',VGAInfo.Totalmem * 64,'K');
|
||||
writeln('startmode = ',HexStr(StartMode,4));
|
||||
write('Mode $',HexStr(GraphMode,4),' : ');
|
||||
if (VESAInfo.ModeAttributes and 1)=0 then write('not '); writeln('supported');
|
||||
writeln('Resolution : ',VESAInfo.XResolution,'x',VESAInfo.YResolution);
|
||||
write('optional Informations : ');
|
||||
if (VESAInfo.ModeAttributes and 2)=0 then write('not '); writeln('available');
|
||||
write('BIOS Output : ');
|
||||
if (VESAInfo.ModeAttributes and 4)=0 then write('not '); writeln('supported');
|
||||
write('Mode : ');
|
||||
if (VESAInfo.ModeAttributes and 8)<>0 then write('colour, ') else write('monochrom, ');
|
||||
if (VESAInfo.ModeAttributes and $10)<>0 then writeln('graphic') else writeln('text');
|
||||
if VGAInfo.VESAhiVersion=2 then begin
|
||||
write('Mode VGA-compatible : ');
|
||||
if (VESAInfo.ModeAttributes and $20)<>0 then writeln('no') else writeln('yes');
|
||||
write('Bankswitching : ');
|
||||
if (VESAInfo.ModeAttributes and $40)<>0 then write('not '); Writeln('supported');
|
||||
write('linear FrameBuffer : ');
|
||||
if (VESAInfo.ModeAttributes and $80)=0 then write('not supported') else
|
||||
begin Writeln('supported');
|
||||
Writeln('PhysBaseAddress at : 0x',HexStr(VESAInfo.PhysAddress,8));
|
||||
Writeln('LinearBase at : 0x',Hexstr(Get_linear_addr(VESAInfo.PhysAddress,VGAInfo.TotalMem shl 16),8));
|
||||
Writeln('OffscreenOffset : 0x',HexStr(VESAInfo.OffScreenPtr,8));
|
||||
Writeln('OffscreenMem : ',VESAInfo.OffScreenMem,'KB');
|
||||
end;
|
||||
if (VESAInfo.ModeAttributes and $200)<>0 then
|
||||
write('(VBE/AF v1.0P) application must call EnableDirectAccess '+
|
||||
'before calling bank-switching functions');
|
||||
end;
|
||||
writeln;
|
||||
writeln('BankSwitchRoutine at: ',HexStr(VESAInfo.RealWinFuncPtr,8));
|
||||
write('WindowA: read: '); if (VESAInfo.WinAAttributes and 3)=3 then write('yes')else write('no ');
|
||||
write(' write: '); if (VESAInfo.WinAAttributes and 5)=5 then write('yes')else write('no ');
|
||||
writeln(' Segment: ',HexStr(VESAInfo.segWinA,4));
|
||||
write('WindowB: read: '); if (VESAInfo.WinBAttributes and 3)=3 then write('yes')else write('no ');
|
||||
write(' write: '); if (VESAInfo.WinBAttributes and 5)=5 then write('yes')else write('no ');
|
||||
writeln(' Segment: ',HexStr(VESAInfo.segWinB,4));
|
||||
writeln('Granularity : ',VESAInfo.WinGranularity);
|
||||
writeln('WinSize : ',Winsize,' KByte WinShift : ',WinShift);
|
||||
write('BytesPerLine : ',BytesPerLine:4);
|
||||
writeln(' BytesPerPixel: ',BytesPerPixel);
|
||||
writeln('Number of pages: ',VESAInfo.NumberOfPages);
|
||||
|
||||
if isDPMI then
|
||||
begin
|
||||
write('Write selector linear base: ',hexstr(get_segment_base_address(seg_write),8));
|
||||
writeln(' linear limit: ',hexstr(get_segment_limit(seg_write),8));
|
||||
end;
|
||||
if not same_window then
|
||||
begin
|
||||
write('Read selector linear base: ',hexstr(get_segment_base_address(seg_read),8));
|
||||
writeln(' linear limit: ',hexstr(get_segment_limit(seg_read),8));
|
||||
end;
|
||||
{$ifndef FPC_PROFILE}
|
||||
readln;
|
||||
{$endif not FPC_PROFILE}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-21 13:07:05 peter
|
||||
* use -FE
|
||||
|
||||
Revision 1.4 1998/11/25 13:04:47 pierre
|
||||
+ added multi page support
|
||||
|
||||
Revision 1.3 1998/11/18 13:23:37 pierre
|
||||
* floodfill got into an infinite loop !!
|
||||
+ added partial support for fillpoly
|
||||
(still wrong if the polygon is not convex)
|
||||
Simply make a floodfill from the barycenter !
|
||||
* some 24BPP code changed (still does not work for my S3VBE program !)
|
||||
|
||||
Revision 1.2 1998/11/18 09:31:43 pierre
|
||||
* changed color scheme
|
||||
all colors are in RGB format if more than 256 colors
|
||||
+ added 24 and 32 bits per pixel mode
|
||||
(compile with -dDEBUG)
|
||||
24 bit mode with banked still as problems on pixels across
|
||||
the bank boundary, but works in LinearFrameBufferMode
|
||||
Look at install/demo/nmandel.pp
|
||||
|
||||
Revision 1.1.1.1 1998/03/25 11:18:42 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.3 1998/01/26 11:58:49 michael
|
||||
+ Added log at the end
|
||||
|
||||
|
||||
|
||||
Working file: rtl/dos/ppi/vesadeb.ppi
|
||||
description:
|
||||
----------------------------
|
||||
revision 1.2
|
||||
date: 1997/12/01 12:21:35; author: michael; state: Exp; lines: +14 -0
|
||||
+ added copyright reference in header.
|
||||
----------------------------
|
||||
revision 1.1
|
||||
date: 1997/11/27 08:33:52; author: michael; state: Exp;
|
||||
Initial revision
|
||||
----------------------------
|
||||
revision 1.1.1.1
|
||||
date: 1997/11/27 08:33:52; author: michael; state: Exp; lines: +0 -0
|
||||
FPC RTL CVS start
|
||||
=============================================================================
|
||||
}
|
||||
@ -1938,7 +1938,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.21 1999-11-03 20:23:01 florian
|
||||
Revision 1.1 1999-11-08 11:15:21 peter
|
||||
* move graph.inc to the target dir
|
||||
|
||||
Revision 1.21 1999/11/03 20:23:01 florian
|
||||
+ first release of win32 gui support
|
||||
|
||||
Revision 1.20 1999/10/24 15:50:23 carl
|
||||
@ -64,7 +64,10 @@ var
|
||||
{ initialized in QueryAdapterInfo in graph.inc }
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1999-09-26 13:31:07 jonas
|
||||
Revision 1.1 1999-11-08 11:15:21 peter
|
||||
* move graph.inc to the target dir
|
||||
|
||||
Revision 1.2 1999/09/26 13:31:07 jonas
|
||||
* changed name of modeinfo variable to vesamodeinfo and fixed
|
||||
associated errors (fillchar(modeinfo,sizeof(tmodeinfo),#0) instead
|
||||
of sizeof(TVesamodeinfo) etc)
|
||||
@ -2124,19 +2124,8 @@ end;
|
||||
|
||||
{$i modes.inc}
|
||||
{$i palette.inc}
|
||||
|
||||
{$ifdef win32}
|
||||
{$i win32.inc}
|
||||
{$else win32}
|
||||
|
||||
{$ifdef DPMI}
|
||||
{$i vesah.inc}
|
||||
{$endif DPMI}
|
||||
|
||||
{$i graph.inc}
|
||||
|
||||
{$endif win32}
|
||||
|
||||
function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): integer;
|
||||
begin
|
||||
_graphResult := grError;
|
||||
@ -2972,7 +2961,10 @@ SetGraphBufSize
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.34 1999-11-03 20:23:01 florian
|
||||
Revision 1.35 1999-11-08 11:15:22 peter
|
||||
* move graph.inc to the target dir
|
||||
|
||||
Revision 1.34 1999/11/03 20:23:01 florian
|
||||
+ first release of win32 gui support
|
||||
|
||||
Revision 1.33 1999/10/17 10:20:13 jonas
|
||||
|
||||
@ -521,7 +521,10 @@ function queryadapterinfo : pmodeinfo;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-11-03 20:23:02 florian
|
||||
Revision 1.1 1999-11-08 11:15:22 peter
|
||||
* move graph.inc to the target dir
|
||||
|
||||
Revision 1.1 1999/11/03 20:23:02 florian
|
||||
+ first release of win32 gui support
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user