paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-30 13:20:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

* optimized patternline a bit (always use hline when possible)

Browse Source 
* isgraphmode stuff cleanup
  * vesainfo.modelist now gets disposed in cleanmode instead of in
    closegraph (required moving of some declarations from vesa.inc to
    new vesah.inc)
  * queryadapter gets no longer called from initgraph (is called from
    initialization of graph unit)
  * bugfix for notput in 32k and 64k vesa modes
  * a div replaced by / in fillpoly
This commit is contained in:
Jonas Maebe 1999-09-24 22:52:38 +00:00
parent 3e14491ff2
commit 5f0cf70477
6 changed files with 242 additions and 156 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
rtl/inc/graph/fills.inc
View File

@ -161,7 +161,7 @@ begin
p := @ptable^[j];
q := @ptable^[index];
end;
deltax := (q^.x-p^.x) div (q^.y-p^.y);
deltax := (q^.x-p^.x) / (q^.y-p^.y);
with activetable^[activepoints] do begin
dx := deltax;
x := dx * (y { + 0.5} - p^.y) + p^.x;
@ -509,7 +509,18 @@ var
{
$Log$
Revision 1.9 1999-09-24 14:23:08 jonas
Revision 1.10 1999-09-24 22:52:38 jonas
* optimized patternline a bit (always use hline when possible)
* isgraphmode stuff cleanup
* vesainfo.modelist now gets disposed in cleanmode instead of in
closegraph (required moving of some declarations from vesa.inc to
new vesah.inc)
* queryadapter gets no longer called from initgraph (is called from
initialization of graph unit)
* bugfix for notput in 32k and 64k vesa modes
* a div replaced by / in fillpoly
Revision 1.9 1999/09/24 14:23:08 jonas
* floodfill uses scanline data from previous loop if line is adjacent
Revision 1.8 1999/09/18 22:21:09 jonas

22
rtl/inc/graph/graph.inc
View File

@ -601,7 +601,6 @@ End;
end;
NotPut:
begin
{ getpixel wants local/relative coordinates }
Color := Not Color;
end
else
@ -1768,15 +1767,7 @@ const CrtAddress: word = 0;
LogLn('actual call of RestoreVideoState');
{$endif logging}
RestoreVideoState;
{$IFDEF DPMI}
{ We had copied the buffer of mode information }
{ and allocated it dynamically... now free it }
{ Warning: if GetVESAInfo returned false, this buffer is not allocated!
(JM)}
isgraphmode := false;
If hasVesa then
Dispose(VESAInfo.ModeList);
{$ENDIF}
end;
function QueryAdapterInfo:PModeInfo;
@ -2755,7 +2746,18 @@ const CrtAddress: word = 0;
{
$Log$
Revision 1.18 1999-09-24 14:22:38 jonas
Revision 1.19 1999-09-24 22:52:38 jonas
* optimized patternline a bit (always use hline when possible)
* isgraphmode stuff cleanup
* vesainfo.modelist now gets disposed in cleanmode instead of in
closegraph (required moving of some declarations from vesa.inc to
new vesah.inc)
* queryadapter gets no longer called from initgraph (is called from
initialization of graph unit)
* bugfix for notput in 32k and 64k vesa modes
* a div replaced by / in fillpoly
Revision 1.18 1999/09/24 14:22:38 jonas
+ getscanline16
Revision 1.17 1999/09/24 11:31:38 jonas

191
rtl/inc/graph/graph.pp
View File

@ -1369,7 +1369,7 @@ var
{ equation of an ellipse. }
{ In the worst case, we have to calculate everything from the }
{ quadrant, so divide the circumference value by 4 (JM) }
NumOfPixels:=(8 div 4)*Round(2*sqrt((sqr(XRadius)+sqr(YRadius)) div 2));
NumOfPixels:=Round(2.5*sqrt((sqr(XRadius)+sqr(YRadius)) div 2));
{ Calculate the angle precision required }
Delta := 90.0 / (NumOfPixels);
{ Adjust for screen aspect ratio }
@ -1605,58 +1605,57 @@ End;
OldWriteMode := CurrentWriteMode;
CurrentWriteMode := NormalPut;
{ number of times to go throuh the 8x8 pattern }
NrIterations := abs(x2 - x1+1) div 8;
Inc(NrIterations);
{ Get the current pattern }
TmpFillPattern := FillPatternTable
{ [FillSettings.Pattern][(((y+viewport.x1) and $7)+1];}
[FillSettings.Pattern][(y and $7)+1];
if FillSettings.Pattern = EmptyFill then
begin
OldCurrentColor := CurrentColor;
CurrentColor := CurrentBkColor;
{ hline converts the coordinates to global ones, but that has been done }
{ already here!!! Convert them back to local ones... (JM) }
HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
CurrentColor := OldCurrentColor;
end
else
if FillSettings.Pattern = SolidFill then
begin
HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
end
else
begin
For i:= 0 to NrIterations do
Begin
for j:=0 to 7 do
Begin
{ x1 mod 8 }
if RevBitArray[x1 and 7] and TmpFillPattern <> 0 then
DirectPutpixel(x1,y)
else
begin
{ According to the TP graph manual, we overwrite everything }
{ which is filled up - checked against VGA and CGA drivers }
{ of TP. }
OldCurrentColor := CurrentColor;
CurrentColor := CurrentBkColor;
DirectPutPixel(x1,y);
CurrentColor := OldCurrentColor;
end;
Inc(x1);
if x1 > x2 then
begin
CurrentWriteMode := OldWriteMode;
exit;
Case TmpFillPattern Of
0:
begin
OldCurrentColor := CurrentColor;
CurrentColor := CurrentBkColor;
{ hline converts the coordinates to global ones, but that has been done }
{ already here!!! Convert them back to local ones... (JM) }
HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
CurrentColor := OldCurrentColor;
end;
$ff:
begin
HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
end;
else
begin
{ number of times to go throuh the 8x8 pattern }
NrIterations := abs(x2 - x1+1) div 8;
Inc(NrIterations);
For i:= 0 to NrIterations do
Begin
for j:=0 to 7 do
Begin
{ x1 mod 8 }
if RevBitArray[x1 and 7] and TmpFillPattern <> 0 then
DirectPutpixel(x1,y)
else
begin
{ According to the TP graph manual, we overwrite everything }
{ which is filled up - checked against VGA and CGA drivers }
{ of TP. }
OldCurrentColor := CurrentColor;
CurrentColor := CurrentBkColor;
DirectPutPixel(x1,y);
CurrentColor := OldCurrentColor;
end;
Inc(x1);
if x1 > x2 then
begin
CurrentWriteMode := OldWriteMode;
exit;
end;
end;
end;
end;
end;
end;
end;
End;
CurrentWriteMode := OldWriteMode;
end;
@ -2039,8 +2038,9 @@ end;
DefaultHooks;
end;
{$ifdef DPMI}
{$i vesah.inc}
{$endif DPMI}
{$i modes.inc}
{$i graph.inc}
@ -2644,56 +2644,56 @@ end;
var
i: integer;
begin
lineinfo.linestyle:=solidln;
lineinfo.thickness:=normwidth;
{ reset line style pattern }
for i:=0 to 15 do
LinePatterns[i] := TRUE;
lineinfo.linestyle:=solidln;
lineinfo.thickness:=normwidth;
{ reset line style pattern }
for i:=0 to 15 do
LinePatterns[i] := TRUE;
{ By default, according to the TP prog's reference }
{ the default pattern is solid, and the default }
{ color is the maximum color in the palette. }
fillsettings.color:=GetMaxColor;
fillsettings.pattern:=solidfill;
{ GraphDefaults resets the User Fill pattern to $ff }
{ checked with VGA BGI driver - CEC }
for i:=1 to 8 do
FillPatternTable[UserFill][i] := $ff;
{ By default, according to the TP prog's reference }
{ the default pattern is solid, and the default }
{ color is the maximum color in the palette. }
fillsettings.color:=GetMaxColor;
fillsettings.pattern:=solidfill;
{ GraphDefaults resets the User Fill pattern to $ff }
{ checked with VGA BGI driver - CEC }
for i:=1 to 8 do
FillPatternTable[UserFill][i] := $ff;
CurrentColor:=white;
SetBkColor(Black);
CurrentColor:=white;
SetBkColor(Black);
ClipPixels := TRUE;
{ Reset the viewport }
StartXViewPort := 0;
StartYViewPort := 0;
ViewWidth := MaxX;
ViewHeight := MaxY;
{ Reset CP }
CurrentX := 0;
CurrentY := 0;
ClipPixels := TRUE;
{ Reset the viewport }
StartXViewPort := 0;
StartYViewPort := 0;
ViewWidth := MaxX;
ViewHeight := MaxY;
{ Reset CP }
CurrentX := 0;
CurrentY := 0;
{ normal write mode }
CurrentWriteMode := CopyPut;
{ normal write mode }
CurrentWriteMode := CopyPut;
{ Schriftart einstellen }
CurrentTextInfo.font := DefaultFont;
CurrentTextInfo.direction:=HorizDir;
CurrentTextInfo.charsize:=1;
CurrentTextInfo.horiz:=LeftText;
CurrentTextInfo.vert:=TopText;
{ Schriftart einstellen }
CurrentTextInfo.font := DefaultFont;
CurrentTextInfo.direction:=HorizDir;
CurrentTextInfo.charsize:=1;
CurrentTextInfo.horiz:=LeftText;
CurrentTextInfo.vert:=TopText;
XAspect:=10000; YAspect:=10000;
XAspect:=10000; YAspect:=10000;
end;
procedure GetAspectRatio(var Xasp,Yasp : word);
begin
XAsp:=XAspect;
YAsp:=YAspect;
end;
procedure GetAspectRatio(var Xasp,Yasp : word);
begin
XAsp:=XAspect;
YAsp:=YAspect;
end;
procedure SetAspectRatio(Xasp, Yasp : word);
begin
@ -2770,7 +2770,7 @@ end;
bgipath:=bgipath+'\';
{ make sure our driver list is setup...}
QueryAdapterInfo;
{ QueryAdapterInfo;}
if not assigned(SaveVideoState) then
RunError(216);
{$ifdef logging}
@ -2880,7 +2880,18 @@ DetectGraph
{
$Log$
Revision 1.26 1999-09-22 13:13:35 jonas
Revision 1.27 1999-09-24 22:52:38 jonas
* optimized patternline a bit (always use hline when possible)
* isgraphmode stuff cleanup
* vesainfo.modelist now gets disposed in cleanmode instead of in
closegraph (required moving of some declarations from vesa.inc to
new vesah.inc)
* queryadapter gets no longer called from initgraph (is called from
initialization of graph unit)
* bugfix for notput in 32k and 64k vesa modes
* a div replaced by / in fillpoly
Revision 1.26 1999/09/22 13:13:35 jonas
* renamed text.inc -> gtext.inc to avoid conflict with system unit
* fixed textwidth
* isgraphmode now gets properly updated, so mode restoring works

23
rtl/inc/graph/modes.inc
View File

@ -109,7 +109,6 @@
c: word;
{$endif logging}
begin
exit;
{$ifdef logging}
LogLn('Modelist at exit: '+strf(longint(modelist)));
LogLn('Modelist^.next at exit: '+strf(longint(modelist^.next)));
@ -127,6 +126,14 @@
{$endif logging}
dispose(tmp);
end;
{$IFDEF DPMI}
{ We had copied the buffer of mode information }
{ and allocated it dynamically... now free it }
{ Warning: if GetVESAInfo returned false, this buffer is not allocated!
(JM)}
If hasVesa then
Dispose(VESAInfo.ModeList);
{$ENDIF}
end;
{-----------------------------------------------------------------------}
@ -336,12 +343,22 @@
begin
isgraphmode := false;
RestoreVideoState;
isgraphmode := true;
end;
{
$Log$
Revision 1.9 1999-09-22 13:13:36 jonas
Revision 1.10 1999-09-24 22:52:39 jonas
* optimized patternline a bit (always use hline when possible)
* isgraphmode stuff cleanup
* vesainfo.modelist now gets disposed in cleanmode instead of in
closegraph (required moving of some declarations from vesa.inc to
new vesah.inc)
* queryadapter gets no longer called from initgraph (is called from
initialization of graph unit)
* bugfix for notput in 32k and 64k vesa modes
* a div replaced by / in fillpoly
Revision 1.9 1999/09/22 13:13:36 jonas
* renamed text.inc -> gtext.inc to avoid conflict with system unit
* fixed textwidth
* isgraphmode now gets properly updated, so mode restoring works

69
rtl/inc/graph/vesa.inc
View File

@ -15,9 +15,6 @@
**********************************************************************}
type
pModeList = ^tModeList;
tModeList = Array [0..255] of word; {list of modes terminated by -1}
{VESA modes are >=100h}
palrec = packed record { record used for set/get DAC palette }
align: byte;
@ -57,50 +54,12 @@ const
modelRGB = $06;
modelYUV = $07;
TYPE
TVESAinfo = packed record { VESA Information request }
signature : array [1..4] of char; { This should be VESA }
version : word; { VESA revision }
str : pChar; { pointer to OEM string }
caps : longint; { video capabilities }
modeList : pModeList; { pointer to SVGA modes }
pad : array [18..260] of byte; { extra padding more then }
end; { VESA standard because of bugs on }
{ some video cards. }
TVESAModeInfo = packed record
attr : word; { mode attributes (1.0) }
winAAttr,
winBAttr : byte; { window attributes (1.0) }
winGranularity : word; {in K} { Window granularity (1.0) }
winSize : word; {in K} { window size (1.0) }
winASeg, { Window A Segment address (1.0) }
winBSeg : word; { Window B Segment address (1.0) }
winFunct : procedure; { Function to swtich bank }
BytesPerScanLine: word; {bytes per scan line (1.0) }
{ extended information }
xRes, yRes : word; {pixels}
xCharSize,
yCharSize : byte;
planes : byte;
bitsPixel : byte;
banks : byte;
memModel : byte;
bankSize : byte; {in K}
NumberOfPages: byte;
pad : array [29..260] of byte; { always put some more space then required}
end;
{$ifndef dpmi}
{$i vesah.inc}
{ otherwise it's already included in graph.pp }
{$endif dpmi}
var
VESAInfo : TVESAInfo; { VESA Driver information }
ModeInfo : TVESAModeInfo; { Current Mode information }
BytesPerLine: word; { Number of bytes per scanline }
@ -114,9 +73,6 @@ var
BankShift : word; { address to shift by when switching banks. }
hasVesa: Boolean; { true if we have a VESA compatible graphics card}
{ initialized in QueryAdapterInfo in graph.inc }
function hexstr(val : longint;cnt : byte) : string;
const
HexTbl : array[0..15] of char='0123456789ABCDEF';
@ -1023,7 +979,7 @@ end;
else
Begin
If CurrentWriteMode <> NotPut Then
col := Byte(CurrentColor)
col := CurrentColor
Else col := Not(CurrentColor);
memW[WinWriteSeg : word(offs)] := Col;
End
@ -1056,7 +1012,7 @@ end;
Else
Begin
If CurrentWriteMode <> NotPut Then
col := Byte(CurrentColor)
col := CurrentColor
Else col := Not(CurrentColor);
memW[WinWriteSeg : word(offs)] := Col;
End
@ -1921,7 +1877,18 @@ end;
{
$Log$
Revision 1.14 1999-09-23 14:00:42 jonas
Revision 1.15 1999-09-24 22:52:39 jonas
* optimized patternline a bit (always use hline when possible)
* isgraphmode stuff cleanup
* vesainfo.modelist now gets disposed in cleanmode instead of in
closegraph (required moving of some declarations from vesa.inc to
new vesah.inc)
* queryadapter gets no longer called from initgraph (is called from
initialization of graph unit)
* bugfix for notput in 32k and 64k vesa modes
* a div replaced by / in fillpoly
Revision 1.14 1999/09/23 14:00:42 jonas
* -dlogging no longer required to fuction correctly
* some typo's fixed

78
rtl/inc/graph/vesah.inc Normal file
View File

@ -0,0 +1,78 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1993,99 by Carl Eric Codere
This include implements VESA basic access.
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.
**********************************************************************}
TYPE
pModeList = ^tModeList;
tModeList = Array [0..255] of word; {list of modes terminated by -1}
{VESA modes are >=100h}
TVESAinfo = packed record { VESA Information request }
signature : array [1..4] of char; { This should be VESA }
version : word; { VESA revision }
str : pChar; { pointer to OEM string }
caps : longint; { video capabilities }
modeList : pModeList; { pointer to SVGA modes }
pad : array [18..260] of byte; { extra padding more then }
end; { VESA standard because of bugs on }
{ some video cards. }
TVESAModeInfo = packed record
attr : word; { mode attributes (1.0) }
winAAttr,
winBAttr : byte; { window attributes (1.0) }
winGranularity : word; {in K} { Window granularity (1.0) }
winSize : word; {in K} { window size (1.0) }
winASeg, { Window A Segment address (1.0) }
winBSeg : word; { Window B Segment address (1.0) }
winFunct : procedure; { Function to swtich bank }
BytesPerScanLine: word; {bytes per scan line (1.0) }
{ extended information }
xRes, yRes : word; {pixels}
xCharSize,
yCharSize : byte;
planes : byte;
bitsPixel : byte;
banks : byte;
memModel : byte;
bankSize : byte; {in K}
NumberOfPages: byte;
pad : array [29..260] of byte; { always put some more space then required}
end;
var
VESAInfo : TVESAInfo; { VESA Driver information }
ModeInfo : TVESAModeInfo; { Current Mode information }
hasVesa: Boolean; { true if we have a VESA compatible graphics card}
{ initialized in QueryAdapterInfo in graph.inc }
{
$Log$
Revision 1.1 1999-09-24 22:52:40 jonas
* optimized patternline a bit (always use hline when possible)
* isgraphmode stuff cleanup
* vesainfo.modelist now gets disposed in cleanmode instead of in
closegraph (required moving of some declarations from vesa.inc to
new vesah.inc)
* queryadapter gets no longer called from initgraph (is called from
initialization of graph unit)
* bugfix for notput in 32k and 64k vesa modes
* a div replaced by / in fillpoly
}