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

--- Merging r29781 into '.':

Browse Source 
U    packages/graph/src/win32/graph.pp
--- Recording mergeinfo for merge of r29781 into '.':
 U   .
--- Merging r30246 into '.':
U    packages/graph/src/go32v2/graph.pp
U    packages/graph/src/go32v2/vesa.inc
--- Recording mergeinfo for merge of r30246 into '.':
 G   .
--- Merging r30247 into '.':
G    packages/graph/src/go32v2/vesa.inc
U    packages/graph/src/msdos/vesa.inc
--- Recording mergeinfo for merge of r30247 into '.':
 G   .
--- Merging r30248 into '.':
G    packages/graph/src/go32v2/vesa.inc
G    packages/graph/src/msdos/vesa.inc
--- Recording mergeinfo for merge of r30248 into '.':
 G   .
--- Merging r30249 into '.':
G    packages/graph/src/msdos/vesa.inc
U    packages/graph/src/msdos/graph.pp
--- Recording mergeinfo for merge of r30249 into '.':
 G   .
--- Merging r30262 into '.':
G    packages/graph/src/msdos/graph.pp
--- Recording mergeinfo for merge of r30262 into '.':
 G   .
--- Merging r30263 into '.':
G    packages/graph/src/msdos/graph.pp
G    packages/graph/src/msdos/vesa.inc
--- Recording mergeinfo for merge of r30263 into '.':
 G   .
--- Merging r30281 into '.':
G    packages/graph/src/go32v2/graph.pp
--- Recording mergeinfo for merge of r30281 into '.':
 G   .
--- Merging r30282 into '.':
G    packages/graph/src/go32v2/graph.pp
--- Recording mergeinfo for merge of r30282 into '.':
 G   .
--- Merging r30283 into '.':
G    packages/graph/src/go32v2/graph.pp
--- Recording mergeinfo for merge of r30283 into '.':
 G   .
--- Merging r30284 into '.':
U    packages/graph/src/ptcgraph/ptcgraph.pp
--- Recording mergeinfo for merge of r30284 into '.':
 G   .
--- Merging r30285 into '.':
G    packages/graph/src/msdos/graph.pp
--- Recording mergeinfo for merge of r30285 into '.':
 G   .

# revisions: 29781,30246,30247,30248,30249,30262,30263,30281,30282,30283,30284,30285

git-svn-id: branches/fixes_3_0@31104 -
This commit is contained in:
marco 2015-06-17 19:35:36 +00:00
parent 826f66757a
commit 5b66aee3f5
6 changed files with 974 additions and 265 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

195
packages/graph/src/go32v2/graph.pp
View File

