mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-27 23:31:50 +01:00
441 lines
10 KiB
PHP
441 lines
10 KiB
PHP
{************************************************************************}
|
|
{* 4-bit planar VGA mode routines *}
|
|
{************************************************************************}
|
|
|
|
|
|
const
|
|
|
|
VideoOfs = 0;
|
|
|
|
|
|
var
|
|
|
|
VidMem: PByteArray;
|
|
ScrWidth: Integer;
|
|
|
|
|
|
procedure bytemove(var source, dest; count: Integer);
|
|
var
|
|
s, d: PByte;
|
|
begin
|
|
s := PByte(@source);
|
|
d := PByte(@dest);
|
|
while count > 0 do begin
|
|
d^ := s^;
|
|
Inc(d);
|
|
Inc(s);
|
|
Dec(count);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure PutPixel16(X,Y : Integer; Pixel: Word);
|
|
var
|
|
offset: word;
|
|
dummy: byte;
|
|
begin
|
|
Inc(x, StartXViewPort);
|
|
Inc(y, StartYViewPort);
|
|
{ convert to absolute coordinates and then verify clipping...}
|
|
if ClipPixels then
|
|
begin
|
|
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
|
|
exit;
|
|
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
|
|
exit;
|
|
end;
|
|
offset := y * 80 + (x shr 3) + VideoOfs;
|
|
WritePortW($3ce, $0f01); { Index 01 : Enable ops on all 4 planes }
|
|
WritePortW($3ce, (Pixel and $ff) shl 8); { Index 00 : Enable correct plane and write color }
|
|
|
|
WritePortW($3ce, 8 or ($8000 shr (x and $7)));{ Select correct bits to modify }
|
|
dummy := VidMem^[offset]; { Read data byte into VGA latch register }
|
|
VidMem^[offset] := dummy; { Write the data into video memory }
|
|
end;
|
|
|
|
|
|
function GetPixel16(X,Y: Integer):word;
|
|
var
|
|
dummy, offset: Word;
|
|
shift: byte;
|
|
begin
|
|
Inc(x, StartXViewPort);
|
|
Inc(y, StartYViewPort);
|
|
offset := Y * 80 + (x shr 3) + VideoOfs;
|
|
WritePortW($3ce, 4);
|
|
shift := 7 - (X and 7);
|
|
dummy := (VidMem^[offset] shr shift) and 1;
|
|
WritePortB($3cf, 1);
|
|
dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 1);
|
|
WritePortB($3cf, 2);
|
|
dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 2);
|
|
WritePortB($3cf, 3);
|
|
dummy := dummy or (((VidMem^[offset] shr shift) and 1) shl 3);
|
|
GetPixel16 := dummy;
|
|
end;
|
|
|
|
|
|
procedure GetScanLine16(x1, x2, y: integer; var data);
|
|
var
|
|
dummylong: longint;
|
|
Offset, count, count2, amount, index: word;
|
|
plane: byte;
|
|
begin
|
|
inc(x1,StartXViewPort);
|
|
inc(x2,StartXViewPort);
|
|
{$ifdef logging}
|
|
LogLn('GetScanLine16 start, length to get: '+strf(x2-x1+1)+' at y = '+strf(y));
|
|
{$Endif logging}
|
|
offset := (Y + StartYViewPort) * 80 + (x1 shr 3) + VideoOfs;
|
|
{$ifdef logging}
|
|
LogLn('Offset: '+HexStr(offset,4)+' - ' + strf(offset));
|
|
{$Endif logging}
|
|
{ first get enough pixels so offset is 32bit aligned }
|
|
amount := 0;
|
|
index := 0;
|
|
If ((x1 and 31) <> 0) Or
|
|
((x2-x1+1) < 32) Then
|
|
Begin
|
|
If ((x2-x1+1) >= 32+32-(x1 and 31)) Then
|
|
amount := 32-(x1 and 31)
|
|
Else amount := x2-x1+1;
|
|
{$ifdef logging}
|
|
LogLn('amount to align to 32bits or to get all: ' + strf(amount));
|
|
{$Endif logging}
|
|
For count := 0 to amount-1 do
|
|
WordArray(Data)[Count] := getpixel16(x1-StartXViewPort+Count,y);
|
|
index := amount;
|
|
Inc(Offset,(amount+7) shr 3);
|
|
{$ifdef logging}
|
|
LogLn('offset now: '+HexStr(offset,4)+' - ' + strf(offset));
|
|
LogLn('index now: '+strf(index));
|
|
{$Endif logging}
|
|
End;
|
|
amount := x2-x1+1 - amount;
|
|
{$ifdef logging}
|
|
LogLn('amount left: ' + strf(amount));
|
|
{$Endif logging}
|
|
If amount = 0 Then Exit;
|
|
WritePortB($3ce, 4);
|
|
{ first get everything from plane 3 (4th plane) }
|
|
WritePortB($3cf, 3);
|
|
Count := 0;
|
|
For Count := 1 to (amount shr 5) Do
|
|
Begin
|
|
dummylong := PLongInt(@VidMem^[offset+(Count-1)*4])^;
|
|
dummylong :=
|
|
((dummylong and $ff) shl 24) or
|
|
((dummylong and $ff00) shl 8) or
|
|
((dummylong and $ff0000) shr 8) or
|
|
((dummylong and $ff000000) shr 24);
|
|
For Count2 := 31 downto 0 Do
|
|
Begin
|
|
WordArray(Data)[index+Count2] := DummyLong and 1;
|
|
DummyLong := DummyLong shr 1;
|
|
End;
|
|
Inc(Index, 32);
|
|
End;
|
|
{ Now get the data from the 3 other planes }
|
|
plane := 3;
|
|
Repeat
|
|
Dec(Index,Count*32);
|
|
Dec(plane);
|
|
WritePortB($3cf, plane);
|
|
Count := 0;
|
|
For Count := 1 to (amount shr 5) Do
|
|
Begin
|
|
dummylong := PLongInt(@VidMem^[offset+(Count-1)*4])^;
|
|
dummylong :=
|
|
((dummylong and $ff) shl 24) or
|
|
((dummylong and $ff00) shl 8) or
|
|
((dummylong and $ff0000) shr 8) or
|
|
((dummylong and $ff000000) shr 24);
|
|
For Count2 := 31 downto 0 Do
|
|
Begin
|
|
WordArray(Data)[index+Count2] :=
|
|
(WordArray(Data)[index+Count2] shl 1) or (DummyLong and 1);
|
|
DummyLong := DummyLong shr 1;
|
|
End;
|
|
Inc(Index, 32);
|
|
End;
|
|
Until plane = 0;
|
|
amount := amount and 31;
|
|
Dec(index);
|
|
{$ifdef Logging}
|
|
LogLn('Last array index written to: '+strf(index));
|
|
LogLn('amount left: '+strf(amount)+' starting at x = '+strf(index+1));
|
|
{$Endif logging}
|
|
For Count := 1 to amount Do
|
|
WordArray(Data)[index+Count] := getpixel16(index+Count,y);
|
|
{$ifdef logging}
|
|
LogLn('First 32 bytes gotten with getscanline16: ');
|
|
If x2-x1+1 >= 32 Then
|
|
Count2 := 32
|
|
Else Count2 := x2-x1+1;
|
|
For Count := 0 to Count2-1 Do
|
|
Log(strf(WordArray(Data)[Count])+' ');
|
|
LogLn('');
|
|
If x2-x1+1 >= 32 Then
|
|
Begin
|
|
LogLn('Last 32 bytes gotten with getscanline16: ');
|
|
For Count := 31 downto 0 Do
|
|
Log(strf(WordArray(Data)[x2-x1-Count])+' ');
|
|
End;
|
|
LogLn('');
|
|
GetScanLineDefault(x1-StartXViewPort,x2-StartXViewPort,y,Data);
|
|
LogLn('First 32 bytes gotten with getscanlinedef: ');
|
|
If x2-x1+1 >= 32 Then
|
|
Count2 := 32
|
|
Else Count2 := x2-x1+1;
|
|
For Count := 0 to Count2-1 Do
|
|
Log(strf(WordArray(Data)[Count])+' ');
|
|
LogLn('');
|
|
If x2-x1+1 >= 32 Then
|
|
Begin
|
|
LogLn('Last 32 bytes gotten with getscanlinedef: ');
|
|
For Count := 31 downto 0 Do
|
|
Log(strf(WordArray(Data)[x2-x1-Count])+' ');
|
|
End;
|
|
LogLn('');
|
|
LogLn('GetScanLine16 end');
|
|
{$Endif logging}
|
|
end;
|
|
|
|
|
|
procedure DirectPutPixel16(X,Y : Integer);
|
|
{ x,y -> must be in global coordinates. No clipping. }
|
|
var
|
|
color: word;
|
|
offset: word;
|
|
dummy: byte;
|
|
begin
|
|
case CurrentWriteMode of
|
|
XORPut:
|
|
begin
|
|
{ getpixel wants local/relative coordinates }
|
|
Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
|
|
Color := CurrentColor xor Color;
|
|
end;
|
|
OrPut:
|
|
begin
|
|
{ getpixel wants local/relative coordinates }
|
|
Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
|
|
Color := CurrentColor or Color;
|
|
end;
|
|
AndPut:
|
|
begin
|
|
{ getpixel wants local/relative coordinates }
|
|
Color := GetPixel(x - StartXViewPort, y - StartYViewPort);
|
|
Color := CurrentColor and Color;
|
|
end;
|
|
NotPut:
|
|
Color := Not Color;
|
|
else
|
|
Color := CurrentColor;
|
|
end;
|
|
offset := Y * 80 + (X shr 3) + VideoOfs;
|
|
WritePortW($3ce, $f01);
|
|
WritePortW($3ce, Color shl 8);
|
|
WritePortW($3ce, 8 or $8000 shr (X and 7));
|
|
dummy := VidMem^[offset];
|
|
VidMem^[offset] := dummy;
|
|
end;
|
|
|
|
|
|
procedure HLine16(x, x2, y: Integer);
|
|
var
|
|
xtmp: Integer;
|
|
ScrOfs, HLength: Word;
|
|
LMask, RMask: Byte;
|
|
begin
|
|
{ must we swap the values? }
|
|
if x > x2 then
|
|
begin
|
|
xtmp := x2;
|
|
x2 := x;
|
|
x:= xtmp;
|
|
end;
|
|
{ First convert to global coordinates }
|
|
Inc(x, StartXViewPort);
|
|
Inc(x2, StartXViewPort);
|
|
Inc(y, StartYViewPort);
|
|
if ClipPixels and LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
|
|
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
|
|
exit;
|
|
|
|
ScrOfs := y * ScrWidth + x div 8;
|
|
HLength := x2 div 8 - x div 8;
|
|
LMask := $ff shr (x and 7);
|
|
{$ifopt r+}
|
|
{$define rangeOn}
|
|
{$r-}
|
|
{$endif}
|
|
{$ifopt q+}
|
|
{$define overflowOn}
|
|
{$q-}
|
|
{$endif}
|
|
RMask:=$ff shl (7 - (x2 and 7));
|
|
{$ifdef rangeOn}
|
|
{$undef rangeOn}
|
|
{$r+}
|
|
{$endif}
|
|
{$ifdef overflowOn}
|
|
{$undef overflowOn}
|
|
{$q+}
|
|
{$endif}
|
|
if HLength=0 then
|
|
LMask:=LMask and RMask;
|
|
WritePortB($3ce, 0);
|
|
if CurrentWriteMode <> NotPut Then
|
|
WritePortB($3cf, CurrentColor)
|
|
else
|
|
WritePortB($3cf, not CurrentColor);
|
|
WritePortW($3ce, $0f01);
|
|
WritePortB($3ce, 3);
|
|
case CurrentWriteMode of
|
|
XORPut:
|
|
WritePortB($3cf, 3 shl 3);
|
|
ANDPut:
|
|
WritePortB($3cf, 1 shl 3);
|
|
ORPut:
|
|
WritePortB($3cf, 2 shl 3);
|
|
NormalPut, NotPut:
|
|
WritePortB($3cf, 0)
|
|
else
|
|
WritePortB($3cf, 0)
|
|
end;
|
|
|
|
WritePortB($3ce, 8);
|
|
WritePortB($3cf, LMask);
|
|
{$ifopt r+}
|
|
{$define rangeOn}
|
|
{$r-}
|
|
{$endif}
|
|
{$ifopt q+}
|
|
{$define overflowOn}
|
|
{$q-}
|
|
{$endif}
|
|
VidMem^[ScrOfs] := VidMem^[ScrOfs] + 1;
|
|
{$ifdef rangeOn}
|
|
{$undef rangeOn}
|
|
{$r+}
|
|
{$endif}
|
|
{$ifdef overflowOn}
|
|
{$undef overflowOn}
|
|
{$q+}
|
|
{$endif}
|
|
if HLength>0 then
|
|
begin
|
|
Dec(HLength);
|
|
Inc(ScrOfs);
|
|
if HLength>0 then
|
|
begin
|
|
WritePortW($3ce, $ff08);
|
|
bytemove(VidMem^[ScrOfs], VidMem^[ScrOfs], HLength);
|
|
Inc(ScrOfs, HLength);
|
|
end else
|
|
WritePortB($3ce, 8);
|
|
WritePortB($3cf, RMask);
|
|
{$ifopt r+}
|
|
{$define rangeOn}
|
|
{$r-}
|
|
{$endif}
|
|
{$ifopt q+}
|
|
{$define overflowOn}
|
|
{$q-}
|
|
{$endif}
|
|
VidMem^[ScrOfs] := VidMem^[ScrOfs] + 1;
|
|
{$ifdef rangeOn}
|
|
{$undef rangeOn}
|
|
{$r+}
|
|
{$endif}
|
|
{$ifdef overflowOn}
|
|
{$undef overflowOn}
|
|
{$q+}
|
|
{$endif}
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure VLine16(x,y,y2: integer);
|
|
var
|
|
ytmp: integer;
|
|
ScrOfs,i: longint;
|
|
BitMask: byte;
|
|
|
|
begin
|
|
{ must we swap the values? }
|
|
if y > y2 then
|
|
begin
|
|
ytmp := y2;
|
|
y2 := y;
|
|
y:= ytmp;
|
|
end;
|
|
{ First convert to global coordinates }
|
|
Inc(x, StartXViewPort);
|
|
Inc(y, StartYViewPort);
|
|
Inc(y2, StartYViewPort);
|
|
if ClipPixels and LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
|
|
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
|
|
exit;
|
|
ScrOfs:=y*ScrWidth+x div 8;
|
|
BitMask:=$80 shr (x and 7);
|
|
WritePortB($3ce, 0);
|
|
if CurrentWriteMode <> NotPut then
|
|
WritePortB($3cf, CurrentColor)
|
|
else
|
|
WritePortB($3cf, not CurrentColor);
|
|
WritePortW($3ce, $0f01);
|
|
WritePortB($3ce, 8);
|
|
WritePortB($3cf, BitMask);
|
|
WritePortB($3ce, 3);
|
|
case CurrentWriteMode of
|
|
XORPut:
|
|
WritePortB($3cf, 3 shl 3);
|
|
ANDPut:
|
|
WritePortB($3cf, 1 shl 3);
|
|
ORPut:
|
|
WritePortB($3cf, 2 shl 3);
|
|
NormalPut, NotPut:
|
|
WritePortB($3cf, 0)
|
|
else
|
|
WritePortB($3cf, 0)
|
|
end;
|
|
for i:=y to y2 do
|
|
begin
|
|
{$ifopt r+}
|
|
{$define rangeOn}
|
|
{$r-}
|
|
{$endif}
|
|
{$ifopt q+}
|
|
{$define overflowOn}
|
|
{$q-}
|
|
{$endif}
|
|
VidMem^[ScrOfs]:=VidMem^[ScrOfs]+1;
|
|
{$ifdef rangeOn}
|
|
{$undef rangeOn}
|
|
{$r+}
|
|
{$endif}
|
|
{$ifdef overflowOn}
|
|
{$undef overflowOn}
|
|
{$q+}
|
|
{$endif}
|
|
Inc(ScrOfs, ScrWidth);
|
|
end;
|
|
end;
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.1 2000-10-12 09:38:34 peter
|
|
* renamed to be 8.3
|
|
|
|
Revision 1.2 2000/09/18 13:14:51 marco
|
|
* Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
|
|
|
|
Revision 1.2 2000/07/13 11:33:49 michael
|
|
+ removed logs
|
|
|
|
}
|