paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 15:29:26 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ hlinevesa256 and vlinevesa256

Browse Source 
+ support for not/xor/or/andput in vesamodes with 32k/64k colors
  * lots of changes to avoid warnings under FPC
This commit is contained in:
Jonas Maebe 1999-09-18 22:21:09 +00:00
parent cd47cbb67a
commit 4e43bad546
6 changed files with 652 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -104,25 +104,25 @@ const
code:=code1;
if (code and LEFT) <> 0 then
begin
newy:=y1+trunc((y2-y1)*(xmin-x1)/(x2-x1));
newy:=y1+(y2-y1)*(xmin-x1) div (x2-x1);
newx:=xmin;
end
else
if (code and RIGHT) <> 0 then
begin
newy:=y1+trunc((y2-y1)*(xmax-x1)/(x2-x1));
newy:=y1+(y2-y1)*(xmax-x1) div (x2-x1);
newx:=xmax;
end
else
if (code and BOTTOM) <> 0 then
begin
newx:=x1+trunc((x2-x1)* ((ymax-y1) / (y2-y1)));
newx:=x1+(x2-x1)* ((ymax-y1) div (y2-y1));
newy:=ymax;
end
else
if (code and TOP) <> 0 then
begin
newx:=x1+trunc((x2-x1)*(ymin-y1)/(y2-y1));
newx:=x1+(x2-x1)*(ymin-y1) div (y2-y1);
newy:=ymin;
end;
if (code1 = code) then
@ -142,7 +142,12 @@ end;
{
$Log$
Revision 1.4 1999-09-12 17:28:59 jonas
Revision 1.5 1999-09-18 22:21:09 jonas
+ hlinevesa256 and vlinevesa256
+ support for not/xor/or/andput in vesamodes with 32k/64k colors
* lots of changes to avoid warnings under FPC
Revision 1.4 1999/09/12 17:28:59 jonas
* several changes to internalellipse to make it faster
and to make sure it updates the ArcCall correctly
(not yet done for width = 3)

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

@ -114,13 +114,13 @@ type
var
ptable : ppointarray; { pointer to points list }
function compare_ind(u, v : pointer) : graph_int; far;
function compare_ind(u, v : pointer) : graph_int; {$ifndef fpc} far; {$endif fpc}
begin
if (ptable^[pint(u)^].y <= ptable^[pint(v)^].y) then compare_ind := -1
else compare_ind := 1;
end;
function compare_active(u, v : pointer) : graph_int; far;
function compare_active(u, v : pointer) : graph_int; {$ifndef fpc} far; {$endif fpc}
begin
if (pedge(u)^.x <= pedge(v)^.x) then compare_active := -1
else compare_active := 1;
@ -492,7 +492,12 @@ var
{
$Log$
Revision 1.7 1999-09-17 13:58:31 jonas
Revision 1.8 1999-09-18 22:21:09 jonas
+ hlinevesa256 and vlinevesa256
+ support for not/xor/or/andput in vesamodes with 32k/64k colors
* lots of changes to avoid warnings under FPC
Revision 1.7 1999/09/17 13:58:31 jonas
* another fix for a case where internalellipsedefault went haywire
* sector() and pieslice() fully implemented!
* small change to prevent buffer overflow with floodfill

93
rtl/inc/graph/graph.inc
View File

@ -145,7 +145,7 @@ CONST
{* 4-bit planar VGA mode routines *}
{************************************************************************}
Procedure Init640x200x16; far; assembler;
Procedure Init640x200x16; {$ifndef fpc}far;{$endif fpc} assembler;
{ must also clear the screen...}
asm
mov ax,000Eh
@ -159,7 +159,7 @@ CONST
end;
Procedure Init640x350x16; far; assembler;
Procedure Init640x350x16; {$ifndef fpc}far;{$endif fpc} assembler;
{ must also clear the screen...}
asm
mov ax,0010h
@ -172,7 +172,7 @@ CONST
{$endif fpc}
end;
procedure Init640x480x16; far; assembler;
procedure Init640x480x16; {$ifndef fpc}far;{$endif fpc} assembler;
{ must also clear the screen...}
asm
mov ax,0012h
@ -185,7 +185,7 @@ CONST
{$endif fpc}
end;
Procedure PutPixel16(X,Y : Integer; Pixel: Word); far;
Procedure PutPixel16(X,Y : Integer; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
{$ifndef asmgraph}
var offset: word;
dummy: byte;
@ -290,7 +290,7 @@ CONST
end;
Function GetPixel16(X,Y: Integer):word; far;
Function GetPixel16(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
{$ifndef asmgraph}
Var dummy, offset: Word;
shift: byte;
@ -448,7 +448,7 @@ CONST
end;
Procedure DirectPutPixel16(X,Y : Integer); far;
Procedure DirectPutPixel16(X,Y : Integer); {$ifndef fpc}far;{$endif fpc}
{ x,y -> must be in global coordinates. No clipping. }
var
color: word;
@ -589,7 +589,7 @@ CONST
end;
{$ifndef tp}
procedure HLine16(x,x2,y: integer); far;
procedure HLine16(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
var
xtmp: integer;
@ -716,7 +716,7 @@ CONST
port[$3cf]:=0;
end;
procedure VLine16(x,y,y2: integer); far;
procedure VLine16(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
var
ytmp: integer;
@ -797,20 +797,20 @@ CONST
{$endif tp}
procedure SetVisual480(page: word); far;
procedure SetVisual480(page: word); {$ifndef fpc}far;{$endif fpc}
{ no page flipping support in 640x480 mode }
begin
VideoOfs := 0;
end;
procedure SetActive480(page: word); far;
procedure SetActive480(page: word); {$ifndef fpc}far;{$endif fpc}
{ no page flipping support in 640x480 mode }
begin
VideoOfs := 0;
end;
procedure SetVisual200(page: word); far;
procedure SetVisual200(page: word); {$ifndef fpc}far;{$endif fpc}
{ two page support... }
begin
if page > HardwarePages then exit;
@ -839,7 +839,7 @@ CONST
end;
end;
procedure SetActive200(page: word); far;
procedure SetActive200(page: word); {$ifndef fpc}far;{$endif fpc}
{ two page support... }
begin
case page of
@ -851,7 +851,7 @@ CONST
end;
end;
procedure SetVisual350(page: word); far;
procedure SetVisual350(page: word); {$ifndef fpc}far;{$endif fpc}
{ one page support... }
begin
if page > HardwarePages then exit;
@ -868,7 +868,7 @@ CONST
end;
end;
procedure SetActive350(page: word); far;
procedure SetActive350(page: word); {$ifndef fpc}far;{$endif fpc}
{ one page support... }
begin
case page of
@ -887,7 +887,7 @@ CONST
{* 320x200x256c Routines *}
{************************************************************************}
Procedure Init320; far; assembler;
Procedure Init320; {$ifndef fpc}far;{$endif fpc} assembler;
asm
mov ax,0013h
{$ifdef fpc}
@ -899,7 +899,7 @@ CONST
{$endif fpc}
end;
Procedure PutPixel320(X,Y : Integer; Pixel: Word); far;
Procedure PutPixel320(X,Y : Integer; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
{ x,y -> must be in local coordinates. Clipping if required. }
Begin
X:= X + StartXViewPort;
@ -941,7 +941,7 @@ CONST
end;
Function GetPixel320(X,Y: Integer):word; far;
Function GetPixel320(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
Begin
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
@ -975,7 +975,7 @@ CONST
end;
Procedure DirectPutPixel320(X,Y : Integer); far;
Procedure DirectPutPixel320(X,Y : Integer); {$ifndef fpc}far;{$endif fpc}
{ x,y -> must be in global coordinates. No clipping. }
{$ifndef asmgraph}
var offset: word;
@ -1027,12 +1027,12 @@ CONST
{$endif asmgraph}
procedure SetVisual320(page: word); far;
procedure SetVisual320(page: word); {$ifndef fpc}far;{$endif fpc}
{ no page support... }
begin
end;
procedure SetActive320(page: word); far;
procedure SetActive320(page: word); {$ifndef fpc}far;{$endif fpc}
{ no page support... }
begin
VideoOfs := 0;
@ -1043,7 +1043,7 @@ CONST
{************************************************************************}
const CrtAddress: word = 0;
procedure InitModeX; far;
procedure InitModeX; {$ifndef fpc}far;{$endif fpc}
begin
asm
{see if we are using color-/monochorme display}
@ -1115,7 +1115,7 @@ const CrtAddress: word = 0;
end;
Function GetPixelX(X,Y: Integer): word; far;
Function GetPixelX(X,Y: Integer): word; {$ifndef fpc}far;{$endif fpc}
{$ifndef asmgraph}
var offset: word;
{$endif asmgraph}
@ -1182,7 +1182,7 @@ const CrtAddress: word = 0;
{$endif asmgraph}
end;
procedure SetVisualX(page: word); far;
procedure SetVisualX(page: word); {$ifndef fpc}far;{$endif fpc}
{ 4 page support... }
Procedure SetVisibleStart(AOffset: word); Assembler;
@ -1238,7 +1238,7 @@ const CrtAddress: word = 0;
end;
end;
procedure SetActiveX(page: word); far;
procedure SetActiveX(page: word); {$ifndef fpc}far;{$endif fpc}
{ 4 page support... }
begin
case page of
@ -1251,7 +1251,7 @@ const CrtAddress: word = 0;
end;
end;
Procedure PutPixelX(X,Y: Integer; color:word); far;
Procedure PutPixelX(X,Y: Integer; color:word); {$ifndef fpc}far;{$endif fpc}
{$ifndef asmgraph}
var offset: word;
dummy: byte;
@ -1309,7 +1309,7 @@ const CrtAddress: word = 0;
end;
Procedure DirectPutPixelX(X,Y: Integer); far;
Procedure DirectPutPixelX(X,Y: Integer); {$ifndef fpc}far;{$endif fpc}
{ x,y -> must be in global coordinates. No clipping. }
{$ifndef asmgraph}
Var offset: Word;
@ -1375,7 +1375,7 @@ const CrtAddress: word = 0;
{$IFDEF DPMI}
RealStateSeg: word; { Real segment of saved video state }
Procedure SaveStateVGA;
Procedure SaveStateVGA; {$ifndef fpc}far;{$endif fpc}
var
PtrLong: longint;
regs: TDPMIRegisters;
@ -1442,7 +1442,7 @@ const CrtAddress: word = 0;
end;
end;
procedure RestoreStateVGA;
procedure RestoreStateVGA; {$ifndef fpc}far;{$endif fpc}
var
regs:TDPMIRegisters;
begin
@ -1493,7 +1493,7 @@ const CrtAddress: word = 0;
{**************************************************************}
Procedure SaveStateVGA; far;
Procedure SaveStateVGA; far;
begin
SavePtr := nil;
SaveSupported := FALSE;
@ -1568,7 +1568,7 @@ const CrtAddress: word = 0;
{ VGA is never a direct color mode, so no need to check ... }
Procedure SetVGARGBPalette(ColorNum, RedValue, GreenValue,
BlueValue : Integer); far; assembler;
BlueValue : Integer); {$ifndef fpc}far;{$endif fpc} assembler;
asm
{ on some hardware - there is a snow like effect }
{ when changing the palette register directly }
@ -1609,7 +1609,7 @@ const CrtAddress: word = 0;
{ VGA is never a direct color mode, so no need to check ... }
Procedure GetVGARGBPalette(ColorNum: integer; Var
RedValue, GreenValue, BlueValue : integer); far;
RedValue, GreenValue, BlueValue : integer); {$ifndef fpc}far;{$endif fpc}
begin
Port[$03C7] := ColorNum;
{ we must convert to lsb values... because the vga uses the 6 msb bits }
@ -2015,6 +2015,8 @@ const CrtAddress: word = 0;
mode.InitMode := Init640x400x256;
mode.SetVisualPage := SetVisualVESA;
mode.SetActivePage := SetActiveVESA;
mode.hline := HLineVESA256;
mode.vline := VLineVESA256;
{$else fpc}
mode.DirectPutPixel:=@DirectPutPixVESA256;
mode.PutPixel:=@PutPixVESA256;
@ -2024,6 +2026,8 @@ const CrtAddress: word = 0;
mode.InitMode := @Init640x400x256;
mode.SetVisualPage := @SetVisualVESA;
mode.SetActivePage := @SetActiveVESA;
mode.hline := @HLineVESA256;
mode.vline := @VLineVESA256;
{$endif fpc}
mode.XAspect := 10000;
mode.YAspect := 10000;
@ -2051,6 +2055,8 @@ const CrtAddress: word = 0;
mode.InitMode := Init640x480x256;
mode.SetVisualPage := SetVisualVESA;
mode.SetActivePage := SetActiveVESA;
mode.hline := HLineVESA256;
mode.vline := VLineVESA256;
{$else fpc}
mode.DirectPutPixel:=@DirectPutPixVESA256;
mode.PutPixel:=@PutPixVESA256;
@ -2060,6 +2066,8 @@ const CrtAddress: word = 0;
mode.InitMode := @Init640x480x256;
mode.SetVisualPage := @SetVisualVESA;
mode.SetActivePage := @SetActiveVESA;
mode.hline := @HLineVESA256;
mode.hline := @HLineVESA256;
{$endif fpc}
mode.XAspect := 10000;
mode.YAspect := 10000;
@ -2199,6 +2207,8 @@ const CrtAddress: word = 0;
mode.InitMode := Init800x600x256;
mode.SetVisualPage := SetVisualVESA;
mode.SetActivePage := SetActiveVESA;
mode.hline := HLineVESA256;
mode.vline := VLineVESA256;
{$else fpc}
mode.DirectPutPixel:=@DirectPutPixVESA256;
mode.PutPixel:=@PutPixVESA256;
@ -2208,6 +2218,8 @@ const CrtAddress: word = 0;
mode.InitMode := @Init800x600x256;
mode.SetVisualPage := @SetVisualVESA;
mode.SetActivePage := @SetActiveVESA;
mode.hline := @HLineVESA256;
mode.vline := @VLineVESA256;
{$endif fpc}
mode.XAspect := 10000;
mode.YAspect := 10000;
@ -2347,6 +2359,8 @@ const CrtAddress: word = 0;
mode.InitMode := Init1024x768x256;
mode.SetVisualPage := SetVisualVESA;
mode.SetActivePage := SetActiveVESA;
mode.hline := HLineVESA256;
mode.vline := VLineVESA256;
{$else fpc}
mode.DirectPutPixel:=@DirectPutPixVESA256;
mode.PutPixel:=@PutPixVESA256;
@ -2356,6 +2370,8 @@ const CrtAddress: word = 0;
mode.InitMode := @Init1024x768x256;
mode.SetVisualPage := @SetVisualVESA;
mode.SetActivePage := @SetActiveVESA;
mode.vline := @VLineVESA256;
mode.hline := @HLineVESA256;
{$endif fpc}
mode.XAspect := 10000;
mode.YAspect := 10000;
@ -2495,6 +2511,8 @@ const CrtAddress: word = 0;
mode.GetRGBPalette := GetVESARGBPalette;
mode.SetVisualPage := SetVisualVESA;
mode.SetActivePage := SetActiveVESA;
mode.hline := HLineVESA256;
mode.vline := VLineVESA256;
{$else fpc}
mode.DirectPutPixel:=@DirectPutPixVESA256;
mode.PutPixel:=@PutPixVESA256;
@ -2504,6 +2522,8 @@ const CrtAddress: word = 0;
mode.GetRGBPalette := @GetVESARGBPalette;
mode.SetVisualPage := @SetVisualVESA;
mode.SetActivePage := @SetActiveVESA;
mode.vline := @VLineVESA256;
mode.hline := @HLineVESA256;
{$endif fpc}
mode.XAspect := 10000;
mode.YAspect := 10000;
@ -2588,7 +2608,12 @@ const CrtAddress: word = 0;
{
$Log$
Revision 1.13 1999-09-18 16:03:36 jonas
Revision 1.14 1999-09-18 22:21:09 jonas
+ hlinevesa256 and vlinevesa256
+ support for not/xor/or/andput in vesamodes with 32k/64k colors
* lots of changes to avoid warnings under FPC
Revision 1.13 1999/09/18 16:03:36 jonas
* graph.pp: removed pieslice and sector from ToDo list
* closegraph: exits now immidiately if isgraphmode = false (caused
RTE 204 with VESA enabled if you set exitproc to call closegraph
@ -2622,7 +2647,7 @@ Revision 1.9 1999/08/01 14:50:51 jonas
Revision 1.8 1999/07/18 15:07:19 jonas
+ xor-, and and- orput support for VESA256 modes
* compile with -dlogging if you wnt some info to be logged to grlog.txt
* compile with -dlogging if you want some info to be logged to grlog.txt
Revision 1.7 1999/07/14 18:18:02 florian
* cosmetic changes
@ -2642,7 +2667,7 @@ Revision 1.4 1999/07/12 13:27:08 jonas
* only dispose vesainfo at closegrph if a vesa card was detected
* changed int32 to longint (int32 is not declared under FPC)
* changed the declaration of almost every procedure in graph.inc to
"far;" becquse otherwise you can't assign them to procvars under TP
"far;" because otherwise you can't assign them to procvars under TP
real mode (but unexplainable "data segnment too large" errors prevent
it from working under real mode anyway)

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

@ -37,8 +37,6 @@ Unit Graph;
{ returns an error. }
{ - DrawPoly XORPut mode is not exactly the same as in }
{ the TP graph unit. }
{ - FillEllipse does not support XORPut mode with a }
{ bounded FloodFill. Mode is always CopyPut mode. }
{ - Imagesize returns a longint instead of a word }
{ - ImageSize cannot return an error value }
{-------------------------------------------------------}
@ -48,7 +46,9 @@ Unit Graph;
{ Pierre Mueller - major bugfixes }
{ Carl Eric Codere - complete rewrite }
{ Thomas Schatzl - optimizations,routines and }
{ Credits (external): suggestions. }
{ suggestions. }
{ Jonas Maebe - bugfixes and optimizations }
{ Credits (external): }
{ - Original FloodFill code by }
{ Menno Victor van der star }
{ (the code has been heavily modified) }
@ -810,7 +810,7 @@ var
{$i clip.inc}
procedure HLineDefault(x,x2,y: integer); far;
procedure HLineDefault(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
var
xtmp: integer;
@ -838,7 +838,7 @@ var
end;
procedure VLineDefault(x,y,y2: integer); far;
procedure VLineDefault(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
var
Col: word;
@ -865,7 +865,7 @@ var
End;
procedure LineDefault(X1, Y1, X2, Y2: Integer); far;
procedure LineDefault(X1, Y1, X2, Y2: Integer); {$ifndef fpc}far;{$endif fpc}
var X, Y : Integer;
deltax, deltay : Integer;
@ -1305,7 +1305,7 @@ var
{********************************************************}
Procedure InternalEllipseDefault(X,Y: Integer;XRadius: word;
YRadius:word; stAngle,EndAngle: word; pl: PatternLineProc); far;
YRadius:word; stAngle,EndAngle: word; pl: PatternLineProc); {$ifndef fpc}far;{$endif fpc}
var
j, Delta, DeltaEnd: graph_float;
NumOfPixels: longint;
@ -1371,7 +1371,7 @@ var
{ quadrant, so divide the circumference value by 4 (JM) }
NumOfPixels:=(8 div 4)*Round(2*sqrt((sqr(XRadius)+sqr(YRadius)) div 2));
{ Calculate the angle precision required }
Delta := 90 / (NumOfPixels);
Delta := 90.0 / (NumOfPixels);
{ Adjust for screen aspect ratio }
XRadius:=(longint(XRadius)*10000) div XAspect;
YRadius:=(longint(YRadius)*10000) div YAspect;
@ -1576,7 +1576,7 @@ Begin
End;
End;
*)
procedure PatternLineDefault(x1,x2,y: integer); far;
procedure PatternLineDefault(x1,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
{********************************************************}
{ Draws a horizontal patterned line according to the }
{ current Fill Settings. }
@ -1745,7 +1745,7 @@ End;
{--------------------------------------------------------------------------}
Procedure ClearViewPortDefault; far;
Procedure ClearViewPortDefault; {$ifndef fpc}far;{$endif fpc}
var
j: integer;
OldWriteMode, OldCurColor: word;
@ -1843,7 +1843,7 @@ end;
{--------------------------------------------------------------------------}
Procedure GetScanlineDefault (Y : Integer; Var Data); far;
Procedure GetScanlineDefault (Y : Integer; Var Data); {$ifndef fpc}far;{$endif fpc}
{**********************************************************}
{ Procedure GetScanLine() }
{----------------------------------------------------------}
@ -1863,14 +1863,14 @@ end;
Function DefaultImageSize(X1,Y1,X2,Y2: Integer): longint; far;
Function DefaultImageSize(X1,Y1,X2,Y2: Integer): longint; {$ifndef fpc}far;{$endif fpc}
Begin
{ each pixel uses two bytes, to enable modes with colors up to 64K }
{ to work. }
DefaultImageSize := 12 + (((X2-X1)*(Y2-Y1))*2);
end;
Procedure DefaultPutImage(X,Y: Integer; var Bitmap; BitBlt: Word); far;
Procedure DefaultPutImage(X,Y: Integer; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
type
pt = array[0..32000] of word;
ptw = array[0..3] of longint;
@ -1905,7 +1905,7 @@ Begin
end;
Procedure DefaultGetImage(X1,Y1,X2,Y2: Integer; Var Bitmap); far;
Procedure DefaultGetImage(X1,Y1,X2,Y2: Integer; Var Bitmap); {$ifndef fpc}far;{$endif fpc}
type
pt = array[0..32000] of word;
ptw = array[0..3] of longint;
@ -1947,12 +1947,12 @@ end;
end;
procedure SetVisualPageDefault(page : word); far;
procedure SetVisualPageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
begin
end;
procedure SetActivePageDefault(page : word); far;
procedure SetActivePageDefault(page : word); {$ifndef fpc}far;{$endif fpc}
begin
end;
@ -2160,7 +2160,6 @@ end;
procedure SectorPL(x1,x2,y: Integer); {$ifndef fpc}far;{$endif fpc}
var plx1, plx2: integer;
{!!!!!!!!!!!!!!!}
{$ifdef sectorpldebug}
t : text;
{$endif sectorpldebug}
@ -2187,24 +2186,24 @@ end;
If (ArcCall.YStart-ArcCall.Y) = 0 then
begin
append(t);
writeln('bug1');
writeln(t,'bug1');
close(t);
runerror(202);
end;
{$endif sectorpldebug}
plx1 := Round((y-ArcCall.Y)/(ArcCall.YStart-ArcCall.Y)*
(ArcCall.XStart-ArcCall.X))+ArcCall.X;
plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
div (ArcCall.YStart-ArcCall.Y)+ArcCall.X;
{$ifdef sectorpldebug}
If (ArcCall.YEnd-ArcCall.Y) = 0 then
begin
append(t);
writeln('bug2');
writeln(t,'bug2');
close(t);
runerror(202);
end;
{$endif sectorpldebug}
plx2 := Round((y-ArcCall.Y)/(ArcCall.YEnd-ArcCall.Y)*
(ArcCall.XEnd-ArcCall.X))+ArcCall.X;
plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X;
If plx1 > plx2 then
begin
plx1 := plx1 xor plx2;
@ -2230,13 +2229,13 @@ end;
If (ArcCall.YEnd-ArcCall.Y) = 0 then
begin
append(t);
writeln('bug3');
writeln(t,'bug3');
close(t);
runerror(202);
end;
{$endif sectorpldebug}
plx1 := Round((y-ArcCall.Y)/(ArcCall.YEnd-ArcCall.Y)*
(ArcCall.XEnd-ArcCall.X))+ArcCall.X
plx1 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
end
else if (y > ArcCall.Y) then
begin
@ -2244,13 +2243,13 @@ end;
If (ArcCall.YStart-ArcCall.Y) = 0 then
begin
append(t);
writeln('bug4');
writeln(t,'bug4');
close(t);
runerror(202);
end;
{$endif sectorpldebug}
plx1 := Round((y-ArcCall.Y)/(ArcCall.YStart-ArcCall.Y)*
(ArcCall.XStart-ArcCall.X))+ArcCall.X
plx1 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
end
else plx1 := ArcCall.X;
plx2 := x2;
@ -2272,13 +2271,13 @@ end;
If (ArcCall.YStart-ArcCall.Y) = 0 then
begin
append(t);
writeln('bug5');
writeln(t,'bug5');
close(t);
runerror(202);
end;
{$endif sectorpldebug}
plx2 := Round((y-ArcCall.Y)/(ArcCall.YStart-ArcCall.Y)*
(ArcCall.XStart-ArcCall.X))+ArcCall.X
plx2 := (y-ArcCall.Y)*(ArcCall.XStart-ArcCall.X)
div (ArcCall.YStart-ArcCall.Y)+ArcCall.X
end
else if (y > ArcCall.Y) then
begin
@ -2286,13 +2285,13 @@ end;
If (ArcCall.YEnd-ArcCall.Y) = 0 then
begin
append(t);
writeln('bug6');
writeln(t,'bug6');
close(t);
runerror(202);
end;
{$endif sectorpldebug}
plx2 := Round((y-ArcCall.Y)/(ArcCall.YEnd-ArcCall.Y)*
(ArcCall.XEnd-ArcCall.X))+ArcCall.X
plx2 := (y-ArcCall.Y)*(ArcCall.XEnd-ArcCall.X)
div (ArcCall.YEnd-ArcCall.Y)+ArcCall.X
end
else plx2 := ArcCall.X;
plx1 := x1;
@ -2877,7 +2876,12 @@ DetectGraph
{
$Log$
Revision 1.24 1999-09-18 16:03:37 jonas
Revision 1.25 1999-09-18 22:21:10 jonas
+ hlinevesa256 and vlinevesa256
+ support for not/xor/or/andput in vesamodes with 32k/64k colors
* lots of changes to avoid warnings under FPC
Revision 1.24 1999/09/18 16:03:37 jonas
* graph.pp: removed pieslice and sector from ToDo list
* closegraph: exits now immidiately if isgraphmode = false (caused
RTE 204 with VESA enabled if you set exitproc to call closegraph

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

@ -87,7 +87,7 @@
end;
procedure cleanmode;far;
procedure cleanmode; {$ifndef fpc}far;{$endif fpc}
{********************************************************}
{ Procedure CleanMode() }
{--------------------------------------------------------}
@ -317,7 +317,12 @@
{
$Log$
Revision 1.7 1999-07-12 13:27:14 jonas
Revision 1.8 1999-09-18 22:21:11 jonas
+ hlinevesa256 and vlinevesa256
+ support for not/xor/or/andput in vesamodes with 32k/64k colors
* lots of changes to avoid warnings under FPC
Revision 1.7 1999/07/12 13:27:14 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

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

@ -400,7 +400,7 @@ end;
{ check if this is the current bank... if so do nothing. }
if BankNr = CurrentReadBank then exit;
{$ifdef logging}
LogLn('Setting read bank to '+strf(BankNr));
{ LogLn('Setting read bank to '+strf(BankNr));}
{$endif logging}
CurrentReadBank := BankNr; { save current bank number }
BankNr := BankNr shl BankShift; { adjust to window granularity }
@ -418,7 +418,7 @@ end;
{ check if this is the current bank... if so do nothing. }
if BankNr = CurrentWriteBank then exit;
{$ifdef logging}
LogLn('Setting write bank to '+strf(BankNr));
{ LogLn('Setting write bank to '+strf(BankNr));}
{$endif logging}
CurrentWriteBank := BankNr; { save current bank number }
BankNr := BankNr shl BankShift; { adjust to window granularity }
@ -435,7 +435,7 @@ end;
{* 8-bit pixels VESA mode routines *}
{************************************************************************}
procedure PutPixVESA256(x, y : integer; color : word); far;
procedure PutPixVESA256(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
var
bank : word;
offs : longint;
@ -455,10 +455,11 @@ end;
mem[WinWriteSeg : word(offs)] := byte(color)
end;
procedure DirectPutPixVESA256(x, y : integer); far;
procedure DirectPutPixVESA256(x, y : integer); {$ifndef fpc}far;{$endif fpc}
var
bank : word;
offs : longint;
col : byte;
begin
offs := longint(y) * BytesPerLine + x;
SetWriteBank(integer(offs shr 16));
@ -477,14 +478,18 @@ end;
Begin
SetReadBank(integer(offs shr 16));
mem[WinWriteSeg : word(offs)] := mem[WinReadSeg : word(offs)] or byte(currentcolor);
End;
NormalPut:
mem[WinWriteSeg : word(offs)] := byte(currentcolor)
else mem[WinWriteSeg : word(offs)] := byte(CurrentColor);
End;
End
else
Begin
If CurrentWriteMode <> NotPut then
col := Byte(CurrentColor)
else col := Not(Byte(CurrentColor));
mem[WinWriteSeg : word(offs)] := Col;
End
End;
end;
function GetPixVESA256(x, y : integer): word; far;
function GetPixVESA256(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
var
bank : word;
offs : longint;
@ -496,11 +501,439 @@ end;
GetPixVESA256:=mem[WinReadSeg : word(offs)];
end;
procedure HLineVESA256(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
var Offs: Longint;
mask, l, bankrest: longint;
curbank, hlength: integer;
Begin
{ must we swap the values? }
if x > x2 then
Begin
x := x xor x2;
x2 := x xor x2;
x:= x xor x2;
end;
{ First convert to global coordinates }
X := X + StartXViewPort;
X2 := X2 + StartXViewPort;
Y := Y + StartYViewPort;
if ClipPixels then
Begin
if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
exit;
end;
{$ifdef logging}
LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
{$endif logging}
HLength := x2 - x + 1;
{$ifdef logging}
LogLn('length: '+strf(hlength));
{$endif logging}
if HLength>0 then
begin
Offs:=Longint(y)*bytesperline+x;
{$ifdef logging}
LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
{$endif logging}
Mask := byte(CurrentColor)+byte(CurrentColor) shl 8;
Mask := Mask + Mask shl 16;
Case CurrentWriteMode of
AndPut:
Begin
Repeat
curbank := integer(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging}
If HLength > 3 Then
{ allign target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor);
End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := $10000 - (Offs and $ffff);
{$ifdef logging}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 4)-1 Do
MemL[WinWriteSeg:word(offs)+l*4] :=
MemL[WinReadSeg:word(offs)+l*4] And Mask;
inc(offs,l*4+4);
dec(hlength,l*4+4);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
x := offs mod bytesperline;
For l := 0 to HLength - 1 do
DirectPutPixVESA256(x+l,y);
HLength := 0
End
Until HLength = 0;
End;
XorPut:
Begin
Repeat
curbank := integer(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging}
If HLength > 3 Then
{ allign target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor);
End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := $10000 - (Offs and $ffff);
{$ifdef logging}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 4)-1 Do
MemL[WinWriteSeg:word(offs)+l*4] :=
MemL[WinReadSeg:word(offs)+l*4] Xor Mask;
inc(offs,l*4+4);
dec(hlength,l*4+4);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
x := offs mod bytesperline;
For l := 0 to HLength - 1 do
DirectPutPixVESA256(x+l,y);
HLength := 0
End
Until HLength = 0;
End;
OrPut:
Begin
Repeat
curbank := integer(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging}
If HLength > 3 Then
{ allign target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor);
End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := $10000 - (Offs and $ffff);
{$ifdef logging}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 4)-1 Do
MemL[WinWriteSeg:offs+l*4] :=
MemL[WinReadSeg:word(offs)+l*4] Or Mask;
inc(offs,l*4+4);
dec(hlength,l*4+4);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
x := offs mod bytesperline;
For l := 0 to HLength - 1 do
DirectPutPixVESA256(x+l,y);
HLength := 0
End
Until HLength = 0;
End
Else
Begin
If CurrentWriteMode = NotPut Then
Mask := Not(Mask);
Repeat
curbank := integer(offs shr 16);
SetWriteBank(curbank);
{$ifdef logging}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8)+' -- '+strf(offs));
{$endif logging}
If HLength > 3 Then
{ allign target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask);
End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := $10000 - (Offs and $ffff);
{$ifdef logging}
LogLn('Rest to be drawn in this window: '+strf(bankrest)+' -- '+hexstr(bankrest,8));
{$endif logging}
For l := 0 to (Bankrest div 4)-1 Do
MemL[WinWriteSeg:word(offs)+l*4] := Mask;
inc(offs,l*4+4);
dec(hlength,l*4+4);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
x := offs mod bytesperline;
For l := 0 to HLength - 1 do
DirectPutPixVESA256(x+l,y);
HLength := 0
End
Until HLength = 0;
End;
End;
end;
end;
procedure VLineVESA256(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
var Offs: Longint;
l, bankrest: longint;
curbank, vlength: integer;
col: byte;
Begin
{ must we swap the values? }
if y > y2 then
Begin
y := y xor y2;
y2 := y xor y2;
y:= y xor y2;
end;
{ First convert to global coordinates }
X := X + StartXViewPort;
Y := Y + StartYViewPort;
Y2 := Y2 + StartYViewPort;
if ClipPixels then
Begin
if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
exit;
end;
{$ifdef logging}
LogLn('vline '+strf(y)+' - '+strf(y2)+' on '+strf(x)+' in mode '+strf(currentwritemode));
{$endif logging}
VLength := y2 - y + 1;
{$ifdef logging}
LogLn('length: '+strf(vlength));
{$endif logging}
if VLength>0 then
begin
Offs:=Longint(y)*bytesperline+x;
{$ifdef logging}
LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
{$endif logging}
Case CurrentWriteMode of
AndPut:
Begin
Repeat
curbank := integer(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging}
If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
bankrest := VLength
else {the rest won't fit anymore in the current window }
bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
{$ifdef logging}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to Bankrest-1 Do
begin
Mem[WinWriteSeg:word(offs)] :=
Mem[WinReadSeg:word(offs)] And Byte(CurrentColor);
inc(offs,bytesperline);
end;
dec(VLength,l+1);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
Until VLength = 0;
End;
XorPut:
Begin
Repeat
curbank := integer(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging}
If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
bankrest := VLength
else {the rest won't fit anymore in the current window }
bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
{$ifdef logging}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to Bankrest-1 Do
begin
Mem[WinWriteSeg:word(offs)] :=
Mem[WinReadSeg:word(offs)] Xor Byte(CurrentColor);
inc(offs,bytesperline);
end;
dec(VLength,l+1);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
Until VLength = 0;
End;
OrPut:
Begin
Repeat
curbank := integer(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging}
If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
bankrest := VLength
else {the rest won't fit anymore in the current window }
bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
{$ifdef logging}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to Bankrest-1 Do
begin
Mem[WinWriteSeg:word(offs)] :=
Mem[WinReadSeg:word(offs)] Or Byte(CurrentColor);
inc(offs,bytesperline);
end;
dec(VLength,l+1);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
Until VLength = 0;
End;
Else
Begin
If CurrentWriteMode = NotPut Then
Col := Not(CurrentColor);
Repeat
curbank := integer(offs shr 16);
SetWriteBank(curbank);
{$ifdef logging}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging}
If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
bankrest := VLength
else {the rest won't fit anymore in the current window }
bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
{$ifdef logging}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to Bankrest-1 Do
begin
Mem[WinWriteSeg:word(offs)] := Col;
inc(offs,bytesperline);
end;
dec(VLength,l+1);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
Until VLength = 0;
End;
End;
end;
end;
{************************************************************************}
{* 15/16bit pixels VESA mode routines *}
{************************************************************************}
procedure PutPixVESA32k(x, y : integer; color : word); far;
procedure PutPixVESA32k(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
var
bank : word;
offs : longint;
@ -520,7 +953,7 @@ end;
memW[WinWriteSeg : word(offs)] := color;
end;
procedure PutPixVESA64k(x, y : integer; color : word); far;
procedure PutPixVESA64k(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
var
bank : word;
offs : longint;
@ -540,7 +973,7 @@ end;
memW[WinWriteSeg : word(offs)] := color;
end;
function GetPixVESA32k(x, y : integer): word; far;
function GetPixVESA32k(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
var
bank : word;
offs : longint;
@ -552,7 +985,7 @@ end;
GetPixVESA32k:=memW[WinReadSeg : word(offs)];
end;
function GetPixVESA64k(x, y : integer): word; far;
function GetPixVESA64k(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
var
bank : word;
offs : longint;
@ -564,31 +997,77 @@ end;
GetPixVESA64k:=memW[WinReadSeg : word(offs)];
end;
procedure DirectPutPixVESA32k(x, y : integer); far;
procedure DirectPutPixVESA32k(x, y : integer); {$ifndef fpc}far;{$endif fpc}
var
bank : word;
bank, col : word;
offs : longint;
begin
offs := longint(y) * BytesPerLine + 2*x;
SetWriteBank(integer((offs shr 16) and $ff));
memW[WinWriteSeg : word(offs)] := CurrentColor;
Case CurrentWriteMode of
XorPut:
Begin
SetReadBank(integer(offs shr 16));
memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] xor currentcolor;
End;
AndPut:
Begin
SetReadBank(integer(offs shr 16));
memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] And currentcolor;
End;
OrPut:
Begin
SetReadBank(integer(offs shr 16));
memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] or currentcolor;
End
else
Begin
If CurrentWriteMode <> NotPut Then
col := Byte(CurrentColor)
Else col := Not(CurrentColor);
memW[WinWriteSeg : word(offs)] := Col;
End
End;
end;
procedure DirectPutPixVESA64k(x, y : integer); far;
procedure DirectPutPixVESA64k(x, y : integer); {$ifndef fpc}far;{$endif fpc}
var
bank : word;
bank, Col : word;
offs : longint;
begin
offs := longint(y) * BytesPerLine + 2*x;
SetWriteBank(integer(offs shr 16));
memW[WinWriteSeg : word(offs)] := CurrentColor;
Case CurrentWriteMode of
XorPut:
Begin
SetReadBank(integer(offs shr 16));
memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] xor currentcolor;
End;
AndPut:
Begin
SetReadBank(integer(offs shr 16));
memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] And currentcolor;
End;
OrPut:
Begin
SetReadBank(integer(offs shr 16));
memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] or currentcolor;
End
Else
Begin
If CurrentWriteMode <> NotPut Then
col := Byte(CurrentColor)
Else col := Not(CurrentColor);
memW[WinWriteSeg : word(offs)] := Col;
End
End;
end;
{************************************************************************}
{* 4-bit pixels VESA mode routines *}
{************************************************************************}
procedure PutPixVESA16(x, y : integer; color : word); far;
procedure PutPixVESA16(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
var
bank : word;
offs : longint;
@ -621,7 +1100,7 @@ end;
{ }
end;
procedure DirectPutPixVESA16(x, y : integer); far;
procedure DirectPutPixVESA16(x, y : integer); {$ifndef fpc}far;{$endif fpc}
var
bank : word;
offs : longint;
@ -1132,89 +1611,89 @@ end;
{* VESA Modes inits *}
{************************************************************************}
procedure Init1280x1024x64k; far;
procedure Init1280x1024x64k; {$ifndef fpc}far;{$endif fpc}
begin
SetVesaMode(m1280x1024x64k);
end;
procedure Init1280x1024x32k; far;
procedure Init1280x1024x32k; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m1280x1024x32k);
end;
procedure Init1280x1024x256; far;
procedure Init1280x1024x256; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m1280x1024x256);
end;
procedure Init1280x1024x16; far;
procedure Init1280x1024x16; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m1280x1024x16);
end;
procedure Init1024x768x64k; far;
procedure Init1024x768x64k; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m1024x768x64k);
end;
procedure Init640x480x32k; far;
procedure Init640x480x32k; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m640x480x32k);
end;
procedure Init1024x768x256; far;
procedure Init1024x768x256; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m1024x768x256);
end;
procedure Init1024x768x16; far;
procedure Init1024x768x16; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m1024x768x16);
end;
procedure Init800x600x64k; far;
procedure Init800x600x64k; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m800x600x64k);
end;
procedure Init800x600x32k; far;
procedure Init800x600x32k; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m800x600x32k);
end;
procedure Init800x600x256; far;
procedure Init800x600x256; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m800x600x256);
end;
procedure Init800x600x16; far;
procedure Init800x600x16; {$ifndef fpc}far;{$endif fpc}
begin
SetVesaMode(m800x600x16);
end;
procedure Init640x480x64k; far;
procedure Init640x480x64k; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m640x480x64k);
end;
procedure Init640x480x256; far;
procedure Init640x480x256; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m640x480x256);
end;
procedure Init640x400x256; far;
procedure Init640x400x256; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m640x400x256);
end;
procedure Init320x200x64k; far;
procedure Init320x200x64k; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m320x200x64k);
end;
procedure Init320x200x32k; far;
procedure Init320x200x32k; {$ifndef fpc}far;{$endif fpc}
begin
SetVESAMode(m320x200x32k);
end;
@ -1222,7 +1701,7 @@ end;
{$IFDEF DPMI}
Procedure SaveStateVESA;
Procedure SaveStateVESA; {$ifndef fpc}far;{$endif fpc}
var
PtrLong: longint;
regs: TDPMIRegisters;
@ -1299,7 +1778,7 @@ end;
end;
end;
procedure RestoreStateVESA;
procedure RestoreStateVESA; {$ifndef fpc}far;{$endif fpc}
var
regs:TDPMIRegisters;
begin
@ -1429,20 +1908,25 @@ end;
{ Note: These routines, according to the VBE3 specification, will NOT }
{ work with the 24 bpp modes, because of the alignment. }
{************************************************************************}
procedure SetVisualVESA(page: word); far;
procedure SetVisualVESA(page: word); {$ifndef fpc}far;{$endif fpc}
{ two page support... }
begin
if page > HardwarePages then exit;
end;
procedure SetActiveVESA(page: word); far;
procedure SetActiveVESA(page: word); {$ifndef fpc}far;{$endif fpc}
{ two page support... }
begin
end;
{
$Log$
Revision 1.11 1999-09-15 11:40:30 jonas
Revision 1.12 1999-09-18 22:21:11 jonas
+ hlinevesa256 and vlinevesa256
+ support for not/xor/or/andput in vesamodes with 32k/64k colors
* lots of changes to avoid warnings under FPC
Revision 1.11 1999/09/15 11:40:30 jonas
* fixed PutPixVESA256
Revision 1.10 1999/09/11 19:43:02 jonas