@ -2307,7 +2307,7 @@ End;
procedure SetVisual200(page: word); {$ifndef fpc}far;{$endif fpc} procedure SetVisual200(page: word); {$ifndef fpc}far;{$endif fpc}
{ two page supPort... } { four page support... }
begin begin
if page > HardwarePages then exit; if page > HardwarePages then exit;
asm asm
@ -2342,12 +2342,13 @@ End;
end; end;
procedure SetActive200(page: word); {$ifndef fpc}far;{$endif fpc} procedure SetActive200(page: word); {$ifndef fpc}far;{$endif fpc}
{ two page supPort... } { four page support... }
begin begin
case page of case page of
0 : VideoOfs := 0; 0 : VideoOfs := 0;
1 : VideoOfs := 16384; 1 : VideoOfs := 16384;
2 : VideoOfs := 32768; 2 : VideoOfs := 32768;
3 : VideoOfs := 49152;
else else
VideoOfs := 0; VideoOfs := 0;
end; end;
@ -3550,6 +3551,7 @@ const CrtAddress: word = 0;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette; mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA; mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
mode.HLine := {$ifdef fpc}@{$endif}HLineVESA32kOr64k;
end; end;
procedure FillCommonVESA32k(var mode: TModeInfo); procedure FillCommonVESA32k(var mode: TModeInfo);
@ -3566,11 +3568,14 @@ const CrtAddress: word = 0;
end; end;
var var
HGCDetected : Boolean; HGCDetected : Boolean = FALSE;
CGADetected : Boolean; { TRUE means real CGA, *not* EGA or VGA } CGADetected : Boolean = FALSE; { TRUE means real CGA, *not* EGA or VGA }
EGADetected : Boolean; { TRUE means EGA or higher (VGA) } EGAColorDetected : Boolean = FALSE; { TRUE means true EGA with a color monitor }
VGADetected : Boolean; EGAMonoDetected : Boolean = FALSE; { TRUE means true EGA with a monochrome (MDA) monitor }
MCGADetected : Boolean = FALSE;
VGADetected : Boolean = FALSE;
mode: TModeInfo; mode: TModeInfo;
regs: TDPMIRegisters;
begin begin
QueryAdapterInfo := ModeList; QueryAdapterInfo := ModeList;
{ If the mode listing already exists... } { If the mode listing already exists... }
@ -3579,92 +3584,83 @@ const CrtAddress: word = 0;
if assigned(ModeList) then if assigned(ModeList) then
exit; exit;
{ check if VGA/MCGA adapter supported... }
HGCDetected := FALSE; regs.ax:=$1a00;
CGADetected := FALSE; RealIntr($10,regs); { get display combination code...}
EGADetected := FALSE; if regs.al=$1a then
VGADetected := FALSE;
{ check if EGA adapter supPorted... }
asm
mov ah,12h
mov bx,0FF10h
{$ifdef fpc}
push ebx
push ebp
push esi
push edi
{$endif fpc}
int 10h { get EGA information }
{$ifdef fpc}
pop edi
pop esi
pop ebp
{$endif fpc}
cmp bh,0ffh
{$ifdef fpc}
pop ebx
{$endif fpc}
jz @noega
mov [EGADetected],TRUE
@noega:
end ['EBX','EAX'];
{$ifdef logging}
LogLn('EGA detected: '+strf(Longint(EGADetected)));
{$endif logging}
{ check if VGA adapter supPorted... }
if EGADetected then
begin begin
asm while regs.bx <> 0 do
mov ax,1a00h begin
{$ifdef fpc} case regs.bl of
push ebp 1: { monochrome adapter (MDA or HGC) }
push esi begin
push edi { check if Hercules adapter supported ... }
push ebx HGCDetected:=Test6845($3B4);
{$endif fpc} end;
int 10h { get display combination code...} 2: CGADetected:=TRUE;
{$ifdef fpc} 4: EGAColorDetected:=TRUE;
pop ebx 5: EGAMonoDetected:=TRUE;
pop edi {6: PGA, this is rare stuff, how do we handle it? }
pop esi 7, 8: VGADetected:=TRUE;
pop ebp 10, 11, 12: MCGADetected:=TRUE;
{$endif fpc} end;
cmp al,1ah { check if supPorted... } { check both primary and secondary display adapter }
jne @novga regs.bx:=regs.bx shr 8;
{ now check if this is the ATI EGA } end;
mov ax,1c00h { get state size for save... }
{ ... all imPortant data }
mov cx,07h
{$ifdef fpc}
push ebp
push esi
push edi
push ebx
{$endif fpc}
int 10h
{$ifdef fpc}
pop ebx
pop edi
pop esi
pop ebp
{$endif fpc}
cmp al,1ch { success? }
jne @novga
mov [VGADetected],TRUE
@novga:
end ['ECX','EAX'];
end; end;
{$ifdef logging} if VGADetected then
LogLn('VGA detected: '+strf(Longint(VGADetected)));
{$endif logging}
{ older than EGA? }
if not EGADetected then
begin begin
{ check if Hercules adapter supPorted ... } { now check if this is the ATI EGA }
regs.ax:=$1c00; { get state size for save... }
{ ... all important data }
regs.cx:=$07;
RealIntr($10,regs);
VGADetected:=regs.al=$1c;
end;
if not VGADetected and not MCGADetected and
not EGAColorDetected and not EGAMonoDetected and
not CGADetected and not HGCDetected then
begin
{ check if EGA adapter supported... }
regs.ah:=$12;
regs.bx:=$FF10;
RealIntr($10,regs); { get EGA information }
if regs.bh<>$FF then
case regs.cl of
0..3, { primary: MDA/HGC, secondary: EGA color }
6..9: { primary: EGA color, secondary: MDA/HGC (optional) }
begin
EGAColorDetected:=TRUE;
{ check if Hercules adapter supported ... }
HGCDetected:=Test6845($3B4);
end;
4..5, { primary: CGA, secondary: EGA mono }
10..11: { primary: EGA mono, secondary: CGA (optional) }
begin
EGAMonoDetected:=TRUE;
{ check if CGA adapter supported ... }
CGADetected := Test6845($3D4);
end;
end;
end;
{ older than EGA? }
if not VGADetected and not MCGADetected and
not EGAColorDetected and not EGAMonoDetected and
not CGADetected and not HGCDetected then
begin
{ check if Hercules adapter supported ... }
HGCDetected := Test6845($3B4); HGCDetected := Test6845($3B4);
{ check if CGA adapter supPorted ... } { check if CGA adapter supported ... }
CGADetected := Test6845($3D4); CGADetected := Test6845($3D4);
end; end;
{$ifdef logging}
LogLn('HGC detected: '+strf(Longint(HGCDetected)));
LogLn('CGA detected: '+strf(Longint(CGADetected)));
LogLn('EGA color detected: '+strf(Longint(EGAColorDetected)));
LogLn('EGA mono detected: '+strf(Longint(EGAMonoDetected)));
LogLn('MCGA detected: '+strf(Longint(MCGADetected)));
LogLn('VGA detected: '+strf(Longint(VGADetected)));
{$endif logging}
if HGCDetected then if HGCDetected then
begin begin
{ HACK: { HACK:
@ -3701,7 +3697,7 @@ const CrtAddress: word = 0;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
end; end;
if CGADetected or EGADetected then if CGADetected or EGAColorDetected or MCGADetected or VGADetected then
begin begin
{ HACK: { HACK:
until we create Save/RestoreStateCGA, we use Save/RestoreStateVGA until we create Save/RestoreStateCGA, we use Save/RestoreStateVGA
@ -3754,7 +3750,7 @@ const CrtAddress: word = 0;
AddMode(mode); AddMode(mode);
end; end;
if EGADetected then if EGAColorDetected or VGADetected then
begin begin
{ HACK: { HACK:
until we create Save/RestoreStateEGA, we use Save/RestoreStateVGA until we create Save/RestoreStateEGA, we use Save/RestoreStateVGA
@ -3772,7 +3768,7 @@ const CrtAddress: word = 0;
mode.ModeName:='640 x 200 EGA'; mode.ModeName:='640 x 200 EGA';
mode.MaxX := 639; mode.MaxX := 639;
mode.MaxY := 199; mode.MaxY := 199;
mode.HardwarePages := 2; mode.HardwarePages := 3;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200; mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16; mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;
@ -3796,8 +3792,14 @@ const CrtAddress: word = 0;
AddMode(mode); AddMode(mode);
end; end;
if VGADetected then if MCGADetected or VGADetected then
begin begin
{ HACK:
until we create Save/RestoreStateEGA, we use Save/RestoreStateVGA
with the inWindows flag enabled (so we only save the mode number
and nothing else) }
if not VGADetected then
inWindows := true;
SaveVideoState := @SaveStateVGA; SaveVideoState := @SaveStateVGA;
{$ifdef logging} {$ifdef logging}
LogLn('Setting VGA SaveVideoState to '+strf(longint(SaveVideoState))); LogLn('Setting VGA SaveVideoState to '+strf(longint(SaveVideoState)));
@ -3896,7 +3898,18 @@ const CrtAddress: word = 0;
mode.XAspect := 8333; mode.XAspect := 8333;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
end;
if VGADetected then
begin
SaveVideoState := @SaveStateVGA;
{$ifdef logging}
LogLn('Setting VGA SaveVideoState to '+strf(longint(SaveVideoState)));
{$endif logging}
RestoreVideoState := @RestoreStateVGA;
{$ifdef logging}
LogLn('Setting VGA RestoreVideoState to '+strf(longint(RestoreVideoState)));
{$endif logging}
{ now add all standard VGA modes... } { now add all standard VGA modes... }
InitMode(mode); InitMode(mode);
mode.DriverNumber:= LowRes; mode.DriverNumber:= LowRes;
@ -3928,7 +3941,7 @@ const CrtAddress: word = 0;
mode.ModeName:='640 x 200 EGA'; { yes, it says 'EGA' even for the VGA driver; this is TP7 compatible } mode.ModeName:='640 x 200 EGA'; { yes, it says 'EGA' even for the VGA driver; this is TP7 compatible }
mode.MaxX := 639; mode.MaxX := 639;
mode.MaxY := 199; mode.MaxY := 199;
mode.HardwarePages := 2; mode.HardwarePages := 3;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200; mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16; mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;

372
packages/graph/src/go32v2/vesa.inc
View File

@ -479,14 +479,14 @@ end;
If ((amount >= 4) and If ((amount >= 4) and
((offs and 3) = 0)) or ((offs and 3) = 0)) or
(amount >= 4+4-(offs and 3)) Then (amount >= 4+4-(offs and 3)) Then
{ allign target } { align target }
Begin Begin
If (offs and 3) <> 0 then If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 } { size of a window is always a multiple of 4 }
Begin Begin
{$ifdef logging} {$ifdef logging}
LogLn('Alligning by reading '+strf(4-(offs and 3))+' pixels'); LogLn('Aligning by reading '+strf(4-(offs and 3))+' pixels');
{$endif logging} {$endif logging}
for l := 1 to 4-(offs and 3) do for l := 1 to 4-(offs and 3) do
WordArray(Data)[index+l-1] := WordArray(Data)[index+l-1] :=
@ -498,7 +498,7 @@ end;
{$ifdef logging} {$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount)); LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
{$endif logging} {$endif logging}
{ offs is now 4-bytes alligned } { offs is now 4-bytes aligned }
If amount <= ($10000-(Offs and $ffff)) Then If amount <= ($10000-(Offs and $ffff)) Then
bankrest := amount bankrest := amount
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -599,24 +599,23 @@ end;
(HLength >= 4+4-(offs and 3)) Then (HLength >= 4+4-(offs and 3)) Then
{ align target } { align target }
Begin Begin
l := 0;
If (offs and 3) <> 0 then If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 } { size of a window is always a multiple of 4 }
Begin Begin
{$ifdef logging2} {$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels'); LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging2} {$endif logging2}
for l := 1 to 4-(offs and 3) do for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] := Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor); Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End; End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2} {$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength)); LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging} {$endif logging}
{ offs is now 4-bytes alligned } { offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength bankrest := HLength
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -669,26 +668,25 @@ end;
If ((HLength >= 4) and If ((HLength >= 4) and
((offs and 3) = 0)) or ((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then (HLength >= 4+4-(offs and 3)) Then
{ allign target } { align target }
Begin Begin
l := 0;
If (offs and 3) <> 0 then If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 } { size of a window is always a multiple of 4 }
Begin Begin
{$ifdef logging2} {$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels'); LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging} {$endif logging}
for l := 1 to 4-(offs and 3) do for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] := Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor); Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End; End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2} {$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength)); LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging} {$endif logging}
{ offs is now 4-bytes alligned } { offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength bankrest := HLength
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -741,22 +739,21 @@ end;
If ((HLength >= 4) and If ((HLength >= 4) and
((offs and 3) = 0)) or ((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then (HLength >= 4+4-(offs and 3)) Then
{ allign target } { align target }
Begin Begin
l := 0;
If (offs and 3) <> 0 then If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 } { size of a window is always a multiple of 4 }
Begin Begin
{$ifdef logging2} {$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels'); LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging} {$endif logging}
for l := 1 to 4-(offs and 3) do for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] := Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor); Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End; End;
Dec(HLength, l);
inc(offs, l);
{ it is possible that by aligningm we ended up in a new } { it is possible that by aligningm we ended up in a new }
{ bank, so set the correct bank again to make sure } { bank, so set the correct bank again to make sure }
setwritebank(offs shr 16); setwritebank(offs shr 16);
@ -764,7 +761,7 @@ end;
{$ifdef logging2} {$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength)); LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging} {$endif logging}
{ offs is now 4-bytes alligned } { offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength bankrest := HLength
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -814,25 +811,24 @@ end;
If ((HLength >= 4) and If ((HLength >= 4) and
((offs and 3) = 0)) or ((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then (HLength >= 4+4-(offs and 3)) Then
{ allign target } { align target }
Begin Begin
l := 0;
If (offs and 3) <> 0 then If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 } { size of a window is always a multiple of 4 }
Begin Begin
{$ifdef logging2} {$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels'); LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging} {$endif logging}
for l := 1 to 4-(offs and 3) do for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask); Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask);
Dec(HLength, l);
inc(offs, l);
End; End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2} {$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength)); LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging} {$endif logging}
{ offs is now 4-bytes alligned } { offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength bankrest := HLength
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -1092,7 +1088,6 @@ end;
(amount > 7+8-(offs and 7))) Then (amount > 7+8-(offs and 7))) Then
Begin Begin
{ align target } { align target }
l := 0;
If (offs and 7) <> 0 then If (offs and 7) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 8 } { size of a window is always a multiple of 8 }
@ -1107,13 +1102,13 @@ end;
Mem[WinWriteSeg:word(offs)+l-1] := fill.pat[patternPos and 7]; Mem[WinWriteSeg:word(offs)+l-1] := fill.pat[patternPos and 7];
inc(patternPos) inc(patternPos)
end; end;
Dec(amount, l);
inc(offs, l);
End; End;
Dec(amount, l);
inc(offs, l);
{$ifdef logging2} {$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount)); LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
{$endif logging2} {$endif logging2}
{ offs is now 8-bytes alligned } { offs is now 8-bytes aligned }
If amount <= ($10000-(Offs and $ffff)) Then If amount <= ($10000-(Offs and $ffff)) Then
bankrest := amount bankrest := amount
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -1377,6 +1372,323 @@ end;
End; End;
end; end;
procedure HLineVESA32kOr64k(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
var Offs: Longint;
mask, l, bankrest: longint;
curbank, hlength: smallint;
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 logging2}
LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
{$endif logging2}
HLength := x2 - x + 1;
{$ifdef logging2}
LogLn('length: '+strf(hlength));
{$endif logging2}
if HLength>0 then
begin
Offs:=(Longint(y)+YOffset)*bytesperline+2*x;
{$ifdef logging2}
LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
{$endif logging2}
Mask := longint(word(CurrentColor)+word(CurrentColor) shl 16);
Case CurrentWriteMode of
AndPut:
Begin
Repeat
curbank := smallint(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging2}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging2}
If ((HLength >= 2) and
((offs and 3) = 0)) or
(HLength >= 3) Then
{ align target }
Begin
If (offs and 3) <> 0 then
{ this cannot go past a window boundary because the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Aligning by drawing 1 pixel');
{$endif logging2}
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] And Word(CurrentColor);
Dec(HLength);
inc(offs, 2);
End;
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes aligned }
If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := ($10000 - (Offs and $ffff)) shr 1;
{ it is possible that by aligningm we ended up in a new }
{ bank, so set the correct bank again to make sure }
setwritebank(offs shr 16);
setreadbank(offs shr 16);
{$ifdef logging2}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 2)-1 Do
MemL[WinWriteSeg:word(offs)+l*4] :=
MemL[WinReadSeg:word(offs)+l*4] And Mask;
inc(offs,l*4+4);
dec(hlength,l*2+2);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging2}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
if HLength > 0 then
begin
{ this may cross a bank at any time, so adjust }
{ because this loop always runs for very little pixels, }
{ there's little gained by splitting it up }
setreadbank(offs shr 16);
setwritebank(offs shr 16);
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] And Word(currentColor);
HLength := 0
end;
End
Until HLength = 0;
End;
XorPut:
Begin
Repeat
curbank := smallint(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging2}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging2}
If ((HLength >= 2) and
((offs and 3) = 0)) or
(HLength >= 3) Then
{ align target }
Begin
If (offs and 3) <> 0 then
{ this cannot go past a window boundary because the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Aligning by drawing 1 pixel');
{$endif logging2}
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] Xor Word(CurrentColor);
Dec(HLength);
inc(offs, 2);
End;
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes aligned }
If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := ($10000 - (Offs and $ffff)) shr 1;
{ it is possible that by aligningm we ended up in a new }
{ bank, so set the correct bank again to make sure }
setwritebank(offs shr 16);
setreadbank(offs shr 16);
{$ifdef logging2}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 2)-1 Do
MemL[WinWriteSeg:word(offs)+l*4] :=
MemL[WinReadSeg:word(offs)+l*4] Xor Mask;
inc(offs,l*4+4);
dec(hlength,l*2+2);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging2}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
if HLength > 0 then
begin
{ this may cross a bank at any time, so adjust }
{ because this loop always runs for very little pixels, }
{ there's little gained by splitting it up }
setreadbank(offs shr 16);
setwritebank(offs shr 16);
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] Xor Word(currentColor);
HLength := 0
end;
End
Until HLength = 0;
End;
OrPut:
Begin
Repeat
curbank := smallint(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging2}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging2}
If ((HLength >= 2) and
((offs and 3) = 0)) or
(HLength >= 3) Then
{ align target }
Begin
If (offs and 3) <> 0 then
{ this cannot go past a window boundary because the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Aligning by drawing 1 pixel');
{$endif logging2}
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] Or Word(CurrentColor);
Dec(HLength);
inc(offs, 2);
End;
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes aligned }
If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := ($10000 - (Offs and $ffff)) shr 1;
{ it is possible that by aligningm we ended up in a new }
{ bank, so set the correct bank again to make sure }
setwritebank(offs shr 16);
setreadbank(offs shr 16);
{$ifdef logging2}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 2)-1 Do
MemL[WinWriteSeg:word(offs)+l*4] :=
MemL[WinReadSeg:word(offs)+l*4] Or Mask;
inc(offs,l*4+4);
dec(hlength,l*2+2);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging2}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
if HLength > 0 then
begin
{ this may cross a bank at any time, so adjust }
{ because this loop always runs for very little pixels, }
{ there's little gained by splitting it up }
setreadbank(offs shr 16);
setwritebank(offs shr 16);
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] Or Word(currentColor);
HLength := 0
end;
End
Until HLength = 0;
End
Else
Begin
If CurrentWriteMode = NotPut Then
Mask := Not(Mask);
Repeat
curbank := smallint(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging2}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging2}
If ((HLength >= 2) and
((offs and 3) = 0)) or
(HLength >= 3) Then
{ align target }
Begin
If (offs and 3) <> 0 then
{ this cannot go past a window boundary because the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Aligning by drawing 1 pixel');
{$endif logging2}
MemW[WinWriteSeg:word(offs)] := Word(Mask);
Dec(HLength);
inc(offs, 2);
End;
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes aligned }
If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := ($10000 - (Offs and $ffff)) shr 1;
{ it is possible that by aligningm we ended up in a new }
{ bank, so set the correct bank again to make sure }
setwritebank(offs shr 16);
setreadbank(offs shr 16);
{$ifdef logging2}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 2)-1 Do
MemL[WinWriteSeg:word(offs)+l*4] := Mask;
inc(offs,l*4+4);
dec(hlength,l*2+2);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging2}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
if HLength > 0 then
begin
{ this may cross a bank at any time, so adjust }
{ because this loop always runs for very little pixels, }
{ there's little gained by splitting it up }
setreadbank(offs shr 16);
setwritebank(offs shr 16);
MemW[WinWriteSeg:word(offs)] := Word(Mask);
HLength := 0
end;
End
Until HLength = 0;
End;
End;
end;
end;
{$ifdef FPC} {$ifdef FPC}
{************************************************************************} {************************************************************************}
{* 15/16bit pixels VESA mode routines Linear mode *} {* 15/16bit pixels VESA mode routines Linear mode *}

231
packages/graph/src/msdos/graph.pp
View File

@ -216,16 +216,16 @@ var
Offset: Word; Offset: Word;
B, Mask, Shift: Byte; B, Mask, Shift: Byte;
begin begin
X:= X + StartXViewPort; { verify clipping and then convert to absolute coordinates...}
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
if ClipPixels then if ClipPixels then
begin begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then if (X < 0) or (X > ViewWidth) then
exit; exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then if (Y < 0) or (Y > ViewHeight) then
exit; exit;
end; end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Offset := (Y shr 2) * 90 + (X shr 3) + VideoOfs; Offset := (Y shr 2) * 90 + (X shr 3) + VideoOfs;
case Y and 3 of case Y and 3 of
1: Inc(Offset, $2000); 1: Inc(Offset, $2000);
@ -620,16 +620,16 @@ var
Offset: Word; Offset: Word;
B, Mask, Shift: Byte; B, Mask, Shift: Byte;
begin begin
X:= X + StartXViewPort; { verify clipping and then convert to absolute coordinates...}
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
if ClipPixels then if ClipPixels then
begin begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then if (X < 0) or (X > ViewWidth) then
exit; exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then if (Y < 0) or (Y > ViewHeight) then
exit; exit;
end; end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Offset := (Y shr 1) * 80 + (X shr 2); Offset := (Y shr 1) * 80 + (X shr 2);
if (Y and 1) <> 0 then if (Y and 1) <> 0 then
Inc(Offset, 8192); Inc(Offset, 8192);
@ -930,16 +930,16 @@ var
Offset: Word; Offset: Word;
B, Mask, Shift: Byte; B, Mask, Shift: Byte;
begin begin
X:= X + StartXViewPort; { verify clipping and then convert to absolute coordinates...}
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
if ClipPixels then if ClipPixels then
begin begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then if (X < 0) or (X > ViewWidth) then
exit; exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then if (Y < 0) or (Y > ViewHeight) then
exit; exit;
end; end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Offset := (Y shr 1) * 80 + (X shr 3); Offset := (Y shr 1) * 80 + (X shr 3);
if (Y and 1) <> 0 then if (Y and 1) <> 0 then
Inc(Offset, 8192); Inc(Offset, 8192);
@ -1238,16 +1238,16 @@ var
Offset: Word; Offset: Word;
B, Mask, Shift: Byte; B, Mask, Shift: Byte;
begin begin
X:= X + StartXViewPort; { verify clipping and then convert to absolute coordinates...}
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
if ClipPixels then if ClipPixels then
begin begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then if (X < 0) or (X > ViewWidth) then
exit; exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then if (Y < 0) or (Y > ViewHeight) then
exit; exit;
end; end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Offset := Y * 80 + (X shr 3); Offset := Y * 80 + (X shr 3);
Shift := 7 - (X and 7); Shift := 7 - (X and 7);
Mask := 1 shl Shift; Mask := 1 shl Shift;
@ -1548,16 +1548,16 @@ end;
dummy: byte; dummy: byte;
{$endif asmgraph} {$endif asmgraph}
Begin Begin
{ verify clipping and then convert to absolute coordinates...}
if ClipPixels then
begin
if (X < 0) or (X > ViewWidth) then
exit;
if (Y < 0) or (Y > ViewHeight) then
exit;
end;
X:= X + StartXViewPort; X:= X + StartXViewPort;
Y:= Y + StartYViewPort; Y:= 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;
{$ifndef asmgraph} {$ifndef asmgraph}
offset := y * 80 + (x shr 3) + VideoOfs; offset := y * 80 + (x shr 3) + VideoOfs;
PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes } PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
@ -2261,7 +2261,7 @@ End;
procedure SetVisual200(page: word); {$ifndef fpc}far;{$endif fpc} procedure SetVisual200(page: word); {$ifndef fpc}far;{$endif fpc}
{ two page supPort... } { four page support... }
begin begin
if page > HardwarePages then exit; if page > HardwarePages then exit;
asm asm
@ -2296,12 +2296,13 @@ End;
end; end;
procedure SetActive200(page: word); {$ifndef fpc}far;{$endif fpc} procedure SetActive200(page: word); {$ifndef fpc}far;{$endif fpc}
{ two page supPort... } { four page support... }
begin begin
case page of case page of
0 : VideoOfs := 0; 0 : VideoOfs := 0;
1 : VideoOfs := 16384; 1 : VideoOfs := 16384;
2 : VideoOfs := 32768; 2 : VideoOfs := 32768;
3 : VideoOfs := 49152;
else else
VideoOfs := 0; VideoOfs := 0;
end; end;
@ -2363,16 +2364,16 @@ End;
Procedure PutPixel320(X,Y : smallint; Pixel: Word); {$ifndef fpc}far;{$endif fpc} Procedure PutPixel320(X,Y : smallint; 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. }
Begin Begin
{ verify clipping and then convert to absolute coordinates...}
if ClipPixels then
begin
if (X < 0) or (X > ViewWidth) then
exit;
if (Y < 0) or (Y > ViewHeight) then
exit;
end;
X:= X + StartXViewPort; X:= X + StartXViewPort;
Y:= Y + StartYViewPort; Y:= 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;
asm asm
mov es, [SegA000] mov es, [SegA000]
mov ax, [Y] mov ax, [Y]
@ -2706,16 +2707,16 @@ const CrtAddress: word = 0;
var offset: word; var offset: word;
{$endif asmgraph} {$endif asmgraph}
begin begin
{ verify clipping and then convert to absolute coordinates...}
if ClipPixels then
begin
if (X < 0) or (X > ViewWidth) then
exit;
if (Y < 0) or (Y > ViewHeight) then
exit;
end;
X:= X + StartXViewPort; X:= X + StartXViewPort;
Y:= Y + StartYViewPort; Y:= 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;
{$ifndef asmgraph} {$ifndef asmgraph}
offset := y * 80 + x shr 2 + VideoOfs; offset := y * 80 + x shr 2 + VideoOfs;
PortW[$3c4] := (hi(word(FirstPlane)) shl 8) shl (x and 3)+ lo(word(FirstPlane)); PortW[$3c4] := (hi(word(FirstPlane)) shl 8) shl (x and 3)+ lo(word(FirstPlane));
@ -3230,6 +3231,7 @@ const CrtAddress: word = 0;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette; mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA; mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
mode.HLine := {$ifdef fpc}@{$endif}HLineVESA32kOr64k;
end; end;
procedure FillCommonVESA32k(var mode: TModeInfo); procedure FillCommonVESA32k(var mode: TModeInfo);
@ -3246,10 +3248,12 @@ const CrtAddress: word = 0;
end; end;
var var
HGCDetected : Boolean; HGCDetected : Boolean = FALSE;
CGADetected : Boolean; { TRUE means real CGA, *not* EGA or VGA } CGADetected : Boolean = FALSE; { TRUE means real CGA, *not* EGA or VGA }
EGADetected : Boolean; { TRUE means EGA or higher (VGA) } EGAColorDetected : Boolean = FALSE; { TRUE means true EGA with a color monitor }
VGADetected : Boolean; EGAMonoDetected : Boolean = FALSE; { TRUE means true EGA with a monochrome (MDA) monitor }
MCGADetected : Boolean = FALSE;
VGADetected : Boolean = FALSE;
mode: TModeInfo; mode: TModeInfo;
regs: Registers; regs: Registers;
begin begin
@ -3260,45 +3264,83 @@ const CrtAddress: word = 0;
if assigned(ModeList) then if assigned(ModeList) then
exit; exit;
{ check if VGA/MCGA adapter supported... }
HGCDetected := FALSE; regs.ax:=$1a00;
CGADetected := FALSE; intr($10,regs); { get display combination code...}
EGADetected := FALSE; if regs.al=$1a then
VGADetected := FALSE;
{ check if EGA adapter supPorted... }
regs.ah:=$12;
regs.bx:=$FF10;
intr($10,regs); { get EGA information }
EGADetected:=regs.bh<>$FF;
{$ifdef logging}
LogLn('EGA detected: '+strf(Longint(EGADetected)));
{$endif logging}
{ check if VGA adapter supPorted... }
if EGADetected then
begin begin
regs.ax:=$1a00; while regs.bx <> 0 do
intr($10,regs); { get display combination code...}
if regs.al=$1a then
begin begin
{ now check if this is the ATI EGA } case regs.bl of
regs.ax:=$1c00; { get state size for save... } 1: { monochrome adapter (MDA or HGC) }
{ ... all imPortant data } begin
regs.cx:=$07; { check if Hercules adapter supported ... }
intr($10,regs); HGCDetected:=Test6845($3B4);
VGADetected:=regs.al=$1c; end;
2: CGADetected:=TRUE;
4: EGAColorDetected:=TRUE;
5: EGAMonoDetected:=TRUE;
{6: PGA, this is rare stuff, how do we handle it? }
7, 8: VGADetected:=TRUE;
10, 11, 12: MCGADetected:=TRUE;
end;
{ check both primary and secondary display adapter }
regs.bx:=regs.bx shr 8;
end; end;
end; end;
{$ifdef logging} if VGADetected then
LogLn('VGA detected: '+strf(Longint(VGADetected)));
{$endif logging}
{ older than EGA? }
if not EGADetected then
begin begin
{ check if Hercules adapter supPorted ... } { now check if this is the ATI EGA }
regs.ax:=$1c00; { get state size for save... }
{ ... all important data }
regs.cx:=$07;
intr($10,regs);
VGADetected:=regs.al=$1c;
end;
if not VGADetected and not MCGADetected and
not EGAColorDetected and not EGAMonoDetected and
not CGADetected and not HGCDetected then
begin
{ check if EGA adapter supported... }
regs.ah:=$12;
regs.bx:=$FF10;
intr($10,regs); { get EGA information }
if regs.bh<>$FF then
case regs.cl of
0..3, { primary: MDA/HGC, secondary: EGA color }
6..9: { primary: EGA color, secondary: MDA/HGC (optional) }
begin
EGAColorDetected:=TRUE;
{ check if Hercules adapter supported ... }
HGCDetected:=Test6845($3B4);
end;
4..5, { primary: CGA, secondary: EGA mono }
10..11: { primary: EGA mono, secondary: CGA (optional) }
begin
EGAMonoDetected:=TRUE;
{ check if CGA adapter supported ... }
CGADetected := Test6845($3D4);
end;
end;
end;
{ older than EGA? }
if not VGADetected and not MCGADetected and
not EGAColorDetected and not EGAMonoDetected and
not CGADetected and not HGCDetected then
begin
{ check if Hercules adapter supported ... }
HGCDetected := Test6845($3B4); HGCDetected := Test6845($3B4);
{ check if CGA adapter supPorted ... } { check if CGA adapter supported ... }
CGADetected := Test6845($3D4); CGADetected := Test6845($3D4);
end; end;
{$ifdef logging}
LogLn('HGC detected: '+strf(Longint(HGCDetected)));
LogLn('CGA detected: '+strf(Longint(CGADetected)));
LogLn('EGA color detected: '+strf(Longint(EGAColorDetected)));
LogLn('EGA mono detected: '+strf(Longint(EGAMonoDetected)));
LogLn('MCGA detected: '+strf(Longint(MCGADetected)));
LogLn('VGA detected: '+strf(Longint(VGADetected)));
{$endif logging}
if HGCDetected then if HGCDetected then
begin begin
{ HACK: { HACK:
@ -3335,7 +3377,7 @@ const CrtAddress: word = 0;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
end; end;
if CGADetected or EGADetected then if CGADetected or EGAColorDetected or MCGADetected or VGADetected then
begin begin
{ HACK: { HACK:
until we create Save/RestoreStateCGA, we use Save/RestoreStateVGA until we create Save/RestoreStateCGA, we use Save/RestoreStateVGA
@ -3388,7 +3430,7 @@ const CrtAddress: word = 0;
AddMode(mode); AddMode(mode);
end; end;
if EGADetected then if EGAColorDetected or VGADetected then
begin begin
{ HACK: { HACK:
until we create Save/RestoreStateEGA, we use Save/RestoreStateVGA until we create Save/RestoreStateEGA, we use Save/RestoreStateVGA
@ -3406,7 +3448,7 @@ const CrtAddress: word = 0;
mode.ModeName:='640 x 200 EGA'; mode.ModeName:='640 x 200 EGA';
mode.MaxX := 639; mode.MaxX := 639;
mode.MaxY := 199; mode.MaxY := 199;
mode.HardwarePages := 2; mode.HardwarePages := 3;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200; mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16; mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;
@ -3430,8 +3472,14 @@ const CrtAddress: word = 0;
AddMode(mode); AddMode(mode);
end; end;
if VGADetected then if MCGADetected or VGADetected then
begin begin
{ HACK:
until we create Save/RestoreStateEGA, we use Save/RestoreStateVGA
with the inWindows flag enabled (so we only save the mode number
and nothing else) }
if not VGADetected then
inWindows := true;
SaveVideoState := @SaveStateVGA; SaveVideoState := @SaveStateVGA;
{$ifdef logging} {$ifdef logging}
LogLn('Setting VGA SaveVideoState to '+strf(longint(SaveVideoState))); LogLn('Setting VGA SaveVideoState to '+strf(longint(SaveVideoState)));
@ -3530,7 +3578,18 @@ const CrtAddress: word = 0;
mode.XAspect := 8333; mode.XAspect := 8333;
mode.YAspect := 10000; mode.YAspect := 10000;
AddMode(mode); AddMode(mode);
end;
if VGADetected then
begin
SaveVideoState := @SaveStateVGA;
{$ifdef logging}
LogLn('Setting VGA SaveVideoState to '+strf(longint(SaveVideoState)));
{$endif logging}
RestoreVideoState := @RestoreStateVGA;
{$ifdef logging}
LogLn('Setting VGA RestoreVideoState to '+strf(longint(RestoreVideoState)));
{$endif logging}
{ now add all standard VGA modes... } { now add all standard VGA modes... }
InitMode(mode); InitMode(mode);
mode.DriverNumber:= LowRes; mode.DriverNumber:= LowRes;
@ -3562,7 +3621,7 @@ const CrtAddress: word = 0;
mode.ModeName:='640 x 200 EGA'; { yes, it says 'EGA' even for the VGA driver; this is TP7 compatible } mode.ModeName:='640 x 200 EGA'; { yes, it says 'EGA' even for the VGA driver; this is TP7 compatible }
mode.MaxX := 639; mode.MaxX := 639;
mode.MaxY := 199; mode.MaxY := 199;
mode.HardwarePages := 2; mode.HardwarePages := 3;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200; mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200; mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16; mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;

410
packages/graph/src/msdos/vesa.inc
View File

@ -221,16 +221,16 @@ end;
var var
offs : longint; offs : longint;
begin begin
X:= X + StartXViewPort; { verify clipping and then convert to absolute coordinates...}
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
if ClipPixels then if ClipPixels then
Begin begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then if (X < 0) or (X > ViewWidth) then
exit; exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then if (Y < 0) or (Y > ViewHeight) then
exit; exit;
end; end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Y := Y + YOffset; { adjust pixel for correct virtual page } Y := Y + YOffset; { adjust pixel for correct virtual page }
offs := longint(y) * BytesPerLine + x; offs := longint(y) * BytesPerLine + x;
begin begin
@ -305,14 +305,14 @@ end;
If ((amount >= 4) and If ((amount >= 4) and
((offs and 3) = 0)) or ((offs and 3) = 0)) or
(amount >= 4+4-(offs and 3)) Then (amount >= 4+4-(offs and 3)) Then
{ allign target } { align target }
Begin Begin
If (offs and 3) <> 0 then If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 } { size of a window is always a multiple of 4 }
Begin Begin
{$ifdef logging} {$ifdef logging}
LogLn('Alligning by reading '+strf(4-(offs and 3))+' pixels'); LogLn('Aligning by reading '+strf(4-(offs and 3))+' pixels');
{$endif logging} {$endif logging}
for l := 1 to 4-(offs and 3) do for l := 1 to 4-(offs and 3) do
WordArray(Data)[index+l-1] := WordArray(Data)[index+l-1] :=
@ -324,7 +324,7 @@ end;
{$ifdef logging} {$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount)); LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
{$endif logging} {$endif logging}
{ offs is now 4-bytes alligned } { offs is now 4-bytes aligned }
If amount <= ($10000-(Offs and $ffff)) Then If amount <= ($10000-(Offs and $ffff)) Then
bankrest := amount bankrest := amount
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -425,24 +425,23 @@ end;
(HLength >= 4+4-(offs and 3)) Then (HLength >= 4+4-(offs and 3)) Then
{ align target } { align target }
Begin Begin
l := 0;
If (offs and 3) <> 0 then If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 } { size of a window is always a multiple of 4 }
Begin Begin
{$ifdef logging2} {$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels'); LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging2} {$endif logging2}
for l := 1 to 4-(offs and 3) do for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] := Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor); Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End; End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2} {$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength)); LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging} {$endif logging}
{ offs is now 4-bytes alligned } { offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength bankrest := HLength
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -495,26 +494,25 @@ end;
If ((HLength >= 4) and If ((HLength >= 4) and
((offs and 3) = 0)) or ((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then (HLength >= 4+4-(offs and 3)) Then
{ allign target } { align target }
Begin Begin
l := 0;
If (offs and 3) <> 0 then If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 } { size of a window is always a multiple of 4 }
Begin Begin
{$ifdef logging2} {$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels'); LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging} {$endif logging}
for l := 1 to 4-(offs and 3) do for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] := Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor); Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End; End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2} {$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength)); LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging} {$endif logging}
{ offs is now 4-bytes alligned } { offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength bankrest := HLength
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -567,22 +565,21 @@ end;
If ((HLength >= 4) and If ((HLength >= 4) and
((offs and 3) = 0)) or ((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then (HLength >= 4+4-(offs and 3)) Then
{ allign target } { align target }
Begin Begin
l := 0;
If (offs and 3) <> 0 then If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 } { size of a window is always a multiple of 4 }
Begin Begin
{$ifdef logging2} {$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels'); LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging} {$endif logging}
for l := 1 to 4-(offs and 3) do for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] := Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor); Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End; End;
Dec(HLength, l);
inc(offs, l);
{ it is possible that by aligningm we ended up in a new } { it is possible that by aligningm we ended up in a new }
{ bank, so set the correct bank again to make sure } { bank, so set the correct bank again to make sure }
setwritebank(offs shr 16); setwritebank(offs shr 16);
@ -590,7 +587,7 @@ end;
{$ifdef logging2} {$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength)); LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging} {$endif logging}
{ offs is now 4-bytes alligned } { offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength bankrest := HLength
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -640,25 +637,24 @@ end;
If ((HLength >= 4) and If ((HLength >= 4) and
((offs and 3) = 0)) or ((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then (HLength >= 4+4-(offs and 3)) Then
{ allign target } { align target }
Begin Begin
l := 0;
If (offs and 3) <> 0 then If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 } { size of a window is always a multiple of 4 }
Begin Begin
{$ifdef logging2} {$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels'); LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging} {$endif logging}
for l := 1 to 4-(offs and 3) do for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask); Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask);
Dec(HLength, l);
inc(offs, l);
End; End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2} {$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength)); LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging} {$endif logging}
{ offs is now 4-bytes alligned } { offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength bankrest := HLength
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -918,7 +914,6 @@ end;
(amount > 7+8-(offs and 7))) Then (amount > 7+8-(offs and 7))) Then
Begin Begin
{ align target } { align target }
l := 0;
If (offs and 7) <> 0 then If (offs and 7) <> 0 then
{ this cannot go past a window boundary bacause the } { this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 8 } { size of a window is always a multiple of 8 }
@ -933,13 +928,13 @@ end;
Mem[WinWriteSeg:word(offs)+l-1] := fill.pat[patternPos and 7]; Mem[WinWriteSeg:word(offs)+l-1] := fill.pat[patternPos and 7];
inc(patternPos) inc(patternPos)
end; end;
Dec(amount, l);
inc(offs, l);
End; End;
Dec(amount, l);
inc(offs, l);
{$ifdef logging2} {$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount)); LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
{$endif logging2} {$endif logging2}
{ offs is now 8-bytes alligned } { offs is now 8-bytes aligned }
If amount <= ($10000-(Offs and $ffff)) Then If amount <= ($10000-(Offs and $ffff)) Then
bankrest := amount bankrest := amount
else {the rest won't fit anymore in the current window } else {the rest won't fit anymore in the current window }
@ -998,16 +993,16 @@ end;
{$ifdef logging} {$ifdef logging}
logln('putpixvesa32kor64k('+strf(x)+','+strf(y)+')'); logln('putpixvesa32kor64k('+strf(x)+','+strf(y)+')');
{$endif logging} {$endif logging}
X:= X + StartXViewPort; { verify clipping and then convert to absolute coordinates...}
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
if ClipPixels then if ClipPixels then
Begin begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then if (X < 0) or (X > ViewWidth) then
exit; exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then if (Y < 0) or (Y > ViewHeight) then
exit; exit;
end; end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Y := Y + YOffset; { adjust pixel for correct virtual page } Y := Y + YOffset; { adjust pixel for correct virtual page }
offs := longint(y) * BytesPerLine + 2*x; offs := longint(y) * BytesPerLine + 2*x;
bank := offs div 65536; bank := offs div 65536;
@ -1076,6 +1071,323 @@ end;
End; End;
end; end;
procedure HLineVESA32kOr64k(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
var Offs: Longint;
mask, l, bankrest: longint;
curbank, hlength: smallint;
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 logging2}
LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
{$endif logging2}
HLength := x2 - x + 1;
{$ifdef logging2}
LogLn('length: '+strf(hlength));
{$endif logging2}
if HLength>0 then
begin
Offs:=(Longint(y)+YOffset)*bytesperline+2*x;
{$ifdef logging2}
LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
{$endif logging2}
Mask := longint(word(CurrentColor))+(longint(word(CurrentColor)) shl 16);
Case CurrentWriteMode of
AndPut:
Begin
Repeat
curbank := smallint(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging2}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging2}
If ((HLength >= 2) and
((offs and 3) = 0)) or
(HLength >= 3) Then
{ align target }
Begin
If (offs and 3) <> 0 then
{ this cannot go past a window boundary because the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Aligning by drawing 1 pixel');
{$endif logging2}
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] And Word(CurrentColor);
Dec(HLength);
inc(offs, 2);
End;
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes aligned }
If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := ($10000 - (Offs and $ffff)) shr 1;
{ it is possible that by aligningm we ended up in a new }
{ bank, so set the correct bank again to make sure }
setwritebank(offs shr 16);
setreadbank(offs shr 16);
{$ifdef logging2}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 2)-1 Do
MemL[WinWriteSeg:word(offs)+l*4] :=
MemL[WinReadSeg:word(offs)+l*4] And Mask;
inc(offs,l*4+4);
dec(hlength,l*2+2);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging2}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
if HLength > 0 then
begin
{ this may cross a bank at any time, so adjust }
{ because this loop always runs for very little pixels, }
{ there's little gained by splitting it up }
setreadbank(offs shr 16);
setwritebank(offs shr 16);
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] And Word(currentColor);
HLength := 0
end;
End
Until HLength = 0;
End;
XorPut:
Begin
Repeat
curbank := smallint(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging2}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging2}
If ((HLength >= 2) and
((offs and 3) = 0)) or
(HLength >= 3) Then
{ align target }
Begin
If (offs and 3) <> 0 then
{ this cannot go past a window boundary because the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Aligning by drawing 1 pixel');
{$endif logging2}
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] Xor Word(CurrentColor);
Dec(HLength);
inc(offs, 2);
End;
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes aligned }
If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := ($10000 - (Offs and $ffff)) shr 1;
{ it is possible that by aligningm we ended up in a new }
{ bank, so set the correct bank again to make sure }
setwritebank(offs shr 16);
setreadbank(offs shr 16);
{$ifdef logging2}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 2)-1 Do
MemL[WinWriteSeg:word(offs)+l*4] :=
MemL[WinReadSeg:word(offs)+l*4] Xor Mask;
inc(offs,l*4+4);
dec(hlength,l*2+2);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging2}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
if HLength > 0 then
begin
{ this may cross a bank at any time, so adjust }
{ because this loop always runs for very little pixels, }
{ there's little gained by splitting it up }
setreadbank(offs shr 16);
setwritebank(offs shr 16);
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] Xor Word(currentColor);
HLength := 0
end;
End
Until HLength = 0;
End;
OrPut:
Begin
Repeat
curbank := smallint(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging2}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging2}
If ((HLength >= 2) and
((offs and 3) = 0)) or
(HLength >= 3) Then
{ align target }
Begin
If (offs and 3) <> 0 then
{ this cannot go past a window boundary because the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Aligning by drawing 1 pixel');
{$endif logging2}
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] Or Word(CurrentColor);
Dec(HLength);
inc(offs, 2);
End;
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes aligned }
If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := ($10000 - (Offs and $ffff)) shr 1;
{ it is possible that by aligningm we ended up in a new }
{ bank, so set the correct bank again to make sure }
setwritebank(offs shr 16);
setreadbank(offs shr 16);
{$ifdef logging2}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 2)-1 Do
MemL[WinWriteSeg:word(offs)+l*4] :=
MemL[WinReadSeg:word(offs)+l*4] Or Mask;
inc(offs,l*4+4);
dec(hlength,l*2+2);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging2}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
if HLength > 0 then
begin
{ this may cross a bank at any time, so adjust }
{ because this loop always runs for very little pixels, }
{ there's little gained by splitting it up }
setreadbank(offs shr 16);
setwritebank(offs shr 16);
MemW[WinWriteSeg:word(offs)] :=
MemW[WinReadSeg:word(offs)] Or Word(currentColor);
HLength := 0
end;
End
Until HLength = 0;
End
Else
Begin
If CurrentWriteMode = NotPut Then
Mask := Not(Mask);
Repeat
curbank := smallint(offs shr 16);
SetWriteBank(curbank);
SetReadBank(curbank);
{$ifdef logging2}
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
{$endif logging2}
If ((HLength >= 2) and
((offs and 3) = 0)) or
(HLength >= 3) Then
{ align target }
Begin
If (offs and 3) <> 0 then
{ this cannot go past a window boundary because the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Aligning by drawing 1 pixel');
{$endif logging2}
MemW[WinWriteSeg:word(offs)] := Word(Mask);
Dec(HLength);
inc(offs, 2);
End;
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes aligned }
If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
bankrest := ($10000 - (Offs and $ffff)) shr 1;
{ it is possible that by aligningm we ended up in a new }
{ bank, so set the correct bank again to make sure }
setwritebank(offs shr 16);
setreadbank(offs shr 16);
{$ifdef logging2}
LogLn('Rest to be drawn in this window: '+strf(bankrest));
{$endif logging}
For l := 0 to (Bankrest div 2)-1 Do
MemL[WinWriteSeg:word(offs)+l*4] := Mask;
inc(offs,l*4+4);
dec(hlength,l*2+2);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
End
Else
Begin
{$ifdef logging2}
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
{$endif logging}
if HLength > 0 then
begin
{ this may cross a bank at any time, so adjust }
{ because this loop always runs for very little pixels, }
{ there's little gained by splitting it up }
setreadbank(offs shr 16);
setwritebank(offs shr 16);
MemW[WinWriteSeg:word(offs)] := Word(Mask);
HLength := 0
end;
End
Until HLength = 0;
End;
End;
end;
end;
{************************************************************************} {************************************************************************}
{* 4-bit pixels VESA mode routines *} {* 4-bit pixels VESA mode routines *}
@ -1086,16 +1398,16 @@ end;
offs : longint; offs : longint;
dummy : byte; dummy : byte;
begin begin
X:= X + StartXViewPort; { verify clipping and then convert to absolute coordinates...}
Y:= Y + StartYViewPort; if ClipPixels then
{ convert to absolute coordinates and then verify clipping...} begin
if ClipPixels then if (X < 0) or (X > ViewWidth) then
Begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
exit; exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then if (Y < 0) or (Y > ViewHeight) then
exit; exit;
end; end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Y := Y + YOffset; { adjust pixel for correct virtual page } Y := Y + YOffset; { adjust pixel for correct virtual page }
{ } { }
offs := longint(y) * BytesPerLine + (x div 8); offs := longint(y) * BytesPerLine + (x div 8);

8
packages/graph/src/ptcgraph/ptcgraph.pp
View File

@ -725,7 +725,7 @@ end;
procedure ptc_Init640x200x16; procedure ptc_Init640x200x16;
begin begin
ptc_InitMode16_CGAEmu(640, 200, 3); ptc_InitMode16_CGAEmu(640, 200, 4);
end; end;
procedure ptc_Init640x350x16; procedure ptc_Init640x350x16;
@ -1827,7 +1827,7 @@ end;
begin begin
ModeNumber:=EGALo; ModeNumber:=EGALo;
DriverNumber := EGA; DriverNumber := EGA;
HardwarePages := 2; HardwarePages := 3;
ModeName:='640 x 200 EGA'; ModeName:='640 x 200 EGA';
MaxColor := 16; MaxColor := 16;
DirectColor := FALSE; DirectColor := FALSE;
@ -1887,7 +1887,7 @@ end;
begin begin
ModeNumber:=VGALo; ModeNumber:=VGALo;
DriverNumber := VGA; DriverNumber := VGA;
HardwarePages := 2; HardwarePages := 3;
ModeName:='640 x 200 EGA'; ModeName:='640 x 200 EGA';
MaxColor := 16; MaxColor := 16;
DirectColor := FALSE; DirectColor := FALSE;
@ -2541,7 +2541,7 @@ end;
InitMode(graphmode); InitMode(graphmode);
with graphmode do with graphmode do
begin begin
ModeNumber := m1280x1024x64k; ModeNumber := m1280x1024x64k;
DriverNumber := VESA; DriverNumber := VESA;
HardwarePages := 1; HardwarePages := 1;

23
packages/graph/src/win32/graph.pp
View File

@ -13,15 +13,32 @@
**********************************************************************} **********************************************************************}
unit Graph; unit Graph;
interface interface
{ used to create a file containing all calls to WM_PAINT
WARNING this probably creates HUGE files PM }
{ $define DEBUG_WM_PAINT}
{ debug child window handling }
{ $define DEBUGCHILDS}
{ {
To be able to use standard file handles in the graph thread, To be able to use standard file handles in the graph thread,
we need to use the system functions handling threads, we need to use the system functions handling threads,
to ensure that thread varaibles are correctly initialized. to ensure that thread varaibles are correctly initialized.
This new default setting can be overridden by defining This new default setting can be overridden by defining
USE_WINDOWS_API_THREAD_FUNCTIONS macro. USE_WINDOWS_API_THREAD_FUNCTIONS macro.
}
Use API thread functions by default, to avoid interferences due to
initialization of threadvars, this solves e.g. #27508 (which does not
mean though that interworking with CRT is guranteed in any way)
undefine this when debugging the graph unit due to writelns in the
debug code }
{$if not(defined(DEBUG_WM_PAINT)) and not(defined(DEBUGCHILDS))}
{$define USE_WINDOWS_API_THREAD_FUNCTIONS}
{$endif not(defined(DEBUG_WM_PAINT)) and not(defined(DEBUGCHILDS))}
{$ifndef USE_WINDOWS_API_THREAD_FUNCTIONS} {$ifndef USE_WINDOWS_API_THREAD_FUNCTIONS}
{$define USE_SYSTEM_BEGIN_THREAD} {$define USE_SYSTEM_BEGIN_THREAD}
@ -134,10 +151,6 @@ const
{$i graph.inc} {$i graph.inc}
{ used to create a file containing all calls to WM_PAINT
WARNING this probably creates HUGE files PM }
{ $define DEBUG_WM_PAINT}
var var
savedscreen : hbitmap; savedscreen : hbitmap;
graphrunning : boolean; graphrunning : boolean;