paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-01 21:50:18 +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]; p := @ptable^[j];
q := @ptable^[index]; q := @ptable^[index];
end; 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 with activetable^[activepoints] do begin
dx := deltax; dx := deltax;
x := dx * (y { + 0.5} - p^.y) + p^.x; x := dx * (y { + 0.5} - p^.y) + p^.x;
@ -509,7 +509,18 @@ var
{ {
$Log$ $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 * floodfill uses scanline data from previous loop if line is adjacent
Revision 1.8 1999/09/18 22:21:09 jonas Revision 1.8 1999/09/18 22:21:09 jonas

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

@ -601,7 +601,6 @@ End;
end; end;
NotPut: NotPut:
begin begin
{ getpixel wants local/relative coordinates }
Color := Not Color; Color := Not Color;
end end
else else
@ -1768,15 +1767,7 @@ const CrtAddress: word = 0;
LogLn('actual call of RestoreVideoState'); LogLn('actual call of RestoreVideoState');
{$endif logging} {$endif logging}
RestoreVideoState; 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; isgraphmode := false;
If hasVesa then
Dispose(VESAInfo.ModeList);
{$ENDIF}
end; end;
function QueryAdapterInfo:PModeInfo; function QueryAdapterInfo:PModeInfo;
@ -2755,7 +2746,18 @@ const CrtAddress: word = 0;
{ {
$Log$ $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 + getscanline16
Revision 1.17 1999/09/24 11:31:38 jonas 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. } { equation of an ellipse. }
{ In the worst case, we have to calculate everything from the } { In the worst case, we have to calculate everything from the }
{ quadrant, so divide the circumference value by 4 (JM) } { 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 } { Calculate the angle precision required }
Delta := 90.0 / (NumOfPixels); Delta := 90.0 / (NumOfPixels);
{ Adjust for screen aspect ratio } { Adjust for screen aspect ratio }
@ -1605,58 +1605,57 @@ End;
OldWriteMode := CurrentWriteMode; OldWriteMode := CurrentWriteMode;
CurrentWriteMode := NormalPut; CurrentWriteMode := NormalPut;
{ number of times to go throuh the 8x8 pattern }
NrIterations := abs(x2 - x1+1) div 8;
Inc(NrIterations);
{ Get the current pattern } { Get the current pattern }
TmpFillPattern := FillPatternTable TmpFillPattern := FillPatternTable
{ [FillSettings.Pattern][(((y+viewport.x1) and $7)+1];}
[FillSettings.Pattern][(y and $7)+1]; [FillSettings.Pattern][(y and $7)+1];
if FillSettings.Pattern = EmptyFill then Case TmpFillPattern Of
begin 0:
OldCurrentColor := CurrentColor; begin
CurrentColor := CurrentBkColor; OldCurrentColor := CurrentColor;
{ hline converts the coordinates to global ones, but that has been done } CurrentColor := CurrentBkColor;
{ already here!!! Convert them back to local ones... (JM) } { hline converts the coordinates to global ones, but that has been done }
HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort); { already here!!! Convert them back to local ones... (JM) }
CurrentColor := OldCurrentColor; HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
end CurrentColor := OldCurrentColor;
else end;
if FillSettings.Pattern = SolidFill then $ff:
begin begin
HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort); HLine(x1-StartXViewPort,x2-StartXViewPort,y-StartYViewPort);
end end;
else else
begin begin
For i:= 0 to NrIterations do { number of times to go throuh the 8x8 pattern }
Begin NrIterations := abs(x2 - x1+1) div 8;
for j:=0 to 7 do Inc(NrIterations);
Begin For i:= 0 to NrIterations do
{ x1 mod 8 } Begin
if RevBitArray[x1 and 7] and TmpFillPattern <> 0 then for j:=0 to 7 do
DirectPutpixel(x1,y) Begin
else { x1 mod 8 }
begin if RevBitArray[x1 and 7] and TmpFillPattern <> 0 then
{ According to the TP graph manual, we overwrite everything } DirectPutpixel(x1,y)
{ which is filled up - checked against VGA and CGA drivers } else
{ of TP. } begin
OldCurrentColor := CurrentColor; { According to the TP graph manual, we overwrite everything }
CurrentColor := CurrentBkColor; { which is filled up - checked against VGA and CGA drivers }
DirectPutPixel(x1,y); { of TP. }
CurrentColor := OldCurrentColor; OldCurrentColor := CurrentColor;
end; CurrentColor := CurrentBkColor;
Inc(x1); DirectPutPixel(x1,y);
if x1 > x2 then CurrentColor := OldCurrentColor;
begin end;
CurrentWriteMode := OldWriteMode; Inc(x1);
exit; if x1 > x2 then
begin
CurrentWriteMode := OldWriteMode;
exit;
end;
end; end;
end; end;
end; end;
end; End;
CurrentWriteMode := OldWriteMode; CurrentWriteMode := OldWriteMode;
end; end;
@ -2039,8 +2038,9 @@ end;
DefaultHooks; DefaultHooks;
end; end;
{$ifdef DPMI}
{$i vesah.inc}
{$endif DPMI}
{$i modes.inc} {$i modes.inc}
{$i graph.inc} {$i graph.inc}
@ -2644,56 +2644,56 @@ end;
var var
i: integer; i: integer;
begin begin
lineinfo.linestyle:=solidln; lineinfo.linestyle:=solidln;
lineinfo.thickness:=normwidth; lineinfo.thickness:=normwidth;
{ reset line style pattern } { reset line style pattern }
for i:=0 to 15 do for i:=0 to 15 do
LinePatterns[i] := TRUE; LinePatterns[i] := TRUE;
{ By default, according to the TP prog's reference } { By default, according to the TP prog's reference }
{ the default pattern is solid, and the default } { the default pattern is solid, and the default }
{ color is the maximum color in the palette. } { color is the maximum color in the palette. }
fillsettings.color:=GetMaxColor; fillsettings.color:=GetMaxColor;
fillsettings.pattern:=solidfill; fillsettings.pattern:=solidfill;
{ GraphDefaults resets the User Fill pattern to $ff } { GraphDefaults resets the User Fill pattern to $ff }
{ checked with VGA BGI driver - CEC } { checked with VGA BGI driver - CEC }
for i:=1 to 8 do for i:=1 to 8 do
FillPatternTable[UserFill][i] := $ff; FillPatternTable[UserFill][i] := $ff;
CurrentColor:=white; CurrentColor:=white;
SetBkColor(Black); SetBkColor(Black);
ClipPixels := TRUE; ClipPixels := TRUE;
{ Reset the viewport } { Reset the viewport }
StartXViewPort := 0; StartXViewPort := 0;
StartYViewPort := 0; StartYViewPort := 0;
ViewWidth := MaxX; ViewWidth := MaxX;
ViewHeight := MaxY; ViewHeight := MaxY;
{ Reset CP } { Reset CP }
CurrentX := 0; CurrentX := 0;
CurrentY := 0; CurrentY := 0;
{ normal write mode } { normal write mode }
CurrentWriteMode := CopyPut; CurrentWriteMode := CopyPut;
{ Schriftart einstellen } { Schriftart einstellen }
CurrentTextInfo.font := DefaultFont; CurrentTextInfo.font := DefaultFont;
CurrentTextInfo.direction:=HorizDir; CurrentTextInfo.direction:=HorizDir;
CurrentTextInfo.charsize:=1; CurrentTextInfo.charsize:=1;
CurrentTextInfo.horiz:=LeftText; CurrentTextInfo.horiz:=LeftText;
CurrentTextInfo.vert:=TopText; CurrentTextInfo.vert:=TopText;
XAspect:=10000; YAspect:=10000; XAspect:=10000; YAspect:=10000;
end; end;
procedure GetAspectRatio(var Xasp,Yasp : word); procedure GetAspectRatio(var Xasp,Yasp : word);
begin begin
XAsp:=XAspect; XAsp:=XAspect;
YAsp:=YAspect; YAsp:=YAspect;
end; end;
procedure SetAspectRatio(Xasp, Yasp : word); procedure SetAspectRatio(Xasp, Yasp : word);
begin begin
@ -2770,7 +2770,7 @@ end;
bgipath:=bgipath+'\'; bgipath:=bgipath+'\';
{ make sure our driver list is setup...} { make sure our driver list is setup...}
QueryAdapterInfo; { QueryAdapterInfo;}
if not assigned(SaveVideoState) then if not assigned(SaveVideoState) then
RunError(216); RunError(216);
{$ifdef logging} {$ifdef logging}
@ -2880,7 +2880,18 @@ DetectGraph
{ {
$Log$ $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 * renamed text.inc -> gtext.inc to avoid conflict with system unit
* fixed textwidth * fixed textwidth
* isgraphmode now gets properly updated, so mode restoring works * isgraphmode now gets properly updated, so mode restoring works

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

@ -109,7 +109,6 @@
c: word; c: word;
{$endif logging} {$endif logging}
begin begin
exit;
{$ifdef logging} {$ifdef logging}
LogLn('Modelist at exit: '+strf(longint(modelist))); LogLn('Modelist at exit: '+strf(longint(modelist)));
LogLn('Modelist^.next at exit: '+strf(longint(modelist^.next))); LogLn('Modelist^.next at exit: '+strf(longint(modelist^.next)));
@ -127,6 +126,14 @@
{$endif logging} {$endif logging}
dispose(tmp); dispose(tmp);
end; 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; end;
{-----------------------------------------------------------------------} {-----------------------------------------------------------------------}
@ -336,12 +343,22 @@
begin begin
isgraphmode := false; isgraphmode := false;
RestoreVideoState; RestoreVideoState;
isgraphmode := true;
end; end;
{ {
$Log$ $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 * renamed text.inc -> gtext.inc to avoid conflict with system unit
* fixed textwidth * fixed textwidth
* isgraphmode now gets properly updated, so mode restoring works * isgraphmode now gets properly updated, so mode restoring works

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

@ -15,9 +15,6 @@
**********************************************************************} **********************************************************************}
type 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 } palrec = packed record { record used for set/get DAC palette }
align: byte; align: byte;
@ -57,50 +54,12 @@ const
modelRGB = $06; modelRGB = $06;
modelYUV = $07; modelYUV = $07;
{$ifndef dpmi}
TYPE {$i vesah.inc}
{ otherwise it's already included in graph.pp }
{$endif dpmi}
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 var
VESAInfo : TVESAInfo; { VESA Driver information }
ModeInfo : TVESAModeInfo; { Current Mode information }
BytesPerLine: word; { Number of bytes per scanline } BytesPerLine: word; { Number of bytes per scanline }
@ -114,9 +73,6 @@ var
BankShift : word; { address to shift by when switching banks. } 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; function hexstr(val : longint;cnt : byte) : string;
const const
HexTbl : array[0..15] of char='0123456789ABCDEF'; HexTbl : array[0..15] of char='0123456789ABCDEF';
@ -1023,7 +979,7 @@ end;
else else
Begin Begin
If CurrentWriteMode <> NotPut Then If CurrentWriteMode <> NotPut Then
col := Byte(CurrentColor) col := CurrentColor
Else col := Not(CurrentColor); Else col := Not(CurrentColor);
memW[WinWriteSeg : word(offs)] := Col; memW[WinWriteSeg : word(offs)] := Col;
End End
@ -1056,7 +1012,7 @@ end;
Else Else
Begin Begin
If CurrentWriteMode <> NotPut Then If CurrentWriteMode <> NotPut Then
col := Byte(CurrentColor) col := CurrentColor
Else col := Not(CurrentColor); Else col := Not(CurrentColor);
memW[WinWriteSeg : word(offs)] := Col; memW[WinWriteSeg : word(offs)] := Col;
End End
@ -1921,7 +1877,18 @@ end;
{ {
$Log$ $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 * -dlogging no longer required to fuction correctly
* some typo's fixed * 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
}