paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 20:09:25 +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}
{ two page supPort... }
{ four page support... }
begin
if page > HardwarePages then exit;
asm
@ -2342,12 +2342,13 @@ End;
end;
procedure SetActive200(page: word); {$ifndef fpc}far;{$endif fpc}
{ two page supPort... }
{ four page support... }
begin
case page of
0 : VideoOfs := 0;
1 : VideoOfs := 16384;
2 : VideoOfs := 32768;
3 : VideoOfs := 49152;
else
VideoOfs := 0;
end;
@ -3550,6 +3551,7 @@ const CrtAddress: word = 0;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
mode.HLine := {$ifdef fpc}@{$endif}HLineVESA32kOr64k;
end;
procedure FillCommonVESA32k(var mode: TModeInfo);
@ -3566,11 +3568,14 @@ const CrtAddress: word = 0;
end;
var
HGCDetected : Boolean;
CGADetected : Boolean; { TRUE means real CGA, *not* EGA or VGA }
EGADetected : Boolean; { TRUE means EGA or higher (VGA) }
VGADetected : Boolean;
HGCDetected : Boolean = FALSE;
CGADetected : Boolean = FALSE; { TRUE means real CGA, *not* EGA or VGA }
EGAColorDetected : Boolean = FALSE; { TRUE means true EGA with a color monitor }
EGAMonoDetected : Boolean = FALSE; { TRUE means true EGA with a monochrome (MDA) monitor }
MCGADetected : Boolean = FALSE;
VGADetected : Boolean = FALSE;
mode: TModeInfo;
regs: TDPMIRegisters;
begin
QueryAdapterInfo := ModeList;
{ If the mode listing already exists... }
@ -3579,92 +3584,83 @@ const CrtAddress: word = 0;
if assigned(ModeList) then
exit;
HGCDetected := FALSE;
CGADetected := FALSE;
EGADetected := FALSE;
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
{ check if VGA/MCGA adapter supported... }
regs.ax:=$1a00;
RealIntr($10,regs); { get display combination code...}
if regs.al=$1a then
begin
asm
mov ax,1a00h
{$ifdef fpc}
push ebp
push esi
push edi
push ebx
{$endif fpc}
int 10h { get display combination code...}
{$ifdef fpc}
pop ebx
pop edi
pop esi
pop ebp
{$endif fpc}
cmp al,1ah { check if supPorted... }
jne @novga
{ now check if this is the ATI EGA }
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'];
while regs.bx <> 0 do
begin
case regs.bl of
1: { monochrome adapter (MDA or HGC) }
begin
{ check if Hercules adapter supported ... }
HGCDetected:=Test6845($3B4);
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;
{$ifdef logging}
LogLn('VGA detected: '+strf(Longint(VGADetected)));
{$endif logging}
{ older than EGA? }
if not EGADetected then
if VGADetected then
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);
{ check if CGA adapter supPorted ... }
{ check if CGA adapter supported ... }
CGADetected := Test6845($3D4);
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
begin
{ HACK:
@ -3701,7 +3697,7 @@ const CrtAddress: word = 0;
mode.YAspect := 10000;
AddMode(mode);
end;
if CGADetected or EGADetected then
if CGADetected or EGAColorDetected or MCGADetected or VGADetected then
begin
{ HACK:
until we create Save/RestoreStateCGA, we use Save/RestoreStateVGA
@ -3754,7 +3750,7 @@ const CrtAddress: word = 0;
AddMode(mode);
end;
if EGADetected then
if EGAColorDetected or VGADetected then
begin
{ HACK:
until we create Save/RestoreStateEGA, we use Save/RestoreStateVGA
@ -3772,7 +3768,7 @@ const CrtAddress: word = 0;
mode.ModeName:='640 x 200 EGA';
mode.MaxX := 639;
mode.MaxY := 199;
mode.HardwarePages := 2;
mode.HardwarePages := 3;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;
@ -3796,8 +3792,14 @@ const CrtAddress: word = 0;
AddMode(mode);
end;
if VGADetected then
if MCGADetected or VGADetected then
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;
{$ifdef logging}
LogLn('Setting VGA SaveVideoState to '+strf(longint(SaveVideoState)));
@ -3896,7 +3898,18 @@ const CrtAddress: word = 0;
mode.XAspect := 8333;
mode.YAspect := 10000;
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... }
InitMode(mode);
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.MaxX := 639;
mode.MaxY := 199;
mode.HardwarePages := 2;
mode.HardwarePages := 3;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;

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

@ -479,14 +479,14 @@ end;
If ((amount >= 4) and
((offs and 3) = 0)) or
(amount >= 4+4-(offs and 3)) Then
{ allign target }
{ align 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');
LogLn('Aligning by reading '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
WordArray(Data)[index+l-1] :=
@ -498,7 +498,7 @@ end;
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
{$endif logging}
{ offs is now 4-bytes alligned }
{ offs is now 4-bytes aligned }
If amount <= ($10000-(Offs and $ffff)) Then
bankrest := amount
else {the rest won't fit anymore in the current window }
@ -599,24 +599,23 @@ end;
(HLength >= 4+4-(offs and 3)) Then
{ align target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging2}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
{ offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
@ -669,26 +668,25 @@ end;
If ((HLength >= 4) and
((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then
{ allign target }
{ align target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
{ offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
@ -741,22 +739,21 @@ end;
If ((HLength >= 4) and
((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then
{ allign target }
{ align target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End;
Dec(HLength, l);
inc(offs, l);
{ 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);
@ -764,7 +761,7 @@ end;
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
{ offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
@ -814,25 +811,24 @@ end;
If ((HLength >= 4) and
((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then
{ allign target }
{ align target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask);
Dec(HLength, l);
inc(offs, l);
End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
{ offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
@ -1092,7 +1088,6 @@ end;
(amount > 7+8-(offs and 7))) Then
Begin
{ align target }
l := 0;
If (offs and 7) <> 0 then
{ this cannot go past a window boundary bacause the }
{ 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];
inc(patternPos)
end;
Dec(amount, l);
inc(offs, l);
End;
Dec(amount, l);
inc(offs, l);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
{$endif logging2}
{ offs is now 8-bytes alligned }
{ offs is now 8-bytes aligned }
If amount <= ($10000-(Offs and $ffff)) Then
bankrest := amount
else {the rest won't fit anymore in the current window }
@ -1377,6 +1372,323 @@ 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}
{************************************************************************}
{* 15/16bit pixels VESA mode routines Linear mode *}

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

@ -216,16 +216,16 @@ var
Offset: Word;
B, Mask, Shift: Byte;
begin
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
{ verify clipping and then convert to absolute coordinates...}
if ClipPixels then
begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
if (X < 0) or (X > ViewWidth) then
exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
if (Y < 0) or (Y > ViewHeight) then
exit;
end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Offset := (Y shr 2) * 90 + (X shr 3) + VideoOfs;
case Y and 3 of
1: Inc(Offset, $2000);
@ -620,16 +620,16 @@ var
Offset: Word;
B, Mask, Shift: Byte;
begin
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
{ verify clipping and then convert to absolute coordinates...}
if ClipPixels then
begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
if (X < 0) or (X > ViewWidth) then
exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
if (Y < 0) or (Y > ViewHeight) then
exit;
end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Offset := (Y shr 1) * 80 + (X shr 2);
if (Y and 1) <> 0 then
Inc(Offset, 8192);
@ -930,16 +930,16 @@ var
Offset: Word;
B, Mask, Shift: Byte;
begin
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
{ verify clipping and then convert to absolute coordinates...}
if ClipPixels then
begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
if (X < 0) or (X > ViewWidth) then
exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
if (Y < 0) or (Y > ViewHeight) then
exit;
end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Offset := (Y shr 1) * 80 + (X shr 3);
if (Y and 1) <> 0 then
Inc(Offset, 8192);
@ -1238,16 +1238,16 @@ var
Offset: Word;
B, Mask, Shift: Byte;
begin
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
{ verify clipping and then convert to absolute coordinates...}
if ClipPixels then
begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
if (X < 0) or (X > ViewWidth) then
exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
if (Y < 0) or (Y > ViewHeight) then
exit;
end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Offset := Y * 80 + (X shr 3);
Shift := 7 - (X and 7);
Mask := 1 shl Shift;
@ -1548,16 +1548,16 @@ end;
dummy: byte;
{$endif asmgraph}
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;
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}
offset := y * 80 + (x shr 3) + VideoOfs;
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}
{ two page supPort... }
{ four page support... }
begin
if page > HardwarePages then exit;
asm
@ -2296,12 +2296,13 @@ End;
end;
procedure SetActive200(page: word); {$ifndef fpc}far;{$endif fpc}
{ two page supPort... }
{ four page support... }
begin
case page of
0 : VideoOfs := 0;
1 : VideoOfs := 16384;
2 : VideoOfs := 32768;
3 : VideoOfs := 49152;
else
VideoOfs := 0;
end;
@ -2363,16 +2364,16 @@ End;
Procedure PutPixel320(X,Y : smallint; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
{ x,y -> must be in local coordinates. Clipping if required. }
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;
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
mov es, [SegA000]
mov ax, [Y]
@ -2706,16 +2707,16 @@ const CrtAddress: word = 0;
var offset: word;
{$endif asmgraph}
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;
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}
offset := y * 80 + x shr 2 + VideoOfs;
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.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
mode.HLine := {$ifdef fpc}@{$endif}HLineVESA32kOr64k;
end;
procedure FillCommonVESA32k(var mode: TModeInfo);
@ -3246,10 +3248,12 @@ const CrtAddress: word = 0;
end;
var
HGCDetected : Boolean;
CGADetected : Boolean; { TRUE means real CGA, *not* EGA or VGA }
EGADetected : Boolean; { TRUE means EGA or higher (VGA) }
VGADetected : Boolean;
HGCDetected : Boolean = FALSE;
CGADetected : Boolean = FALSE; { TRUE means real CGA, *not* EGA or VGA }
EGAColorDetected : Boolean = FALSE; { TRUE means true EGA with a color monitor }
EGAMonoDetected : Boolean = FALSE; { TRUE means true EGA with a monochrome (MDA) monitor }
MCGADetected : Boolean = FALSE;
VGADetected : Boolean = FALSE;
mode: TModeInfo;
regs: Registers;
begin
@ -3260,45 +3264,83 @@ const CrtAddress: word = 0;
if assigned(ModeList) then
exit;
HGCDetected := FALSE;
CGADetected := FALSE;
EGADetected := FALSE;
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
{ check if VGA/MCGA adapter supported... }
regs.ax:=$1a00;
intr($10,regs); { get display combination code...}
if regs.al=$1a then
begin
regs.ax:=$1a00;
intr($10,regs); { get display combination code...}
if regs.al=$1a then
while regs.bx <> 0 do
begin
{ 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;
case regs.bl of
1: { monochrome adapter (MDA or HGC) }
begin
{ check if Hercules adapter supported ... }
HGCDetected:=Test6845($3B4);
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;
{$ifdef logging}
LogLn('VGA detected: '+strf(Longint(VGADetected)));
{$endif logging}
{ older than EGA? }
if not EGADetected then
if VGADetected then
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);
{ check if CGA adapter supPorted ... }
{ check if CGA adapter supported ... }
CGADetected := Test6845($3D4);
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
begin
{ HACK:
@ -3335,7 +3377,7 @@ const CrtAddress: word = 0;
mode.YAspect := 10000;
AddMode(mode);
end;
if CGADetected or EGADetected then
if CGADetected or EGAColorDetected or MCGADetected or VGADetected then
begin
{ HACK:
until we create Save/RestoreStateCGA, we use Save/RestoreStateVGA
@ -3388,7 +3430,7 @@ const CrtAddress: word = 0;
AddMode(mode);
end;
if EGADetected then
if EGAColorDetected or VGADetected then
begin
{ HACK:
until we create Save/RestoreStateEGA, we use Save/RestoreStateVGA
@ -3406,7 +3448,7 @@ const CrtAddress: word = 0;
mode.ModeName:='640 x 200 EGA';
mode.MaxX := 639;
mode.MaxY := 199;
mode.HardwarePages := 2;
mode.HardwarePages := 3;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;
@ -3430,8 +3472,14 @@ const CrtAddress: word = 0;
AddMode(mode);
end;
if VGADetected then
if MCGADetected or VGADetected then
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;
{$ifdef logging}
LogLn('Setting VGA SaveVideoState to '+strf(longint(SaveVideoState)));
@ -3530,7 +3578,18 @@ const CrtAddress: word = 0;
mode.XAspect := 8333;
mode.YAspect := 10000;
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... }
InitMode(mode);
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.MaxX := 639;
mode.MaxY := 199;
mode.HardwarePages := 2;
mode.HardwarePages := 3;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;

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

@ -221,16 +221,16 @@ end;
var
offs : longint;
begin
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
{ verify clipping and then convert to absolute coordinates...}
if ClipPixels then
Begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
begin
if (X < 0) or (X > ViewWidth) then
exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
if (Y < 0) or (Y > ViewHeight) then
exit;
end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Y := Y + YOffset; { adjust pixel for correct virtual page }
offs := longint(y) * BytesPerLine + x;
begin
@ -305,14 +305,14 @@ end;
If ((amount >= 4) and
((offs and 3) = 0)) or
(amount >= 4+4-(offs and 3)) Then
{ allign target }
{ align 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');
LogLn('Aligning by reading '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
WordArray(Data)[index+l-1] :=
@ -324,7 +324,7 @@ end;
{$ifdef logging}
LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
{$endif logging}
{ offs is now 4-bytes alligned }
{ offs is now 4-bytes aligned }
If amount <= ($10000-(Offs and $ffff)) Then
bankrest := amount
else {the rest won't fit anymore in the current window }
@ -425,24 +425,23 @@ end;
(HLength >= 4+4-(offs and 3)) Then
{ align target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging2}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
{ offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
@ -495,26 +494,25 @@ end;
If ((HLength >= 4) and
((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then
{ allign target }
{ align target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
{ offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
@ -567,22 +565,21 @@ end;
If ((HLength >= 4) and
((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then
{ allign target }
{ align target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] :=
Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor);
Dec(HLength, l);
inc(offs, l);
End;
Dec(HLength, l);
inc(offs, l);
{ 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);
@ -590,7 +587,7 @@ end;
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
{ offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
@ -640,25 +637,24 @@ end;
If ((HLength >= 4) and
((offs and 3) = 0)) or
(HLength >= 4+4-(offs and 3)) Then
{ allign target }
{ align target }
Begin
l := 0;
If (offs and 3) <> 0 then
{ this cannot go past a window boundary bacause the }
{ size of a window is always a multiple of 4 }
Begin
{$ifdef logging2}
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
{$endif logging}
for l := 1 to 4-(offs and 3) do
Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask);
Dec(HLength, l);
inc(offs, l);
End;
Dec(HLength, l);
inc(offs, l);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
{$endif logging}
{ offs is now 4-bytes alligned }
{ offs is now 4-bytes aligned }
If HLength <= ($10000-(Offs and $ffff)) Then
bankrest := HLength
else {the rest won't fit anymore in the current window }
@ -918,7 +914,6 @@ end;
(amount > 7+8-(offs and 7))) Then
Begin
{ align target }
l := 0;
If (offs and 7) <> 0 then
{ this cannot go past a window boundary bacause the }
{ 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];
inc(patternPos)
end;
Dec(amount, l);
inc(offs, l);
End;
Dec(amount, l);
inc(offs, l);
{$ifdef logging2}
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
{$endif logging2}
{ offs is now 8-bytes alligned }
{ offs is now 8-bytes aligned }
If amount <= ($10000-(Offs and $ffff)) Then
bankrest := amount
else {the rest won't fit anymore in the current window }
@ -998,16 +993,16 @@ end;
{$ifdef logging}
logln('putpixvesa32kor64k('+strf(x)+','+strf(y)+')');
{$endif logging}
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
{ verify clipping and then convert to absolute coordinates...}
if ClipPixels then
Begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
begin
if (X < 0) or (X > ViewWidth) then
exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
if (Y < 0) or (Y > ViewHeight) then
exit;
end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Y := Y + YOffset; { adjust pixel for correct virtual page }
offs := longint(y) * BytesPerLine + 2*x;
bank := offs div 65536;
@ -1076,6 +1071,323 @@ 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 *}
@ -1086,16 +1398,16 @@ end;
offs : longint;
dummy : byte;
begin
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
if ClipPixels then
Begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
{ verify clipping and then convert to absolute coordinates...}
if ClipPixels then
begin
if (X < 0) or (X > ViewWidth) then
exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
if (Y < 0) or (Y > ViewHeight) then
exit;
end;
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
Y := Y + YOffset; { adjust pixel for correct virtual page }
{ }
offs := longint(y) * BytesPerLine + (x div 8);

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

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

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

@ -13,15 +13,32 @@
**********************************************************************}
unit Graph;
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,
we need to use the system functions handling threads,
to ensure that thread varaibles are correctly initialized.
This new default setting can be overridden by defining
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}
{$define USE_SYSTEM_BEGIN_THREAD}
@ -134,10 +151,6 @@ const
{$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
savedscreen : hbitmap;
graphrunning : boolean;