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

* changed definition of getscanlineproc to "getscanline(x1,x2,y:

Browse Source 
integer; var data);" so it can be used by getimage too
  * changed getimage so it uses getscanline
  * changed floodfill, getscanline16 and definitions in Linux
    include files so they use this new format
  + getscanlineVESA256 for 256 color VESA modes (banked)
This commit is contained in:
Jonas Maebe 1999-12-11 23:41:38 +00:00
parent da92ae391d
commit 4ebd215a8c
6 changed files with 279 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

157
rtl/go32v2/graph.inc
View File

@ -24,11 +24,7 @@
const const
InternalDriverName = 'DOSGX'; InternalDriverName = 'DOSGX';
{$ifdef fpc} {$ifdef fpc}
{$ifdef asmgraph}
VideoOfs : DWord = 0; { Segment to draw to } VideoOfs : DWord = 0; { Segment to draw to }
{$else asmgraph}
VideoOfs : word = 0; { Segment to draw to }
{$endif asmgraph}
{$else fpc} {$else fpc}
VideoOfs : word = 0; { Segment to draw to } VideoOfs : word = 0; { Segment to draw to }
{$endif fpc} {$endif fpc}
@ -420,46 +416,48 @@ const
{$endif asmgraph} {$endif asmgraph}
end; end;
Procedure GetScanLine16(y: integer; var data); Procedure GetScanLine16(x1, x2, y: integer; var data);
var dummylong: longint; var dummylong: longint;
Offset, count, count2, amount, index: word; Offset, count, count2, amount, index: word;
plane: byte; plane: byte;
Begin Begin
inc(x1,StartXViewPort);
inc(x2,StartXViewPort);
{$ifdef logging} {$ifdef logging}
LogLn('GetScanLine16 start, length to get: '+strf(ViewWidth+1)+' at y = '+strf(y)); LogLn('GetScanLine16 start, length to get: '+strf(x2-x1+1)+' at y = '+strf(y));
{$Endif logging} {$Endif logging}
Port[$3ce] := 4; offset := (Y + StartYViewPort) * 80 + (x1 shr 3) + VideoOfs;
offset := (Y + StartYViewPort) * 80 + (StartXViewPort shr 3) + VideoOfs;
{$ifdef logging} {$ifdef logging}
LogLn('Offset: '+HexStr(offset,4)+' - ' + strf(offset)); LogLn('Offset: '+HexStr(offset,4)+' - ' + strf(offset));
{$Endif logging} {$Endif logging}
{ first get enough pixels so offset is 32bit aligned } { first get enough pixels so offset is 32bit aligned }
amount := 0; amount := 0;
index := 0; index := 0;
If ((StartXViewPort and 31) <> 0) Or If ((x1 and 31) <> 0) Or
(ViewWidth < 32) Then ((x2-x1+1) < 32) Then
Begin Begin
If (ViewWidth >= 32+32-(StartXViewPort and 31)) Then If ((x2-x1+1) >= 32+32-(x1 and 31)) Then
amount := 32-(StartXViewPort and 31) amount := 32-(x1 and 31)
Else amount := ViewWidth + 1; Else amount := x2-x1+1;
{$ifdef logging} {$ifdef logging}
LogLn('amount to align to 32bits or to get all: ' + strf(amount)); LogLn('amount to align to 32bits or to get all: ' + strf(amount));
{$Endif logging} {$Endif logging}
For count := 0 to amount-1 do For count := 0 to amount-1 do
WordArray(Data)[Count] := getpixel16(Count,y); WordArray(Data)[Count] := getpixel16(x1-StartXViewPort+Count,y);
index := count+1; index := amount;
Inc(Offset,(amount+7) shr 3); Inc(Offset,(amount+7) shr 3);
{$ifdef logging} {$ifdef logging}
LogLn('offset now: '+HexStr(offset,4)+' - ' + strf(offset)); LogLn('offset now: '+HexStr(offset,4)+' - ' + strf(offset));
LogLn('index now: '+strf(index)); LogLn('index now: '+strf(index));
{$Endif logging} {$Endif logging}
End; End;
amount := ViewWidth + 1 - amount; amount := x2-x1+1 - amount;
{$ifdef logging} {$ifdef logging}
LogLn('amount left: ' + strf(amount)); LogLn('amount left: ' + strf(amount));
{$Endif logging} {$Endif logging}
If amount = 0 Then Exit; If amount = 0 Then Exit;
Port[$3ce] := 4;
{ first get everything from plane 3 (4th plane) } { first get everything from plane 3 (4th plane) }
Port[$3cf] := 3; Port[$3cf] := 3;
Count := 0; Count := 0;
@ -496,7 +494,7 @@ Begin
For Count2 := 31 downto 0 Do For Count2 := 31 downto 0 Do
Begin Begin
WordArray(Data)[index+Count2] := WordArray(Data)[index+Count2] :=
(WordArray(Data)[index+Count2] shl 1) + (DummyLong and 1); (WordArray(Data)[index+Count2] shl 1) or (DummyLong and 1);
DummyLong := DummyLong shr 1; DummyLong := DummyLong shr 1;
End; End;
Inc(Index, 32); Inc(Index, 32);
@ -512,32 +510,32 @@ Begin
WordArray(Data)[index+Count] := getpixel16(index+Count,y); WordArray(Data)[index+Count] := getpixel16(index+Count,y);
{$ifdef logging} {$ifdef logging}
LogLn('First 32 bytes gotten with getscanline16: '); LogLn('First 32 bytes gotten with getscanline16: ');
If ViewWidth + 1 >= 32 Then If x2-x1+1 >= 32 Then
Count2 := 32 Count2 := 32
Else Count2 := ViewWidth; Else Count2 := x2-x1+1;
For Count := 0 to Count2-1 Do For Count := 0 to Count2-1 Do
Log(strf(WordArray(Data)[Count])+' '); Log(strf(WordArray(Data)[Count])+' ');
LogLn(''); LogLn('');
If ViewWidth + 1 >= 32 Then If x2-x1+1 >= 32 Then
Begin Begin
LogLn('Last 32 bytes gotten with getscanline16: '); LogLn('Last 32 bytes gotten with getscanline16: ');
For Count := 31 downto 0 Do For Count := 31 downto 0 Do
Log(strf(WordArray(Data)[ViewWidth-Count])+' '); Log(strf(WordArray(Data)[x2-x1-Count])+' ');
End; End;
LogLn(''); LogLn('');
GetScanLineDefault(y,Data); GetScanLineDefault(x1-StartXViewPort,x2-StartXViewPort,y,Data);
LogLn('First 32 bytes gotten with getscanlinedef: '); LogLn('First 32 bytes gotten with getscanlinedef: ');
If ViewWidth + 1 >= 32 Then If x2-x1+1 >= 32 Then
Count2 := 32 Count2 := 32
Else Count2 := ViewWidth; Else Count2 := x2-x1+1;
For Count := 0 to Count2-1 Do For Count := 0 to Count2-1 Do
Log(strf(WordArray(Data)[Count])+' '); Log(strf(WordArray(Data)[Count])+' ');
LogLn(''); LogLn('');
If ViewWidth + 1 >= 32 Then If x2-x1+1 >= 32 Then
Begin Begin
LogLn('Last 32 bytes gotten with getscanlinedef: '); LogLn('Last 32 bytes gotten with getscanlinedef: ');
For Count := 31 downto 0 Do For Count := 31 downto 0 Do
Log(strf(WordArray(Data)[ViewWidth-Count])+' '); Log(strf(WordArray(Data)[x2-x1-Count])+' ');
End; End;
LogLn(''); LogLn('');
LogLn('GetScanLine16 end'); LogLn('GetScanLine16 end');
@ -999,6 +997,7 @@ End;
Procedure PutPixel320(X,Y : Integer; Pixel: Word); {$ifndef fpc}far;{$endif fpc} Procedure PutPixel320(X,Y : Integer; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
{ x,y -> must be in local coordinates. Clipping if required. } { x,y -> must be in local coordinates. Clipping if required. }
{$ifndef fpc}
Begin Begin
X:= X + StartXViewPort; X:= X + StartXViewPort;
Y:= Y + StartYViewPort; Y:= Y + StartYViewPort;
@ -1010,11 +1009,7 @@ End;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
exit; exit;
end; end;
{$ifndef asmgraph}
Mem[SegA000: y * 320 + x + VideoOfs] := Lo(Pixel);
{$else asmgraph}
asm asm
{$ifndef fpc}
mov es, [SegA000] mov es, [SegA000]
mov ax, [Y] mov ax, [Y]
mov di, [X] mov di, [X]
@ -1025,29 +1020,41 @@ End;
add di, [VideoOfs] { point to correct page.. } add di, [VideoOfs] { point to correct page.. }
mov ax, [Pixel] mov ax, [Pixel]
mov es:[di], al mov es:[di], al
{$else fpc}
movzx edi, x
movzx ebx, y
add edi, [VideoOfs]
shl ebx, 6
add edi, ebx
mov ax, [pixel]
mov fs:[edi+ebx*4+$a0000], al
{$endif fpc}
end; end;
{$endif asmgraph} {$else fpc}
end; assembler;
asm
movzx edi, x
movzx ebx, y
cmp clippixels, 0
je @putpix320noclip
test edi, edi
jl @putpix320done
test ebx, ebx
jl @putpix320done
cmp di, ViewWidth
jg @putpix320done
cmp bx, ViewHeight
jg @putpix320done
@putpix320noclip:
add bx, StartYViewPort
add di, StartXViewPort
{ add edi, [VideoOfs] no multiple pages in 320*200*256 }
mov ax, [pixel]
shl ebx, 6
add edi, ebx
mov fs:[edi+ebx*4+$a0000], al
@putpix320done:
{$endif fpc}
end;
Function GetPixel320(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc} Function GetPixel320(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
{$ifndef fpc}
Begin Begin
X:= X + StartXViewPort; X:= X + StartXViewPort;
Y:= Y + StartYViewPort; Y:= Y + StartYViewPort;
{$ifndef asmgraph} asm
GetPixel320 := Mem[SegA000:y * 320 + x + VideoOfs];
{$else asmgraph}
asm
{$ifndef fpc}
mov es, [SegA000] mov es, [SegA000]
mov ax, [Y] mov ax, [Y]
mov di, [X] mov di, [X]
@ -1059,17 +1066,19 @@ End;
add di, [VideoOfs] { point to correct gfx page ... } add di, [VideoOfs] { point to correct gfx page ... }
mov al,es:[di] mov al,es:[di]
mov @Result,ax mov @Result,ax
{$else fpc}
movzx edi, x
movzx ebx, y
add edi, [VideoOfs]
shl ebx, 6
add edi, ebx
mov al, fs:[edi+ebx*4+$a0000]
mov @Result, al
{$endif fpc}
end; end;
{$endif asmgraph} {$else fpc}
assembler;
asm
movzx edi, x
movzx ebx, y
add di, StartXViewPort
add bx, StartYViewPort
{ add edi, [VideoOfs] no multiple pages in 320*200*256 }
shl ebx, 6
add edi, ebx
mov al, fs:[edi+ebx*4+$a0000]
{$endif fpc}
end; end;
@ -1100,7 +1109,7 @@ End;
add di, ax add di, ax
shr ax, 2 shr ax, 2
add di, ax add di, ax
add di, [VideoOfs] { add di, [VideoOfs] no multiple pages support in 320*200*256 }
mov ax, [CurrentColor] mov ax, [CurrentColor]
cmp [CurrentWriteMode],XORPut { check write mode } cmp [CurrentWriteMode],XORPut { check write mode }
jne @MOVMode jne @MOVMode
@ -1109,31 +1118,32 @@ End;
@MovMode: @MovMode:
mov es:[di], al mov es:[di], al
{$else fpc} {$else fpc}
movzx edi, y movzx edi, x
shl edi, 6 movzx ebx, y
mov ebx, edx { add edi, [VideoOfs] no multiple pages in 320*200*256 }
add edi, [VideoOfs] shl ebx, 6
add edi, ebx
mov ax, [CurrentColor] mov ax, [CurrentColor]
cmp [CurrentWriteMode],XORPut { check write mode } cmp [CurrentWriteMode],XORPut { check write mode }
jne @MOVMode jne @MOVMode
mov bl, fs:[edi+ebx*4+$a0000] xor al, fs:[edi+ebx*4+$a0000]
xor al, bl @MovMode:
@MovMode:
mov fs:[edi+ebx*4+$a0000], al mov fs:[edi+ebx*4+$a0000], al
{$endif fpc} {$endif fpc}
end; end;
{$endif asmgraph} {$endif asmgraph}
procedure SetVisual320(page: word); {$ifndef fpc}far;{$endif fpc} procedure SetVisual320(page: word); {$ifndef fpc}far;{$endif fpc}
{ no page supPort... } { no page supPort... }
begin begin
VideoOfs := 0;
end; end;
procedure SetActive320(page: word); {$ifndef fpc}far;{$endif fpc} procedure SetActive320(page: word); {$ifndef fpc}far;{$endif fpc}
{ no page supPort... } { no page supPort... }
begin begin
VideoOfs := 0; VideoOfs := 0;
end; end;
{************************************************************************} {************************************************************************}
@ -2091,6 +2101,7 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
mode.hline := {$ifdef fpc}@{$endif}HLineVESA256; mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
mode.vline := {$ifdef fpc}@{$endif}VLineVESA256; mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
mode.XAspect := 10000; mode.XAspect := 10000;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -2118,6 +2129,7 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
mode.hline := {$ifdef fpc}@{$endif}HLineVESA256; mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
mode.hline := {$ifdef fpc}@{$endif}HLineVESA256; mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
mode.XAspect := 10000; mode.XAspect := 10000;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -2224,6 +2236,7 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
mode.hline := {$ifdef fpc}@{$endif}HLineVESA256; mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
mode.vline := {$ifdef fpc}@{$endif}VLineVESA256; mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
mode.XAspect := 10000; mode.XAspect := 10000;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -2330,6 +2343,7 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
mode.vline := {$ifdef fpc}@{$endif}VLineVESA256; mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
mode.hline := {$ifdef fpc}@{$endif}HLineVESA256; mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
mode.XAspect := 10000; mode.XAspect := 10000;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -2436,6 +2450,7 @@ const CrtAddress: word = 0;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
mode.vline := {$ifdef fpc}@{$endif}VLineVESA256; mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
mode.hline := {$ifdef fpc}@{$endif}HLineVESA256; mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
mode.XAspect := 10000; mode.XAspect := 10000;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
@ -2497,7 +2512,15 @@ const CrtAddress: word = 0;
{ {
$Log$ $Log$
Revision 1.5 1999-12-10 12:49:24 pierre Revision 1.6 1999-12-11 23:41:39 jonas
* changed definition of getscanlineproc to "getscanline(x1,x2,y:
integer; var data);" so it can be used by getimage too
* changed getimage so it uses getscanline
* changed floodfill, getscanline16 and definitions in Linux
include files so they use this new format
+ getscanlineVESA256 for 256 color VESA modes (banked)
Revision 1.5 1999/12/10 12:49:24 pierre
* avoid overflow on ProtW in PutPixel16 * avoid overflow on ProtW in PutPixel16
Revision 1.4 1999/11/29 07:32:53 jonas Revision 1.4 1999/11/29 07:32:53 jonas

88
rtl/go32v2/vesa.inc
View File

@ -472,6 +472,84 @@ end;
GetPixVESA256:=mem[WinReadSeg : word(offs)]; GetPixVESA256:=mem[WinReadSeg : word(offs)];
end; end;
Procedure GetScanLineVESA256(x1, x2, y: integer; var data);
var offs: Longint;
l, amount, bankrest, index, pixels: longint;
x, curbank: integer;
begin
inc(x1,StartXViewPort);
inc(x2,StartXViewPort);
{$ifdef logging}
LogLn('getscanline256 '+strf(x1)+' - '+strf(x2)+' at '+strf(y+StartYViewPort));
{$endif logging}
index := 0;
amount := x2-x1+1;
Offs:=(Longint(y)+StartYViewPort+YOffset)*bytesperline+x1;
Repeat
curbank := integer(offs shr 16);
SetReadBank(curbank);
{$ifdef logging}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging}
If amount > 3 Then
{ allign target }
Begin
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 reading '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
WordArray(Data)[index+l-1] :=
Mem[WinReadSeg:word(offs)+l-1];
inc(index, l);
inc(offs, l);
dec(amount, l);
End;
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
{$endif logging}
{ offs is now 4-bytes alligned }
If amount <= ($10000-(Offs and $ffff)) Then
bankrest := amount
else {the rest won't fit anymore in the current window }
bankrest := $10000 - (Offs and $ffff);
{$ifdef logging}
LogLn('Rest to be read from this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 4)-1 Do
begin
pixels := MemL[WinWriteSeg:word(offs)+l*4];
WordArray(Data)[index+l*4] := pixels and $ff;
pixels := pixels shr 8;
WordArray(Data)[index+l*4+1] := pixels and $ff;
pixels := pixels shr 8;
WordArray(Data)[index+l*4+2] := pixels and $ff;
pixels := pixels shr 8;
WordArray(Data)[index+l*4+3] := pixels and $ff;
end;
inc(index,l*4+4);
inc(offs,l*4+4);
dec(amount,l*4+4);
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
{$endif logging}
End
Else
Begin
{$ifdef logging}
LogLn('Leftover: '+strf(amount)+' at offset '+hexstr(offs,8));
{$endif logging}
x := offs mod bytesperline - StartXViewPort;
For l := 0 to amount - 1 do
WordArray(Data)[index+l] := GetPixVESA256(x+l,y);
amount := 0
End
Until amount = 0;
end;
procedure HLineVESA256(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc} procedure HLineVESA256(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
var Offs: Longint; var Offs: Longint;
@ -2295,7 +2373,15 @@ end;
{ {
$Log$ $Log$
Revision 1.7 1999-12-10 12:52:54 pierre Revision 1.8 1999-12-11 23:41:39 jonas
* changed definition of getscanlineproc to "getscanline(x1,x2,y:
integer; var data);" so it can be used by getimage too
* changed getimage so it uses getscanline
* changed floodfill, getscanline16 and definitions in Linux
include files so they use this new format
+ getscanlineVESA256 for 256 color VESA modes (banked)
Revision 1.7 1999/12/10 12:52:54 pierre
* some LinearFrameBuffer code, not finished * some LinearFrameBuffer code, not finished
Revision 1.6 1999/12/09 02:06:00 carl Revision 1.6 1999/12/09 02:06:00 carl

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

@ -450,9 +450,9 @@ var
s1 := s3; s1 := s3;
s3 := stemp; s3 := stemp;
End End
Else GetScanline (y,s1^); Else GetScanline(0,ViewWidth,y,s1^);
GetScanline (y-1,s2^); GetScanline(0,ViewWidth,y-1,s2^);
GetScanline (y+1,s3^); GetScanline(0,ViewWidth,y+1,s3^);
prevy := y; prevy := y;
{ check the current scan line } { check the current scan line }
While (s1^[x]<>Border) And (x<=ViewWidth) Do Inc (x); While (s1^[x]<>Border) And (x<=ViewWidth) Do Inc (x);
@ -509,7 +509,15 @@ var
{ {
$Log$ $Log$
Revision 1.11 1999-09-27 23:34:40 peter Revision 1.12 1999-12-11 23:41:38 jonas
* changed definition of getscanlineproc to "getscanline(x1,x2,y:
integer; var data);" so it can be used by getimage too
* changed getimage so it uses getscanline
* changed floodfill, getscanline16 and definitions in Linux
include files so they use this new format
+ getscanlineVESA256 for 256 color VESA modes (banked)
Revision 1.11 1999/09/27 23:34:40 peter
* new graph unit is default for go32v2 * new graph unit is default for go32v2
* removed warnings/notes * removed warnings/notes

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

@ -483,8 +483,9 @@ TYPE
lineproc = procedure (X1, Y1, X2, Y2 : Integer); lineproc = procedure (X1, Y1, X2, Y2 : Integer);
{ this routine is used for FloodFill - it returns an entire } { this routine is used for FloodFill - it returns an entire }
{ screen scan line with a word for each pixel in the scanline } { screen scan line with a word for each pixel in the scanline. }
getscanlineproc = procedure (Y : integer; var data); { Also handy for GetImage, so I added x coords as well (JM) }
getscanlineproc = procedure (X1, X2, Y : integer; var data);
{ changes the active display screen where we draw to... } { changes the active display screen where we draw to... }
setactivepageproc = procedure (page: word); setactivepageproc = procedure (page: word);
@ -1921,7 +1922,7 @@ end;
{--------------------------------------------------------------------------} {--------------------------------------------------------------------------}
Procedure GetScanlineDefault (Y : Integer; Var Data); {$ifndef fpc}far;{$endif fpc} Procedure GetScanlineDefault (X1, X2, Y : Integer; Var Data); {$ifndef fpc}far;{$endif fpc}
{**********************************************************} {**********************************************************}
{ Procedure GetScanLine() } { Procedure GetScanLine() }
{----------------------------------------------------------} {----------------------------------------------------------}
@ -1929,14 +1930,16 @@ end;
{ coordinate. The values are returned in a WORD array } { coordinate. The values are returned in a WORD array }
{ each WORD representing a pixel of the specified scanline } { each WORD representing a pixel of the specified scanline }
{ note: we only need the pixels inside the ViewPort! (JM) } { note: we only need the pixels inside the ViewPort! (JM) }
{ note2: extended so you can specify start and end X coord }
{ so it is usable for GetImage too (JM) }
{**********************************************************} {**********************************************************}
Var Var
x : Integer; x : Integer;
Begin Begin
For x:=0 to ViewWidth Do For x:=X1 to X2 Do
WordArray(Data)[x]:=GetPixel(x, y); WordArray(Data)[x-x1]:=GetPixel(x, y);
End; End;
@ -1991,18 +1994,12 @@ var
i,j: integer; i,j: integer;
k: longint; k: longint;
Begin Begin
k:= 3 * Sizeof(longint) div Sizeof(word); { Three reserved longs at start of bitmap } k:= 3 * Sizeof(longint) div sizeof(word); { Three reserved longs at start of bitmap }
i := x2 - x1 + 1;
for j:=Y1 to Y2 do for j:=Y1 to Y2 do
Begin Begin
for i:=X1 to X2 do GetScanLine(x1,x2,j,pt(Bitmap)[k]);
begin inc(k,i);
{$R-}
pt(Bitmap)[k] :=getpixel(i,j);
{$ifdef debug}
{$R+}
{$endif debug}
Inc(k);
end;
end; end;
ptw(Bitmap)[0] := X2-X1; { First longint is width } ptw(Bitmap)[0] := X2-X1; { First longint is width }
ptw(Bitmap)[1] := Y2-Y1; { Second longint is height } ptw(Bitmap)[1] := Y2-Y1; { Second longint is height }
@ -3008,7 +3005,15 @@ SetGraphBufSize
{ {
$Log$ $Log$
Revision 1.45 1999-12-10 12:47:41 pierre Revision 1.46 1999-12-11 23:41:38 jonas
* changed definition of getscanlineproc to "getscanline(x1,x2,y:
integer; var data);" so it can be used by getimage too
* changed getimage so it uses getscanline
* changed floodfill, getscanline16 and definitions in Linux
include files so they use this new format
+ getscanlineVESA256 for 256 color VESA modes (banked)
Revision 1.45 1999/12/10 12:47:41 pierre
* SetBkColor like BP by changing Palette entry zero * SetBkColor like BP by changing Palette entry zero
Revision 1.44 1999/11/30 08:57:46 michael Revision 1.44 1999/11/30 08:57:46 michael

70
rtl/linux/ggigraph.inc
View File

@ -16,7 +16,7 @@
{$LINKLIB c} {$LINKLIB c}
{$PACKRECORDS C} {$PACKRECORDS C}
const const
InternalDriverName = 'LinuxGGI'; InternalDriverName = 'LinuxGGI';
@ -91,7 +91,7 @@ Const
G1600x1200x16M32 = 49; G1600x1200x16M32 = 49;
GLASTMODE = 49; GLASTMODE = 49;
ModeNames: array[0..GLastMode] of PChar = ModeNames: array[0..GLastMode] of PChar =
('[]', {Let GGI choose a default mode} ('[]', {Let GGI choose a default mode}
'S320x200[GT_4BIT]', 'S320x200[GT_4BIT]',
'S640x200[GT_4BIT]', 'S640x200[GT_4BIT]',
@ -170,7 +170,7 @@ type
dpp: TGGICoord; // dots per pixel dpp: TGGICoord; // dots per pixel
end; end;
const const
libggi = 'ggi'; libggi = 'ggi';
function ggiInit: Integer; cdecl; external libggi; function ggiInit: Integer; cdecl; external libggi;
procedure ggiExit; cdecl; external libggi; procedure ggiExit; cdecl; external libggi;
@ -197,7 +197,7 @@ var
Visual: TGGIVisual; Visual: TGGIVisual;
CurrentMode, OldMode: TGGIMode; CurrentMode, OldMode: TGGIMode;
procedure ggi_savevideostate; procedure ggi_savevideostate;
begin begin
ggiGetMode(Visual, OldMode); ggiGetMode(Visual, OldMode);
@ -243,7 +243,7 @@ begin
if ClipCoords then begin if ClipCoords then begin
ClipCoords := (y < StartXViewPort) or (x > (StartXViewPort + ViewWidth)); ClipCoords := (y < StartXViewPort) or (x > (StartXViewPort + ViewWidth));
ClipCoords := ClipCoords or ClipCoords := ClipCoords or
((y < StartYViewPort) or (y > (StartYViewPort + ViewHeight))); ((y < StartYViewPort) or (y > (StartYViewPort + ViewHeight)));
ClipCoords := not ClipCoords; ClipCoords := not ClipCoords;
end; end;
end; end;
@ -256,20 +256,20 @@ begin
CurCol := ggiMapColor(Visual, BgiColors[CurrentColor]); CurCol := ggiMapColor(Visual, BgiColors[CurrentColor]);
case CurrentWriteMode of case CurrentWriteMode of
XORPut: begin XORPut: begin
{ getpixel wants local/relative coordinates } { getpixel wants local/relative coordinates }
ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color); ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color);
Color := CurCol xor Color; Color := CurCol xor Color;
end; end;
OrPut: begin OrPut: begin
{ getpixel wants local/relative coordinates } { getpixel wants local/relative coordinates }
ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color); ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color);
Color := CurCol or Color; Color := CurCol or Color;
end; end;
AndPut: begin AndPut: begin
{ getpixel wants local/relative coordinates } { getpixel wants local/relative coordinates }
ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color); ggiGetPixel(Visual, x-StartXViewPort, y-StartYViewPort, Color);
Color := CurCol and Color; Color := CurCol and Color;
end; end;
NotPut: NotPut:
Color := not Color; Color := not Color;
else else
@ -303,10 +303,10 @@ end;
type type
PBitmap = ^TBitmap; PBitmap = ^TBitmap;
TBitmap = record TBitmap = record
Width, Height: longint; Width, Height: longint;
reserved : longint; reserved : longint;
Data: record end; Data: record end;
end; end;
procedure ggi_putimageproc (X,Y: Integer; var Bitmap; BitBlt: Word); procedure ggi_putimageproc (X,Y: Integer; var Bitmap; BitBlt: Word);
begin begin
@ -326,7 +326,7 @@ end;
function ggi_imagesizeproc (X1,Y1,X2,Y2: Integer): longint; function ggi_imagesizeproc (X1,Y1,X2,Y2: Integer): longint;
begin begin
// 32 bits per pixel -- change ASAP !! // 32 bits per pixel -- change ASAP !!
ggi_imagesizeproc := SizeOf(TBitmap) + (x2 - x1 + 1) * (y2 - y1 + 1) * SizeOF(longint); ggi_imagesizeproc := SizeOf(TBitmap) + (x2 - x1 + 1) * (y2 - y1 + 1) * SizeOF(longint);
end; end;
@ -351,7 +351,7 @@ procedure ggi_lineproc (X1, Y1, X2, Y2 : Integer);
begin begin
end; end;
procedure ggi_getscanlineproc (Y : integer; var data); procedure ggi_getscanlineproc (X1, X2, Y : integer; var data);
begin begin
end; end;
@ -380,11 +380,11 @@ begin
col.r:=redvalue; col.r:=redvalue;
col.g:=greenvalue; col.g:=greenvalue;
col.b:=bluevalue; col.b:=bluevalue;
ggisetpalette(Visual,ColorNum,1,col); ggisetpalette(Visual,ColorNum,1,col);
end; end;
procedure ggi_getrgbpaletteproc (ColorNum: integer; procedure ggi_getrgbpaletteproc (ColorNum: integer;
var RedValue, GreenValue, BlueValue: Integer); var RedValue, GreenValue, BlueValue: Integer);
Var Col : TGGIColor; Var Col : TGGIColor;
@ -394,7 +394,7 @@ begin
GreenValue:=Col.G; GreenValue:=Col.G;
BlueValue:=Col.B; BlueValue:=Col.B;
end; end;
{************************************************************************} {************************************************************************}
{* General routines *} {* General routines *}
{************************************************************************} {************************************************************************}
@ -435,7 +435,7 @@ var
MaxColor := 255; MaxColor := 255;
PaletteSize := MaxColor; PaletteSize := MaxColor;
HardwarePages := 0; HardwarePages := 0;
// necessary hooks ... // necessary hooks ...
DirectPutPixel := @ggi_DirectPixelProc; DirectPutPixel := @ggi_DirectPixelProc;
GetPixel := @ggi_GetPixelProc; GetPixel := @ggi_GetPixelProc;
PutPixel := @ggi_PutPixelProc; PutPixel := @ggi_PutPixelProc;
@ -445,7 +445,7 @@ var
PutImage := @ggi_PutImageProc; PutImage := @ggi_PutImageProc;
GetImage := @ggi_GetImageProc; GetImage := @ggi_GetImageProc;
ImageSize := @ggi_ImageSizeProc; ImageSize := @ggi_ImageSizeProc;
{ Add later maybe ? { Add later maybe ?
SetVisualPage := SetVisualPageProc; SetVisualPage := SetVisualPageProc;
SetActivePage := SetActivePageProc; SetActivePage := SetActivePageProc;
GetScanLine := @ggi_GetScanLineProc; GetScanLine := @ggi_GetScanLineProc;
@ -471,14 +471,14 @@ begin
if Assigned(ModeList) then if Assigned(ModeList) then
exit; exit;
SaveVideoState:=ggi_savevideostate; SaveVideoState:=ggi_savevideostate;
RestoreVideoState:=ggi_restorevideostate; RestoreVideoState:=ggi_restorevideostate;
If ggiInit <> 0 then begin If ggiInit <> 0 then begin
_graphresult := grNoInitGraph; _graphresult := grNoInitGraph;
exit; exit;
end; end;
Visual := ggiOpen(nil, []); // Use default visual Visual := ggiOpen(nil, []); // Use default visual
ggiGetMode(Visual, OldMode); ggiGetMode(Visual, OldMode);
ggiParseMode('', ModeInfo); ggiParseMode('', ModeInfo);
@ -500,7 +500,15 @@ end;
{ {
$Log$ $Log$
Revision 1.5 1999-11-12 02:13:01 carl Revision 1.6 1999-12-11 23:41:39 jonas
* changed definition of getscanlineproc to "getscanline(x1,x2,y:
integer; var data);" so it can be used by getimage too
* changed getimage so it uses getscanline
* changed floodfill, getscanline16 and definitions in Linux
include files so they use this new format
+ getscanlineVESA256 for 256 color VESA modes (banked)
Revision 1.5 1999/11/12 02:13:01 carl
* Bugfix if getimage / putimage, format was not standard with FPC * Bugfix if getimage / putimage, format was not standard with FPC
graph. graph.

52
rtl/linux/vgagraph.inc
View File

@ -13,7 +13,7 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************} **********************************************************************}
const const
InternalDriverName = 'LinuxVGA'; InternalDriverName = 'LinuxVGA';
@ -147,7 +147,7 @@ Const
G1600x1200x16M32 = 49; G1600x1200x16M32 = 49;
GLASTMODE = 49; GLASTMODE = 49;
ModeNames : Array[0..GLastMode] of string [18] = ModeNames : Array[0..GLastMode] of string [18] =
('Text', ('Text',
'G320x200x16', 'G320x200x16',
'G640x200x16', 'G640x200x16',
@ -222,7 +222,7 @@ var
{ --------------------------------------------------------------------- { ---------------------------------------------------------------------
Required procedures Required procedures
---------------------------------------------------------------------} ---------------------------------------------------------------------}
procedure libvga_savevideostate; procedure libvga_savevideostate;
begin begin
@ -255,17 +255,17 @@ end;
procedure libvga_initmodeproc; procedure libvga_initmodeproc;
begin begin
vga_setmode(IntCurrentMode); vga_setmode(IntCurrentMode);
gl_setcontextvga(IntCurrentMode); gl_setcontextvga(IntCurrentMode);
PhysicalScreen := gl_allocatecontext; PhysicalScreen := gl_allocatecontext;
gl_getcontext(PhysicalScreen); gl_getcontext(PhysicalScreen);
if (PhysicalScreen^.colors = 256) then gl_setrgbpalette; if (PhysicalScreen^.colors = 256) then gl_setrgbpalette;
InitColors; InitColors;
end; end;
Function ClipCoords (Var X,Y : Integer) : Boolean; Function ClipCoords (Var X,Y : Integer) : Boolean;
{ Adapt to viewport, return TRUE if still in viewport, { Adapt to viewport, return TRUE if still in viewport,
false if outside viewport} false if outside viewport}
begin begin
X:= X + StartXViewPort; X:= X + StartXViewPort;
Y:= Y + StartYViewPort; Y:= Y + StartYViewPort;
@ -276,8 +276,8 @@ begin
ClipCoords:=ClipCoords or ClipCoords:=ClipCoords or
((Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight))); ((Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)));
ClipCoords:=Not ClipCoords; ClipCoords:=Not ClipCoords;
end; end;
end; end;
procedure libvga_directpixelproc(X,Y: Integer); procedure libvga_directpixelproc(X,Y: Integer);
@ -292,24 +292,24 @@ begin
Color := GetPixel(x-StartXViewPort,y-StartYViewPort); Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
Color := CurrentColor Xor Color; Color := CurrentColor Xor Color;
end; end;
OrPut: OrPut:
begin begin
{ getpixel wants local/relative coordinates } { getpixel wants local/relative coordinates }
Color := GetPixel(x-StartXViewPort,y-StartYViewPort); Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
Color := CurrentColor Or Color; Color := CurrentColor Or Color;
end; end;
AndPut: AndPut:
begin begin
{ getpixel wants local/relative coordinates } { getpixel wants local/relative coordinates }
Color := GetPixel(x-StartXViewPort,y-StartYViewPort); Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
Color := CurrentColor And Color; Color := CurrentColor And Color;
end; end;
NotPut: NotPut:
begin begin
Color := Not Color; Color := Not Color;
end end
else else
Color:=CurrentColor; Color:=CurrentColor;
end; end;
gl_setpixel(x, y, Color); gl_setpixel(x, y, Color);
end; end;
@ -381,7 +381,7 @@ procedure libvga_lineproc (X1, Y1, X2, Y2 : Integer);
begin begin
end; end;
procedure libvga_getscanlineproc (Y : integer; var data); procedure libvga_getscanlineproc (X1,X2,Y : integer; var data);
begin begin
end; end;
@ -404,10 +404,10 @@ end;
procedure libvga_setrgbpaletteproc(ColorNum, RedValue, GreenValue, BlueValue: Integer); procedure libvga_setrgbpaletteproc(ColorNum, RedValue, GreenValue, BlueValue: Integer);
begin begin
gl_setpalettecolor(ColorNum,RedValue,GreenValue,BlueValue); gl_setpalettecolor(ColorNum,RedValue,GreenValue,BlueValue);
end; end;
procedure libvga_getrgbpaletteproc (ColorNum: integer; procedure libvga_getrgbpaletteproc (ColorNum: integer;
var RedValue, GreenValue, BlueValue: Integer); var RedValue, GreenValue, BlueValue: Integer);
Var R,G,B : longint; Var R,G,B : longint;
@ -418,7 +418,7 @@ begin
GreenValue:=G; GreenValue:=G;
BlueValue:=B; BlueValue:=B;
end; end;
{************************************************************************} {************************************************************************}
{* General routines *} {* General routines *}
{************************************************************************} {************************************************************************}
@ -443,7 +443,7 @@ end;
mode: TModeInfo; mode: TModeInfo;
modeinfo : vga_modeinfo; modeinfo : vga_modeinfo;
i : longint; i : longint;
begin begin
QueryAdapterInfo := ModeList; QueryAdapterInfo := ModeList;
{ If the mode listing already exists... } { If the mode listing already exists... }
@ -452,13 +452,13 @@ end;
if assigned(ModeList) then if assigned(ModeList) then
exit; exit;
SaveVideoState:=libvga_savevideostate; SaveVideoState:=libvga_savevideostate;
RestoreVideoState:=libvga_restorevideostate; RestoreVideoState:=libvga_restorevideostate;
vga_init; vga_init;
For I:=0 to GLastMode do For I:=0 to GLastMode do
begin begin
If vga_hasmode(I) then If vga_hasmode(I) then
begin begin
ModeInfo:=vga_getmodeinfo(i)^; ModeInfo:=vga_getmodeinfo(i)^;
InitMode(Mode); InitMode(Mode);
With Mode do With Mode do
begin begin
@ -471,7 +471,7 @@ end;
MaxColor := ModeInfo.colors; MaxColor := ModeInfo.colors;
PaletteSize := MaxColor; PaletteSize := MaxColor;
HardwarePages := 0; HardwarePages := 0;
// necessary hooks ... // necessary hooks ...
DirectPutPixel := @libvga_DirectPixelProc; DirectPutPixel := @libvga_DirectPixelProc;
GetPixel := @Libvga_GetPixelProc; GetPixel := @Libvga_GetPixelProc;
PutPixel := @libvga_PutPixelProc; PutPixel := @libvga_PutPixelProc;
@ -481,7 +481,7 @@ end;
PutImage := @Libvga_PutImageProc; PutImage := @Libvga_PutImageProc;
GetImage := @libvga_GetImageProc; GetImage := @libvga_GetImageProc;
ImageSize := @libvga_ImageSizeProc; ImageSize := @libvga_ImageSizeProc;
{ Add later maybe ? { Add later maybe ?
SetVisualPage := SetVisualPageProc; SetVisualPage := SetVisualPageProc;
SetActivePage := SetActivePageProc; SetActivePage := SetActivePageProc;
GetScanLine := @libvga_GetScanLineProc; GetScanLine := @libvga_GetScanLineProc;
@ -500,7 +500,15 @@ end;
{ {
$Log$ $Log$
Revision 1.2 1999-11-08 00:08:43 michael Revision 1.3 1999-12-11 23:41:39 jonas
* changed definition of getscanlineproc to "getscanline(x1,x2,y:
integer; var data);" so it can be used by getimage too
* changed getimage so it uses getscanline
* changed floodfill, getscanline16 and definitions in Linux
include files so they use this new format
+ getscanlineVESA256 for 256 color VESA modes (banked)
Revision 1.2 1999/11/08 00:08:43 michael
* Fist working version of svgalib new graph unit * Fist working version of svgalib new graph unit
* Initial implementation of ggi new graph unit * Initial implementation of ggi new graph unit