2
$Id: vesa.inc,v 1.12 2005/02/14 17:13:22 peter Exp $
3
This file is part of the Free Pascal run time library.
4
Copyright (c) 1999-2000 by Carl Eric Codere
6
This include implements VESA basic access.
8
See the file COPYING.FPC, included in this distribution,
9
for details about the copyright.
11
This program is distributed in the hope that it will be useful,
12
but WITHOUT ANY WARRANTY; without even the implied warranty of
13
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15
**********************************************************************}
18
palrec = packed record { record used for set/get DAC palette }
19
blue, green, red, align: byte;
24
attrSwitchDAC = $01; { DAC is switchable (1.2) }
25
attrNotVGACompatible = $02; { Video is NOT VGA compatible (2.0) }
26
attrSnowCheck = $04; { Video must use snow checking(2.0) }
28
{ mode attribute bits }
29
modeAvail = $01; { Hardware supports this mode (1.0) }
30
modeExtendInfo = $02; { Extended information (1.0) }
31
modeBIOSSupport = $04; { TTY BIOS Support (1.0) }
32
modeColor = $08; { This is a color mode (1.0) }
33
modeGraphics = $10; { This is a graphics mode (1.0) }
34
modeNotVGACompatible = $20; { this mode is NOT I/O VGA compatible (2.0)}
35
modeNoWindowed = $40; { This mode does not support Windows (2.0) }
36
modeLinearBuffer = $80; { This mode supports linear buffers (2.0) }
55
{ otherwise it's already included in graph.pp }
60
BytesPerLine: word; { Number of bytes per scanline }
61
YOffset : word; { Pixel offset for VESA page flipping }
64
ReadWindow : byte; { Window number for reading. }
65
WriteWindow: byte; { Window number for writing. }
66
winReadSeg : word; { Address of segment for read }
67
winWriteSeg: word; { Address of segment for writes}
68
CurrentReadBank : integer; { active read bank }
69
CurrentWriteBank: integer; { active write bank }
71
BankShift : word; { address to shift by when switching banks. }
73
{ linear mode specific stuff }
74
InLinear : boolean; { true if in linear mode }
75
LinearPageOfs : longint; { offset used to set active page }
76
FrameBufferLinearAddress : longint;
78
ScanLines: word; { maximum number of scan lines for mode }
80
function hexstr(val : longint;cnt : byte) : string;
82
HexTbl : array[0..15] of char='0123456789ABCDEF';
87
for i:=cnt downto 1 do
89
hexstr[i]:=hextbl[val and $f];
97
function getVESAInfo(var VESAInfo: TVESAInfo) : boolean;
100
VESAPtr : ^TVESAInfo;
102
regs : TDPMIRegisters;
112
{ Allocate real mode buffer }
114
Ptrlong:=GlobalDosAlloc(sizeof(TVESAInfo));
115
{ Get selector value }
116
VESAPtr := pointer(Ptrlong shl 16);
118
Ptrlong:=Global_Dos_Alloc(sizeof(TVESAInfo));
121
{ Get segment value }
122
RealSeg := word(Ptrlong shr 16);
123
if not assigned(VESAPtr) then
125
FillChar(regs, sizeof(regs), #0);
127
{ Get VESA Mode information ... }
133
{ no far pointer support in FPC yet, so move the vesa info into a memory }
134
{ block in the DS slector space (JM) }
135
dosmemget(RealSeg,0,VesaPtr^,SizeOf(TVESAInfo));
137
St:=Vesaptr^.signature;
141
LogLn('No VESA detected.');
143
getVesaInfo := FALSE;
145
GlobalDosFree(word(PtrLong and $ffff));
147
If not Global_Dos_Free(word(PtrLong and $ffff)) then
149
{ also free the extra allocated buffer }
158
{ The mode pointer buffer points to a real mode memory }
159
{ Therefore steps to get the modes: }
160
{ 1. Allocate Selector and SetLimit to max number of }
161
{ of possible modes. }
162
ModeSel := AllocSelector(0);
163
SetSelectorLimit(ModeSel, 256*sizeof(word));
165
{ 2. Set Selector linear address to the real mode pointer }
167
offs := longint(longint(VESAPtr^.ModeList) shr 16) shl 4;
168
{shouldn't the OR in the next line be a + ?? (JM)}
169
offs := offs OR (Longint(VESAPtr^.ModeList) and $ffff);
170
SetSelectorBase(ModeSel, offs);
172
{ copy VESA mode information to a protected mode buffer and }
173
{ then free the real mode buffer... }
174
Move(VESAPtr^, VESAInfo, sizeof(VESAInfo));
175
GlobalDosFree(word(PtrLong and $ffff));
177
{ ModeList points to the mode list }
178
{ We must copy it somewhere... }
179
ModeList := Ptr(ModeSel, 0);
182
{ No far pointer support, so the Ptr(ModeSel, 0) doesn't work. }
183
{ Immediately copy everything to a buffer in the DS selector space }
185
{ The following may copy data from outside the VESA buffer, but it }
186
{ shouldn't get past the 1MB limit, since that would mean the buffer }
187
{ has been allocated in the BIOS or high memory region, which seems }
188
{ impossible to me (JM)}
189
DosMemGet(word(longint(VESAPtr^.ModeList) shr 16),
190
word(longint(VESAPtr^.ModeList) and $ffff), ModeList^,256*sizeof(word));
192
{ copy VESA mode information to a protected mode buffer and }
193
{ then free the real mode buffer... }
194
Move(VESAPtr^, VESAInfo, sizeof(VESAInfo));
195
If not Global_Dos_Free(word(PtrLong and $ffff)) then
201
new(VESAInfo.ModeList);
202
while ModeList^[i]<> $ffff do
205
LogLn('Found mode $'+hexstr(ModeList^[i],4));
207
VESAInfo.ModeList^[i] := ModeList^[i];
210
VESAInfo.ModeList^[i]:=$ffff;
211
{ Free the temporary selector used to get mode information }
213
LogLn(strf(i) + ' modes found.');
216
FreeSelector(ModeSel);
222
function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;
226
VESAPtr : ^TVESAModeInfo;
228
regs : TDPMIRegisters;
231
{ Alllocate real mode buffer }
233
Ptr:=GlobalDosAlloc(sizeof(TVESAModeInfo));
234
{ get the selector value }
235
VESAPtr := pointer(longint(Ptr shl 16));
236
if not assigned(VESAPtr) then
239
Ptr:=Global_Dos_Alloc(sizeof(TVESAModeInfo));
241
{ get the segment value }
242
RealSeg := word(Ptr shr 16);
243
{ setup interrupt registers }
244
FillChar(regs, sizeof(regs), #0);
245
{ call VESA mode information...}
251
if word(regs.eax) <> $4f then
252
getVESAModeInfo := FALSE
254
getVESAModeInfo := TRUE;
255
{ copy to protected mode buffer ... }
257
Move(VESAPtr^, ModeInfo, sizeof(ModeInfo));
259
DosMemGet(RealSeg,0,ModeInfo,sizeof(ModeInfo));
261
{ free real mode memory }
263
GlobalDosFree(Word(Ptr and $ffff));
265
If not Global_Dos_Free(Word(Ptr and $ffff)) then
271
function getVESAInfo(var VESAInfo: TVESAInfo) : boolean; assembler;
276
sub ax,004Fh {make sure we got 004Fh back}
279
cmp word ptr es:[di],'V'or('E'shl 8) {signature should be 'VESA'}
281
cmp word ptr es:[di+2],'S'or('A'shl 8)
289
function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;assembler;
295
sub ax,004Fh {make sure it's 004Fh}
302
function SearchVESAModes(mode: Word): boolean;
303
{********************************************************}
304
{ Searches for a specific DEFINED vesa mode. If the mode }
305
{ is not available for some reason, then returns FALSE }
306
{ otherwise returns TRUE. }
307
{********************************************************}
310
ModeSupported : Boolean;
313
{ let's assume it's not available ... }
314
ModeSupported := FALSE;
315
{ This is a STUB VESA implementation }
316
if VESAInfo.ModeList^[0] = $FFFF then exit;
318
if VESAInfo.ModeList^[i] = mode then
320
{ we found it, the card supports this mode... }
321
ModeSupported := TRUE;
325
until VESAInfo.ModeList^[i] = $ffff;
326
{ now check if the hardware supports it... }
327
If ModeSupported then
329
{ we have to init everything to zero, since VBE < 1.1 }
330
{ may not setup fields correctly. }
331
FillChar(VESAModeInfo, sizeof(VESAModeInfo), #0);
332
If GetVESAModeInfo(VESAModeInfo, Mode) And
333
((VESAModeInfo.attr and modeAvail) <> 0) then
334
ModeSupported := TRUE
336
ModeSupported := FALSE;
338
SearchVESAModes := ModeSupported;
343
procedure SetBankIndex(win: byte; BankNr: Integer); assembler;
364
{********************************************************}
365
{ There are two routines for setting banks. This may in }
366
{ in some cases optimize a bit some operations, if the }
367
{ hardware supports it, because one window is used for }
368
{ reading and one window is used for writing. }
369
{********************************************************}
370
procedure SetReadBank(BankNr: Integer);
372
{ check if this is the current bank... if so do nothing. }
373
if BankNr = CurrentReadBank then exit;
375
{ LogLn('Setting read bank to '+strf(BankNr));}
377
CurrentReadBank := BankNr; { save current bank number }
378
BankNr := BankNr shl BankShift; { adjust to window granularity }
379
{ we set both banks, since one may read only }
380
SetBankIndex(ReadWindow, BankNr);
381
{ if the hardware supports only one window }
382
{ then there is only one single bank, so }
383
{ update both bank numbers. }
384
if ReadWindow = WriteWindow then
385
CurrentWriteBank := CurrentReadBank;
388
procedure SetWriteBank(BankNr: Integer);
390
{ check if this is the current bank... if so do nothing. }
391
if BankNr = CurrentWriteBank then exit;
393
{ LogLn('Setting write bank to '+strf(BankNr));}
395
CurrentWriteBank := BankNr; { save current bank number }
396
BankNr := BankNr shl BankShift; { adjust to window granularity }
397
{ we set both banks, since one may read only }
398
SetBankIndex(WriteWindow, BankNr);
399
{ if the hardware supports only one window }
400
{ then there is only one single bank, so }
401
{ update both bank numbers. }
402
if ReadWindow = WriteWindow then
403
CurrentReadBank := CurrentWriteBank;
406
{************************************************************************}
407
{* 8-bit pixels VESA mode routines *}
408
{************************************************************************}
410
procedure PutPixVESA256(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
414
X:= X + StartXViewPort;
415
Y:= Y + StartYViewPort;
416
{ convert to absolute coordinates and then verify clipping...}
419
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
421
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
424
Y := Y + YOffset; { adjust pixel for correct virtual page }
425
offs := longint(y) * BytesPerLine + x;
427
SetWriteBank(integer(offs shr 16));
428
mem[WinWriteSeg : word(offs)] := byte(color);
432
procedure DirectPutPixVESA256(x, y : integer); {$ifndef fpc}far;{$endif fpc}
437
offs := (longint(y) + YOffset) * BytesPerLine + x;
438
Case CurrentWriteMode of
441
SetReadBank(integer(offs shr 16));
442
col := mem[WinReadSeg : word(offs)] xor byte(CurrentColor);
446
SetReadBank(integer(offs shr 16));
447
col := mem[WinReadSeg : word(offs)] And byte(CurrentColor);
451
SetReadBank(integer(offs shr 16));
452
col := mem[WinReadSeg : word(offs)] or byte(currentcolor);
456
If CurrentWriteMode <> NotPut then
457
col := Byte(CurrentColor)
458
else col := Not(Byte(CurrentColor));
461
SetWriteBank(integer(offs shr 16));
462
mem[WinWriteSeg : word(offs)] := Col;
465
function GetPixVESA256(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
469
X:= X + StartXViewPort;
470
Y:= Y + StartYViewPort + YOffset;
471
offs := longint(y) * BytesPerLine + x;
472
SetReadBank(integer(offs shr 16));
473
GetPixVESA256:=mem[WinReadSeg : word(offs)];
476
Procedure GetScanLineVESA256(x1, x2, y: integer; var data); {$ifndef fpc}far;{$endif}
478
l, amount, bankrest, index, pixels: longint;
481
inc(x1,StartXViewPort);
482
inc(x2,StartXViewPort);
484
LogLn('getscanline256 '+strf(x1)+' - '+strf(x2)+' at '+strf(y+StartYViewPort));
488
Offs:=(Longint(y)+StartYViewPort+YOffset)*bytesperline+x1;
490
curbank := integer(offs shr 16);
491
SetReadBank(curbank);
493
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
495
If ((amount >= 4) and
496
((offs and 3) = 0)) or
497
(amount >= 4+4-(offs and 3)) Then
500
If (offs and 3) <> 0 then
501
{ this cannot go past a window boundary bacause the }
502
{ size of a window is always a multiple of 4 }
505
LogLn('Alligning by reading '+strf(4-(offs and 3))+' pixels');
507
for l := 1 to 4-(offs and 3) do
508
WordArray(Data)[index+l-1] :=
509
Mem[WinReadSeg:word(offs)+l-1];
515
LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
517
{ offs is now 4-bytes alligned }
518
If amount <= ($10000-(Offs and $ffff)) Then
520
else {the rest won't fit anymore in the current window }
521
bankrest := $10000 - (Offs and $ffff);
522
{ it is possible that by aligning, we ended up in a new }
523
{ bank, so set the correct bank again to make sure }
524
setreadbank(offs shr 16);
526
LogLn('Rest to be read from this window: '+strf(bankrest));
528
For l := 0 to (Bankrest div 4)-1 Do
530
pixels := MemL[WinWriteSeg:word(offs)+l*4];
531
WordArray(Data)[index+l*4] := pixels and $ff;
532
pixels := pixels shr 8;
533
WordArray(Data)[index+l*4+1] := pixels and $ff;
534
pixels := pixels shr 8;
535
WordArray(Data)[index+l*4+2] := pixels and $ff;
536
pixels := pixels shr 8;
537
WordArray(Data)[index+l*4+3] := pixels{ and $ff};
543
LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
549
LogLn('Leftover: '+strf(amount)+' at offset '+hexstr(offs,8));
551
For l := 0 to amount - 1 do
553
{ this may cross a bank at any time, so adjust }
554
{ because this loop alwys runs for very little pixels, }
555
{ there's little gained by splitting it up }
556
setreadbank(offs shr 16);
557
WordArray(Data)[index+l] := mem[WinReadSeg:word(offs)];
565
procedure HLineVESA256(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
568
mask, l, bankrest: longint;
569
curbank, hlength: integer;
571
{ must we swap the values? }
578
{ First convert to global coordinates }
579
X := X + StartXViewPort;
580
X2 := X2 + StartXViewPort;
581
Y := Y + StartYViewPort;
584
if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
585
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
589
LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
591
HLength := x2 - x + 1;
593
LogLn('length: '+strf(hlength));
597
Offs:=(Longint(y)+YOffset)*bytesperline+x;
599
LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
601
Mask := byte(CurrentColor)+byte(CurrentColor) shl 8;
602
Mask := Mask + Mask shl 16;
603
Case CurrentWriteMode of
607
curbank := integer(offs shr 16);
608
SetWriteBank(curbank);
609
SetReadBank(curbank);
611
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
613
If ((HLength >= 4) and
614
((offs and 3) = 0)) or
615
(HLength >= 4+4-(offs and 3)) Then
619
If (offs and 3) <> 0 then
620
{ this cannot go past a window boundary bacause the }
621
{ size of a window is always a multiple of 4 }
624
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
626
for l := 1 to 4-(offs and 3) do
627
Mem[WinWriteSeg:word(offs)+l-1] :=
628
Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor);
633
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
635
{ offs is now 4-bytes alligned }
636
If HLength <= ($10000-(Offs and $ffff)) Then
638
else {the rest won't fit anymore in the current window }
639
bankrest := $10000 - (Offs and $ffff);
640
{ it is possible that by aligningm we ended up in a new }
641
{ bank, so set the correct bank again to make sure }
642
setwritebank(offs shr 16);
643
setreadbank(offs shr 16);
645
LogLn('Rest to be drawn in this window: '+strf(bankrest));
647
For l := 0 to (Bankrest div 4)-1 Do
648
MemL[WinWriteSeg:word(offs)+l*4] :=
649
MemL[WinReadSeg:word(offs)+l*4] And Mask;
653
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
659
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
661
For l := 0 to HLength - 1 do
663
{ this may cross a bank at any time, so adjust }
664
{ becauese this loop alwys runs for very little pixels, }
665
{ there's little gained by splitting it up }
666
setreadbank(offs shr 16);
667
setwritebank(offs shr 16);
668
Mem[WinWriteSeg:word(offs)] :=
669
Mem[WinReadSeg:word(offs)] And byte(currentColor);
679
curbank := integer(offs shr 16);
680
SetWriteBank(curbank);
681
SetReadBank(curbank);
683
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
685
If ((HLength >= 4) and
686
((offs and 3) = 0)) or
687
(HLength >= 4+4-(offs and 3)) Then
691
If (offs and 3) <> 0 then
692
{ this cannot go past a window boundary bacause the }
693
{ size of a window is always a multiple of 4 }
696
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
698
for l := 1 to 4-(offs and 3) do
699
Mem[WinWriteSeg:word(offs)+l-1] :=
700
Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor);
705
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
707
{ offs is now 4-bytes alligned }
708
If HLength <= ($10000-(Offs and $ffff)) Then
710
else {the rest won't fit anymore in the current window }
711
bankrest := $10000 - (Offs and $ffff);
712
{ it is possible that by aligningm we ended up in a new }
713
{ bank, so set the correct bank again to make sure }
714
setwritebank(offs shr 16);
715
setreadbank(offs shr 16);
717
LogLn('Rest to be drawn in this window: '+strf(bankrest));
719
For l := 0 to (Bankrest div 4)-1 Do
720
MemL[WinWriteSeg:word(offs)+l*4] :=
721
MemL[WinReadSeg:word(offs)+l*4] Xor Mask;
725
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
731
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
733
For l := 0 to HLength - 1 do
735
{ this may cross a bank at any time, so adjust }
736
{ because this loop alwys runs for very little pixels, }
737
{ there's little gained by splitting it up }
738
setreadbank(offs shr 16);
739
setwritebank(offs shr 16);
740
Mem[WinWriteSeg:word(offs)] :=
741
Mem[WinReadSeg:word(offs)] xor byte(currentColor);
751
curbank := integer(offs shr 16);
752
SetWriteBank(curbank);
753
SetReadBank(curbank);
755
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
757
If ((HLength >= 4) and
758
((offs and 3) = 0)) or
759
(HLength >= 4+4-(offs and 3)) Then
763
If (offs and 3) <> 0 then
764
{ this cannot go past a window boundary bacause the }
765
{ size of a window is always a multiple of 4 }
768
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
770
for l := 1 to 4-(offs and 3) do
771
Mem[WinWriteSeg:word(offs)+l-1] :=
772
Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor);
776
{ it is possible that by aligningm we ended up in a new }
777
{ bank, so set the correct bank again to make sure }
778
setwritebank(offs shr 16);
779
setreadbank(offs shr 16);
781
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
783
{ offs is now 4-bytes alligned }
784
If HLength <= ($10000-(Offs and $ffff)) Then
786
else {the rest won't fit anymore in the current window }
787
bankrest := $10000 - (Offs and $ffff);
789
LogLn('Rest to be drawn in this window: '+strf(bankrest));
791
For l := 0 to (Bankrest div 4)-1 Do
792
MemL[WinWriteSeg:offs+l*4] :=
793
MemL[WinReadSeg:word(offs)+l*4] Or Mask;
797
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
803
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
805
For l := 0 to HLength - 1 do
807
{ this may cross a bank at any time, so adjust }
808
{ because this loop alwys runs for very little pixels, }
809
{ there's little gained by splitting it up }
810
setreadbank(offs shr 16);
811
setwritebank(offs shr 16);
812
Mem[WinWriteSeg:word(offs)] :=
813
Mem[WinReadSeg:word(offs)] And byte(currentColor);
822
If CurrentWriteMode = NotPut Then
825
curbank := integer(offs shr 16);
826
SetWriteBank(curbank);
828
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8)+' -- '+strf(offs));
830
If ((HLength >= 4) and
831
((offs and 3) = 0)) or
832
(HLength >= 4+4-(offs and 3)) Then
836
If (offs and 3) <> 0 then
837
{ this cannot go past a window boundary bacause the }
838
{ size of a window is always a multiple of 4 }
841
LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
843
for l := 1 to 4-(offs and 3) do
844
Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask);
849
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
851
{ offs is now 4-bytes alligned }
852
If HLength <= ($10000-(Offs and $ffff)) Then
854
else {the rest won't fit anymore in the current window }
855
bankrest := $10000 - (Offs and $ffff);
856
{ it is possible that by aligningm we ended up in a new }
857
{ bank, so set the correct bank again to make sure }
858
setwritebank(offs shr 16);
860
LogLn('Rest to be drawn in this window: '+strf(bankrest)+' -- '+hexstr(bankrest,8));
862
For l := 0 to (Bankrest div 4)-1 Do
863
MemL[WinWriteSeg:word(offs)+l*4] := Mask;
867
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
873
LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
875
For l := 0 to HLength - 1 do
877
{ this may cross a bank at any time, so adjust }
878
{ because this loop alwys runs for very little pixels, }
879
{ there's little gained by splitting it up }
880
setwritebank(offs shr 16);
881
Mem[WinWriteSeg:word(offs)] := byte(mask);
892
procedure VLineVESA256(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
895
l, bankrest: longint;
896
curbank, vlength: integer;
899
{ must we swap the values? }
906
{ First convert to global coordinates }
907
X := X + StartXViewPort;
908
Y := Y + StartYViewPort;
909
Y2 := Y2 + StartYViewPort;
912
if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
913
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
916
Col := Byte(CurrentColor);
918
LogLn('vline '+strf(y)+' - '+strf(y2)+' on '+strf(x)+' in mode '+strf(currentwritemode));
920
VLength := y2 - y + 1;
922
LogLn('length: '+strf(vlength));
926
Offs:=(Longint(y)+YOffset)*bytesperline+x;
928
LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
930
Case CurrentWriteMode of
934
curbank := integer(offs shr 16);
935
SetWriteBank(curbank);
936
SetReadBank(curbank);
938
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
940
If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
942
else {the rest won't fit anymore in the current window }
943
bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
945
LogLn('Rest to be drawn in this window: '+strf(bankrest));
947
For l := 0 to Bankrest-1 Do
949
Mem[WinWriteSeg:word(offs)] :=
950
Mem[WinReadSeg:word(offs)] And Col;
951
inc(offs,bytesperline);
955
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
962
curbank := integer(offs shr 16);
963
SetWriteBank(curbank);
964
SetReadBank(curbank);
966
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
968
If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
970
else {the rest won't fit anymore in the current window }
971
bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
973
LogLn('Rest to be drawn in this window: '+strf(bankrest));
975
For l := 0 to Bankrest-1 Do
977
Mem[WinWriteSeg:word(offs)] :=
978
Mem[WinReadSeg:word(offs)] Xor Col;
979
inc(offs,bytesperline);
983
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
990
curbank := integer(offs shr 16);
991
SetWriteBank(curbank);
992
SetReadBank(curbank);
994
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
996
If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
998
else {the rest won't fit anymore in the current window }
999
bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
1001
LogLn('Rest to be drawn in this window: '+strf(bankrest));
1003
For l := 0 to Bankrest-1 Do
1005
Mem[WinWriteSeg:word(offs)] :=
1006
Mem[WinReadSeg:word(offs)] Or Col;
1007
inc(offs,bytesperline);
1011
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
1017
If CurrentWriteMode = NotPut Then
1020
curbank := integer(offs shr 16);
1021
SetWriteBank(curbank);
1023
LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
1025
If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
1027
else {the rest won't fit anymore in the current window }
1028
bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
1030
LogLn('Rest to be drawn in this window: '+strf(bankrest));
1032
For l := 0 to Bankrest-1 Do
1034
Mem[WinWriteSeg:word(offs)] := Col;
1035
inc(offs,bytesperline);
1039
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
1047
procedure PatternLineVESA256(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
1048
{********************************************************}
1049
{ Draws a horizontal patterned line according to the }
1050
{ current Fill Settings. }
1051
{********************************************************}
1052
{ Important notes: }
1053
{ - CurrentColor must be set correctly before entering }
1055
{********************************************************}
1057
TVESA256Fill = Record
1059
0: (data1, data2: longint);
1060
1: (pat: array[0..7] of byte);
1065
bankrest, l : longint;
1066
offs, amount: longint;
1069
OldWriteMode : word;
1070
TmpFillPattern, patternPos : byte;
1072
{ convert to global coordinates ... }
1073
x1 := x1 + StartXViewPort;
1074
x2 := x2 + StartXViewPort;
1075
y := y + StartYViewPort;
1076
{ if line was fully clipped then exit...}
1077
if LineClipped(x1,y,x2,y,StartXViewPort,StartYViewPort,
1078
StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
1080
OldWriteMode := CurrentWriteMode;
1081
CurrentWriteMode := NormalPut;
1082
{ Get the current pattern }
1083
TmpFillPattern := FillPatternTable
1084
[FillSettings.Pattern][((y + startYViewPort) and $7)+1];
1086
LogLn('patternline '+strf(x1)+' - '+strf(x2)+' on '+strf(y));
1088
{ how long is the line }
1089
amount := x2 - x1 + 1;
1090
{ offset to start at }
1091
offs := (longint(y)+yoffset)*bytesperline+x1;
1092
{ convert the pattern data into the actual color sequence }
1094
FillChar(fill,sizeOf(fill),byte(currentBkColor));
1097
if TmpFillPattern and j <> 0 then
1098
fill.pat[7-i] := currentColor;
1101
{$define overflowOn}
1110
SetWriteBank(integer(offs shr 16));
1112
(((offs and 7) = 0) or
1113
(amount > 7+8-(offs and 7))) Then
1117
If (offs and 7) <> 0 then
1118
{ this cannot go past a window boundary bacause the }
1119
{ size of a window is always a multiple of 8 }
1121
{ position in the pattern where to start }
1122
patternPos := offs and 7;
1124
LogLn('Aligning by drawing '+strf(8-(offs and 7))+' pixels');
1126
for l := 1 to 8-(offs and 7) do
1128
Mem[WinWriteSeg:word(offs)+l-1] := fill.pat[patternPos and 7];
1135
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
1137
{ offs is now 8-bytes alligned }
1138
If amount <= ($10000-(Offs and $ffff)) Then
1140
else {the rest won't fit anymore in the current window }
1141
bankrest := $10000 - (Offs and $ffff);
1142
{ it is possible that by aligningm we ended up in a new }
1143
{ bank, so set the correct bank again to make sure }
1144
setwritebank(offs shr 16);
1146
LogLn('Rest to be drawn in this window: '+strf(bankrest));
1148
for l := 0 to (bankrest div 8)-1 Do
1150
MemL[WinWriteSeg:word(offs)+l*8] := fill.data1;
1151
MemL[WinWriteSeg:word(offs)+l*8+4] := fill.data2;
1156
LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
1162
LogLn('Drawing leftover: '+strf(amount)+' at offset '+hexstr(offs,8));
1164
patternPos := offs and 7;
1165
For l := 0 to amount - 1 do
1167
{ this may cross a bank at any time, so adjust }
1168
{ because this loop alwys runs for very little pixels, }
1169
{ there's little gained by splitting it up }
1170
setwritebank(offs shr 16);
1171
Mem[WinWriteSeg:word(offs)] := fill.pat[patternPos and 7];
1178
currentWriteMode := oldWriteMode;
1182
{************************************************************************}
1183
{* 256 colors VESA mode routines Linear mode *}
1184
{************************************************************************}
1190
procedure DirectPutPixVESA256Linear(x, y : integer); {$ifndef fpc}far;{$endif fpc}
1195
offs := longint(y) * BytesPerLine + x;
1196
Case CurrentWriteMode of
1199
if UseNoSelector then
1200
col:=pbyte(LFBPointer+offs+LinearPageOfs)^
1202
seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
1203
col := col xor byte(CurrentColor);
1207
if UseNoSelector then
1208
col:=pbyte(LFBPointer+offs+LinearPageOfs)^
1210
seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
1211
col := col and byte(CurrentColor);
1215
if UseNoSelector then
1216
col:=pbyte(LFBPointer+offs+LinearPageOfs)^
1218
seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
1219
col := col or byte(CurrentColor);
1223
If CurrentWriteMode <> NotPut then
1224
col := Byte(CurrentColor)
1225
else col := Not(Byte(CurrentColor));
1228
if UseNoSelector then
1229
pbyte(LFBPointer+offs+LinearPageOfs)^:=col
1231
seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,1);
1234
procedure PutPixVESA256Linear(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
1238
X:= X + StartXViewPort;
1239
Y:= Y + StartYViewPort;
1240
{ convert to absolute coordinates and then verify clipping...}
1243
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
1245
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
1248
offs := longint(y) * BytesPerLine + x;
1250
logln('putpix offset: '+hexstr(offs,8)+', color: '+strf(color)+', lpo: $'+
1251
hexstr(LinearPageOfs,8));
1253
if UseNoSelector then
1254
pbyte(LFBPointer+offs+LinearPageOfs)^:=byte(color)
1256
seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,1);
1259
function GetPixVESA256Linear(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
1264
X:= X + StartXViewPort;
1265
Y:= Y + StartYViewPort;
1266
offs := longint(y) * BytesPerLine + x;
1268
logln('getpix offset: '+hexstr(offs,8)+', lpo: $'+
1269
hexstr(LinearPageOfs,8));
1271
if UseNoSelector then
1272
col:=pbyte(LFBPointer+offs+LinearPageOfs)^
1274
seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
1275
GetPixVESA256Linear:=col;
1278
function SetVESADisplayStart(PageNum : word;x,y : integer):Boolean;
1282
if PageNum>VesaModeInfo.NumberOfPages then
1286
writeln(stderr,'Setting Display Page ',PageNum);
1288
dregs.RealEBX:=0{ $80 for Wait for retrace };
1290
dregs.RealEDX:=y+PageNum*maxy;
1293
dregs.RealEAX:=$4F07; RealIntr($10,dregs);
1294
{ idem as above !!! }
1295
if (dregs.RealEAX and $1FF) <> $4F then
1298
writeln(stderr,'Set Display start error');
1300
SetVESADisplayStart:=false;
1303
SetVESADisplayStart:=true;
1309
{************************************************************************}
1310
{* 15/16bit pixels VESA mode routines *}
1311
{************************************************************************}
1313
procedure PutPixVESA32kOr64k(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
1318
logln('putpixvesa32kor64k('+strf(x)+','+strf(y)+')');
1320
X:= X + StartXViewPort;
1321
Y:= Y + StartYViewPort;
1322
{ convert to absolute coordinates and then verify clipping...}
1325
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
1327
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
1330
Y := Y + YOffset; { adjust pixel for correct virtual page }
1331
offs := longint(y) * BytesPerLine + 2*x;
1332
SetWriteBank(integer(offs shr 16));
1334
logln('putpixvesa32kor64k offset: '+strf(word(offs)));
1336
memW[WinWriteSeg : word(offs)] := color;
1339
function GetPixVESA32kOr64k(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
1343
X:= X + StartXViewPort;
1344
Y:= Y + StartYViewPort + YOffset;
1345
offs := longint(y) * BytesPerLine + 2*x;
1346
SetReadBank(integer(offs shr 16));
1347
GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)];
1350
procedure DirectPutPixVESA32kOr64k(x, y : integer); {$ifndef fpc}far;{$endif fpc}
1356
logln('directputpixvesa32kor64k('+strf(x)+','+strf(y)+')');
1359
offs := longint(y) * BytesPerLine + 2*x;
1360
SetWriteBank(integer((offs shr 16) and $ff));
1361
Case CurrentWriteMode of
1364
SetReadBank(integer(offs shr 16));
1365
memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] xor currentcolor;
1369
SetReadBank(integer(offs shr 16));
1370
memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] And currentcolor;
1374
SetReadBank(integer(offs shr 16));
1375
memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] or currentcolor;
1379
If CurrentWriteMode <> NotPut Then
1381
Else col := Not(CurrentColor);
1383
logln('directputpixvesa32kor64k offset: '+strf(word(offs)));
1385
memW[WinWriteSeg : word(offs)] := Col;
1391
{************************************************************************}
1392
{* 15/16bit pixels VESA mode routines Linear mode *}
1393
{************************************************************************}
1395
procedure PutPixVESA32kor64kLinear(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
1399
X:= X + StartXViewPort;
1400
Y:= Y + StartYViewPort;
1401
{ convert to absolute coordinates and then verify clipping...}
1404
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
1406
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
1409
offs := longint(y) * BytesPerLine + 2*x;
1410
if UseNoSelector then
1411
pword(LFBPointer+offs+LinearPageOfs)^:=color
1413
seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,2);
1416
function GetPixVESA32kor64kLinear(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
1421
X:= X + StartXViewPort;
1422
Y:= Y + StartYViewPort;
1423
offs := longint(y) * BytesPerLine + 2*x;
1424
if UseNoSelector then
1425
color:=pword(LFBPointer+offs+LinearPageOfs)^
1427
seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@color),2);
1428
GetPixVESA32kor64kLinear:=color;
1431
procedure DirectPutPixVESA32kor64kLinear(x, y : integer); {$ifndef fpc}far;{$endif fpc}
1436
offs := longint(y) * BytesPerLine + 2*x;
1437
Case CurrentWriteMode of
1440
if UseNoSelector then
1441
col:=pword(LFBPointer+offs+LinearPageOfs)^
1443
seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
1444
col := col xor currentcolor;
1448
if UseNoSelector then
1449
col:=pword(LFBPointer+offs+LinearPageOfs)^
1451
seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
1452
col := col and currentcolor;
1456
if UseNoSelector then
1457
col:=pword(LFBPointer+offs+LinearPageOfs)^
1459
seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
1460
col := col or currentcolor;
1464
If CurrentWriteMode <> NotPut Then
1466
Else col := Not(CurrentColor);
1469
if UseNoSelector then
1470
pword(LFBPointer+offs+LinearPageOfs)^:=col
1472
seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,2);
1477
{************************************************************************}
1478
{* 4-bit pixels VESA mode routines *}
1479
{************************************************************************}
1481
procedure PutPixVESA16(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
1486
X:= X + StartXViewPort;
1487
Y:= Y + StartYViewPort;
1488
{ convert to absolute coordinates and then verify clipping...}
1491
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
1493
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
1496
Y := Y + YOffset; { adjust pixel for correct virtual page }
1498
offs := longint(y) * BytesPerLine + (x div 8);
1499
SetWriteBank(integer(offs shr 16));
1501
PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
1502
PortW[$3ce] := color shl 8; { Index 00 : Enable correct plane and write color }
1504
Port[$3ce] := 8; { Index 08 : Bitmask register. }
1505
Port[$3cf] := $80 shr (x and $7); { Select correct bits to modify }
1507
dummy := Mem[WinWriteSeg: offs]; { Latch the data into host space. }
1508
Mem[WinWriteSeg: offs] := dummy; { Write the data into video memory }
1509
PortW[$3ce] := $ff08; { Enable all bit planes. }
1510
PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. }
1515
Function GetPixVESA16(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
1516
Var dummy, offset: Word;
1519
X:= X + StartXViewPort;
1520
Y:= Y + StartYViewPort + YOffset;
1521
offset := longint(Y) * BytesPerLine + (x div 8);
1522
SetReadBank(integer(offset shr 16));
1524
shift := 7 - (X and 7);
1526
dummy := (Mem[WinReadSeg:offset] shr shift) and 1;
1528
dummy := dummy or (((Mem[WinReadSeg:offset] shr shift) and 1) shl 1);
1530
dummy := dummy or (((Mem[WinReadSeg:offset] shr shift) and 1) shl 2);
1532
dummy := dummy or (((Mem[WinReadSeg:offset] shr shift) and 1) shl 3);
1533
GetPixVESA16 := dummy;
1537
procedure DirectPutPixVESA16(x, y : integer); {$ifndef fpc}far;{$endif fpc}
1544
case CurrentWriteMode of
1547
{ getpixel wants local/relative coordinates }
1548
Color := GetPixVESA16(x-StartXViewPort,y-StartYViewPort);
1549
Color := CurrentColor Xor Color;
1553
{ getpixel wants local/relative coordinates }
1554
Color := GetPixVESA16(x-StartXViewPort,y-StartYViewPort);
1555
Color := CurrentColor Or Color;
1559
{ getpixel wants local/relative coordinates }
1560
Color := GetPixVESA16(x-StartXViewPort,y-StartYViewPort);
1561
Color := CurrentColor And Color;
1568
Color := CurrentColor;
1570
offs := longint(y) * BytesPerLine + (x div 8);
1571
SetWriteBank(integer(offs shr 16));
1572
PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
1573
PortW[$3ce] := color shl 8; { Index 00 : Enable correct plane and write color }
1575
Port[$3ce] := 8; { Index 08 : Bitmask register. }
1576
Port[$3cf] := $80 shr (x and $7); { Select correct bits to modify }
1578
dummy := Mem[WinWriteSeg: offs]; { Latch the data into host space. }
1579
Mem[WinWriteSeg: offs] := dummy; { Write the data into video memory }
1580
PortW[$3ce] := $ff08; { Enable all bit planes. }
1581
PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. }
1587
{************************************************************************}
1588
{* VESA Palette entries *}
1589
{************************************************************************}
1594
Procedure SetVESARGBAllPalette(const Palette:PaletteType);
1596
pal: array[0..255] of palrec;
1597
regs: TDPMIRegisters;
1600
FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
1604
_GraphResult := grError;
1607
{ use the set/get palette function }
1608
if VESAInfo.Version >= $0200 then
1610
{ check if blanking bit must be set when programming }
1612
if (VESAInfo.caps and attrSnowCheck) <> 0 then
1617
fillChar(pal,sizeof(pal),0);
1618
{ Convert to vesa format }
1619
for c := 0 to 255 do
1621
pal[c].red := byte(palette.colors[c].red);
1622
pal[c].green := byte(palette.colors[c].green);
1623
pal[c].blue := byte(palette.colors[c].blue);
1626
{ Alllocate real mode buffer }
1627
Ptr:=Global_Dos_Alloc(sizeof(pal));
1628
{get the segment value}
1629
RealSeg := word(Ptr shr 16);
1630
{ setup interrupt registers }
1631
FillChar(regs, sizeof(regs), #0);
1632
{ copy palette values to real mode buffer }
1633
DosMemPut(RealSeg,0,pal,sizeof(pal));
1635
regs.ebx := FunctionNr;
1639
regs.edi := 0; { offset is always zero }
1640
RealIntr($10, regs);
1642
{ free real mode memory }
1643
If not Global_Dos_Free(word(Ptr and $ffff)) then
1646
if word(regs.eax) <> $004F then
1648
_GraphResult := grError;
1653
{ assume it's fully VGA compatible palette-wise. }
1655
SetVGARGBAllPalette(palette);
1657
setallpalettedefault(palette);
1661
Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
1662
BlueValue : Integer);
1665
regs: TDPMIRegisters;
1671
FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
1676
logln('setvesargbpalette called with directcolor = true');
1678
_GraphResult := grError;
1682
pal.red := byte(RedValue) shr 2;
1683
pal.green := byte(GreenValue) shr 2;
1684
pal.blue := byte(BlueValue) shr 2;
1685
{ use the set/get palette function }
1686
if VESAInfo.Version >= $0200 then
1688
{ check if blanking bit must be set when programming }
1690
if (VESAInfo.caps and attrSnowCheck) <> 0 then
1695
{ Alllocate real mode buffer }
1697
Ptr:=GlobalDosAlloc(sizeof(palrec));
1698
{ get the selector values }
1699
PalPtr := pointer(Ptr shl 16);
1700
if not assigned(PalPtr) then
1703
Ptr:=Global_Dos_Alloc(sizeof(palrec));
1705
{get the segment value}
1706
RealSeg := word(Ptr shr 16);
1707
{ setup interrupt registers }
1708
FillChar(regs, sizeof(regs), #0);
1709
{ copy palette values to real mode buffer }
1711
move(pal, palptr^, sizeof(pal));
1713
DosMemPut(RealSeg,0,pal,sizeof(pal));
1716
regs.ebx := FunctionNr;
1718
regs.edx := ColorNum;
1720
regs.edi := 0; { offset is always zero }
1721
RealIntr($10, regs);
1723
{ free real mode memory }
1725
GlobalDosFree(word(Ptr and $ffff));
1727
If not Global_Dos_Free(word(Ptr and $ffff)) then
1731
if word(regs.eax) <> $004F then
1734
logln('setvesargbpalette failed while directcolor = false!');
1736
_GraphResult := grError;
1741
{ assume it's fully VGA compatible palette-wise. }
1743
SetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
1748
Procedure GetVESARGBPalette(ColorNum: integer; Var
1749
RedValue, GreenValue, BlueValue : integer);
1755
regs : TDPMIRegisters;
1762
logln('getvesargbpalette called with directcolor = true');
1764
_GraphResult := grError;
1767
{ use the set/get palette function }
1768
if VESAInfo.Version >= $0200 then
1770
{ Alllocate real mode buffer }
1772
Ptr:=GlobalDosAlloc(sizeof(palrec));
1773
{ get the selector value }
1774
PalPtr := pointer(longint(Ptr and $0000ffff) shl 16);
1775
if not assigned(PalPtr) then
1778
Ptr:=Global_Dos_Alloc(sizeof(palrec));
1780
{ get the segment value }
1781
RealSeg := word(Ptr shr 16);
1782
{ setup interrupt registers }
1783
FillChar(regs, sizeof(regs), #0);
1786
regs.ebx := $01; { get palette data }
1788
regs.edx := ColorNum;
1790
regs.edi := 0; { offset is always zero }
1791
RealIntr($10, regs);
1793
{ copy to protected mode buffer ... }
1795
Move(PalPtr^, Pal, sizeof(pal));
1797
DosMemGet(RealSeg,0,Pal,sizeof(pal));
1799
{ free real mode memory }
1801
GlobalDosFree(word(Ptr and $ffff));
1803
If not Global_Dos_Free(word(Ptr and $ffff)) then
1807
if word(regs.eax) <> $004F then
1810
logln('getvesargbpalette failed while directcolor = false!');
1812
_GraphResult := grError;
1817
RedValue := Integer(pal.Red);
1818
GreenValue := Integer(pal.Green);
1819
BlueValue := Integer(pal.Blue);
1823
GetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
1827
Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
1828
BlueValue : Integer); far;
1830
FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
1832
Error : boolean; { VBE call error }
1836
_GraphResult := grError;
1841
if not assigned(pal) then RunError(203);
1843
pal^.red := byte(RedValue);
1844
pal^.green := byte(GreenValue);
1845
pal^.blue := byte(BlueValue);
1846
{ use the set/get palette function }
1847
if VESAInfo.Version >= $0200 then
1849
{ check if blanking bit must be set when programming }
1851
if (VESAInfo.caps and attrSnowCheck) <> 0 then
1856
mov ax, 4F09h { Set/Get Palette data }
1857
mov bl, [FunctionNr] { Set palette data }
1858
mov cx, 01h { update one palette reg. }
1859
mov dx, [ColorNum] { register number to update }
1860
les di, [pal] { get palette address }
1862
cmp ax, 004Fh { check if success }
1871
_GraphResult := grError;
1876
{ assume it's fully VGA compatible palette-wise. }
1878
SetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
1885
Procedure GetVESARGBPalette(ColorNum: integer; Var RedValue, GreenValue,
1886
BlueValue : integer); far;
1893
_GraphResult := grError;
1898
if not assigned(pal) then RunError(203);
1899
FillChar(pal^, sizeof(palrec), #0);
1900
{ use the set/get palette function }
1901
if VESAInfo.Version >= $0200 then
1904
mov ax, 4F09h { Set/Get Palette data }
1905
mov bl, 01h { Set palette data }
1906
mov cx, 01h { update one palette reg. }
1907
mov dx, [ColorNum] { register number to update }
1908
les di, [pal] { get palette address }
1910
cmp ax, 004Fh { check if success }
1917
RedValue := Integer(pal^.Red);
1918
GreenValue := Integer(pal^.Green);
1919
BlueValue := Integer(pal^.Blue);
1924
_GraphResult := grError;
1929
GetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
1937
heaperrorproc=function(size:longint):integer;
1940
HeapErrorIsHooked : boolean = false;
1941
OldHeapError : HeapErrorProc = nil;
1942
DsLimit : dword = 0;
1944
function NewHeapError(size : longint) : integer;
1946
set_segment_limit(get_ds,DsLimit);
1947
NewHeapError:=OldHeapError(size);
1948
DsLimit:=get_segment_limit(get_ds);
1949
{ The base of ds can be changed
1950
we need to compute the address again PM }
1951
LFBPointer:=pointer(FrameBufferLinearAddress-get_segment_base_address(get_ds));
1952
if dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1 > DsLimit then
1953
set_segment_limit(get_ds,dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1);
1956
procedure HookHeapError;
1958
if HeapErrorIsHooked then
1960
DsLimit:=get_segment_limit(get_ds);
1961
OldHeapError:=HeapErrorProc(HeapError);
1962
HeapError:=@NewHeapError;
1963
HeapErrorIsHooked:=true;
1966
procedure UnHookHeapError;
1968
if not HeapErrorIsHooked then
1971
set_segment_limit(get_ds,DsLimit);
1972
HeapError:=OldHeapError;
1973
HeapErrorIsHooked:=false;
1977
function SetupLinear(var ModeInfo: TVESAModeInfo;mode : word) : boolean;
1993
DirectPutPixel:=@DirectPutPixVESA32kor64kLinear;
1994
PutPixel:=@PutPixVESA32kor64kLinear;
1995
GetPixel:=@GetPixVESA32kor64kLinear;
1996
{ linear mode for lines not yet implemented PM }
1997
HLine:=@HLineDefault;
1998
VLine:=@VLineDefault;
1999
GetScanLine := @GetScanLineDefault;
2000
PatternLine := @PatternLineDefault;
2008
DirectPutPixel:=@DirectPutPixVESA256Linear;
2009
PutPixel:=@PutPixVESA256Linear;
2010
GetPixel:=@GetPixVESA256Linear;
2011
{ linear mode for lines not yet implemented PM }
2012
HLine:=@HLineDefault;
2013
VLine:=@VLineDefault;
2014
GetScanLine := @GetScanLineDefault;
2015
PatternLine := @PatternLineDefault;
2020
FrameBufferLinearAddress:=Get_linear_addr(VESAModeInfo.PhysAddress and $FFFF0000,
2021
VESAInfo.TotalMem shl 16);
2023
logln('framebuffer linear address: '+hexstr(FrameBufferLinearAddress div (1024*1024),8));
2024
logln('total mem shl 16: '+strf(vesainfo.totalmem shl 16));
2026
if int31error<>0 then
2029
logln('Unable to get linear address for '+hexstr(VESAModeInfo.PhysAddress,8));
2031
writeln(stderr,'Unable to get linear address for ',hexstr(VESAModeInfo.PhysAddress,8));
2034
if UseNoSelector then
2037
LFBPointer:=pointer(FrameBufferLinearAddress-get_segment_base_address(get_ds));
2038
if dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1 > dword(get_segment_limit(get_ds)) then
2039
set_segment_limit(get_ds,dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1);
2043
WinWriteSeg:=allocate_ldt_descriptors(1);
2045
logln('writeseg1: '+hexstr(winwriteseg,8));
2047
set_segment_base_address(WinWriteSeg,FrameBufferLinearAddress);
2048
set_segment_limit(WinWriteSeg,(VESAInfo.TotalMem shl 16)-1);
2049
lock_linear_region(FrameBufferLinearAddress,(VESAInfo.TotalMem shl 16));
2050
if int31error<>0 then
2053
logln('Error in linear memory selectors creation');
2055
writeln(stderr,'Error in linear memory selectors creation');
2062
{ WinSize:=(VGAInfo.TotalMem shl 16);
2063
WinLoMask:=(VGAInfo.TotalMem shl 16)-1;
2065
Temp:=VGAInfo.TotalMem;
2074
procedure SetupWindows(var ModeInfo: TVESAModeInfo);
2077
{ now we check the windowing scheme ...}
2078
if (ModeInfo.WinAAttr and WinSupported) <> 0 then
2079
{ is this window supported ... }
2081
{ now check if the window is R/W }
2082
if (ModeInfo.WinAAttr and WinReadable) <> 0 then
2085
WinReadSeg := ModeInfo.WinASeg;
2087
if (ModeInfo.WinAAttr and WinWritable) <> 0 then
2090
WinWriteSeg := ModeInfo.WinASeg;
2093
if (ModeInfo.WinBAttr and WinSupported) <> 0 then
2094
{ is this window supported ... }
2097
{ OPTIMIZATION ... }
2098
{ if window A supports both read/write, then we try to optimize }
2099
{ everything, by using a different window for Read and/or write.}
2100
if (WinReadSeg <> 0) and (WinWriteSeg <> 0) then
2102
{ check if winB supports read }
2103
if (ModeInfo.WinBAttr and winReadable) <> 0 then
2105
WinReadSeg := ModeInfo.WinBSeg;
2109
{ check if WinB supports write }
2110
if (ModeInfo.WinBAttr and WinWritable) <> 0 then
2112
WinWriteSeg := ModeInfo.WinBSeg;
2117
{ Window A only supported Read OR Write, no we have to make }
2118
{ sure that window B supports the other mode. }
2119
if (WinReadSeg = 0) and (WinWriteSeg<>0) then
2121
if (ModeInfo.WinBAttr and WinReadable <> 0) then
2124
WinReadSeg := ModeInfo.WinBSeg;
2127
{ impossible, this VESA mode is WRITE only! }
2129
WriteLn('Invalid VESA Window attribute.');
2134
if (winWriteSeg = 0) and (WinReadSeg<>0) then
2136
if (ModeInfo.WinBAttr and WinWritable) <> 0 then
2139
WinWriteSeg := ModeInfo.WinBSeg;
2142
{ impossible, this VESA mode is READ only! }
2144
WriteLn('Invalid VESA Window attribute.');
2149
if (winReadSeg = 0) and (winWriteSeg = 0) then
2150
{ no read/write in this mode! }
2152
WriteLn('Invalid VESA Window attribute.');
2158
{ if both windows are not supported, then we can assume }
2159
{ that there is ONE single NON relocatable window. }
2160
if (WinWriteSeg = 0) and (WinReadSeg = 0) then
2162
WinWriteSeg := ModeInfo.WinASeg;
2163
WinReadSeg := ModeInfo.WinASeg;
2166
{ 16-bit Protected mode checking code... }
2167
{ change segment values to protected mode }
2169
if WinReadSeg = $A000 then
2170
WinReadSeg := SegA000
2172
if WinReadSeg = $B000 then
2173
WinReadSeg := SegB000
2175
if WinReadSeg = $B800 then
2176
WinReadSeg := SegB800
2179
WriteLn('Invalid segment address.');
2182
if WinWriteSeg = $A000 then
2183
WinWriteSeg := SegA000
2185
if WinWriteSeg = $B000 then
2186
WinWriteSeg := SegB000
2188
if WinWriteSeg = $B800 then
2189
WinWriteSeg := SegB800
2192
WriteLn('Invalid segment address.');
2200
function setVESAMode(mode:word):boolean;
2204
{ Init mode information, for compatibility with VBE < 1.1 }
2205
FillChar(VESAModeInfo, sizeof(TVESAModeInfo), #0);
2206
{ get the video mode information }
2207
if getVESAModeInfo(VESAmodeinfo, mode) then
2209
{ checks if the hardware supports the video mode. }
2210
if (VESAModeInfo.attr and modeAvail) = 0 then
2212
SetVESAmode := FALSE;
2214
logln(' vesa mode '+strf(mode)+' not supported!!!');
2216
_GraphResult := grError;
2220
SetVESAMode := TRUE;
2222
while (64 shr BankShift) <> VESAModeInfo.WinGranularity do
2224
CurrentWriteBank := -1;
2225
CurrentReadBank := -1;
2226
BytesPerLine := VESAModeInfo.BytesPerScanLine;
2228
{ These are the window adresses ... }
2229
WinWriteSeg := 0; { This is the segment to use for writes }
2230
WinReadSeg := 0; { This is the segment to use for reads }
2234
{ VBE 2.0 and higher supports >= non VGA linear buffer types...}
2235
{ this is backward compatible. }
2236
if (((VESAModeInfo.Attr and ModeNoWindowed) <> 0) or UseLFB) and
2237
((VESAModeInfo.Attr and ModeLinearBuffer) <> 0) then
2239
if not SetupLinear(VESAModeInfo,mode) then
2240
SetUpWindows(VESAModeInfo);
2243
{ if linear and windowed is supported, then use windowed }
2245
SetUpWindows(VESAModeInfo);
2248
LogLn('Entering vesa mode '+strf(mode));
2249
LogLn('Read segment: $'+hexstr(winreadseg,4));
2250
LogLn('Write segment: $'+hexstr(winwriteseg,4));
2251
LogLn('Window granularity: '+strf(VESAModeInfo.WinGranularity)+'kb');
2252
LogLn('Window size: '+strf(VESAModeInfo.winSize)+'kb');
2253
LogLn('Bytes per line: '+strf(bytesperline));
2255
{ Select the correct mode number if we're going to use linear access! }
2275
_GraphResult := GrNotDetected
2276
else _GraphResult := grOk;
2281
function getVESAMode:word;assembler;
2282
asm {return -1 if error}
2303
{************************************************************************}
2304
{* VESA Modes inits *}
2305
{************************************************************************}
2309
{******************************************************** }
2310
{ Function GetMaxScanLines() }
2311
{-------------------------------------------------------- }
2312
{ This routine returns the maximum number of scan lines }
2313
{ possible for this mode. This is done using the Get }
2314
{ Scan Line length VBE function. }
2315
{******************************************************** }
2316
function GetMaxScanLines: word;
2318
regs : TDPMIRegisters;
2320
FillChar(regs, sizeof(regs), #0);
2321
{ play it safe, call the real mode int, the 32-bit entry point }
2322
{ may not be defined as stated in VBE v3.0 }
2323
regs.eax := $4f06; {_ setup function }
2324
regs.ebx := $0001; { get scan line length }
2325
RealIntr($10, regs);
2326
GetMaxScanLines := (regs.edx and $0000ffff);
2331
function GetMaxScanLines: word; assembler;
2341
procedure Init1280x1024x64k; {$ifndef fpc}far;{$endif fpc}
2343
SetVesaMode(m1280x1024x64k);
2344
{ Get maximum number of scanlines for page flipping }
2345
ScanLines := GetMaxScanLines;
2348
procedure Init1280x1024x32k; {$ifndef fpc}far;{$endif fpc}
2350
SetVESAMode(m1280x1024x32k);
2351
{ Get maximum number of scanlines for page flipping }
2352
ScanLines := GetMaxScanLines;
2355
procedure Init1280x1024x256; {$ifndef fpc}far;{$endif fpc}
2357
SetVESAMode(m1280x1024x256);
2358
{ Get maximum number of scanlines for page flipping }
2359
ScanLines := GetMaxScanLines;
2363
procedure Init1280x1024x16; {$ifndef fpc}far;{$endif fpc}
2365
SetVESAMode(m1280x1024x16);
2366
{ Get maximum number of scanlines for page flipping }
2367
ScanLines := GetMaxScanLines;
2370
procedure Init1024x768x64k; {$ifndef fpc}far;{$endif fpc}
2372
SetVESAMode(m1024x768x64k);
2373
{ Get maximum number of scanlines for page flipping }
2374
ScanLines := GetMaxScanLines;
2377
procedure Init640x480x32k; {$ifndef fpc}far;{$endif fpc}
2379
SetVESAMode(m640x480x32k);
2380
{ Get maximum number of scanlines for page flipping }
2381
ScanLines := GetMaxScanLines;
2384
procedure Init1024x768x256; {$ifndef fpc}far;{$endif fpc}
2386
SetVESAMode(m1024x768x256);
2387
{ Get maximum number of scanlines for page flipping }
2388
ScanLines := GetMaxScanLines;
2391
procedure Init1024x768x16; {$ifndef fpc}far;{$endif fpc}
2393
SetVESAMode(m1024x768x16);
2394
{ Get maximum number of scanlines for page flipping }
2395
ScanLines := GetMaxScanLines;
2398
procedure Init800x600x64k; {$ifndef fpc}far;{$endif fpc}
2400
SetVESAMode(m800x600x64k);
2401
{ Get maximum number of scanlines for page flipping }
2402
ScanLines := GetMaxScanLines;
2405
procedure Init800x600x32k; {$ifndef fpc}far;{$endif fpc}
2407
SetVESAMode(m800x600x32k);
2408
{ Get maximum number of scanlines for page flipping }
2409
ScanLines := GetMaxScanLines;
2412
procedure Init800x600x256; {$ifndef fpc}far;{$endif fpc}
2414
SetVESAMode(m800x600x256);
2415
{ Get maximum number of scanlines for page flipping }
2416
ScanLines := GetMaxScanLines;
2419
procedure Init800x600x16; {$ifndef fpc}far;{$endif fpc}
2421
SetVesaMode(m800x600x16);
2422
{ Get maximum number of scanlines for page flipping }
2423
ScanLines := GetMaxScanLines;
2426
procedure Init640x480x64k; {$ifndef fpc}far;{$endif fpc}
2428
SetVESAMode(m640x480x64k);
2429
{ Get maximum number of scanlines for page flipping }
2430
ScanLines := GetMaxScanLines;
2434
procedure Init640x480x256; {$ifndef fpc}far;{$endif fpc}
2436
SetVESAMode(m640x480x256);
2437
{ Get maximum number of scanlines for page flipping }
2438
ScanLines := GetMaxScanLines;
2441
procedure Init640x400x256; {$ifndef fpc}far;{$endif fpc}
2443
SetVESAMode(m640x400x256);
2444
{ Get maximum number of scanlines for page flipping }
2445
ScanLines := GetMaxScanLines;
2448
procedure Init320x200x64k; {$ifndef fpc}far;{$endif fpc}
2450
SetVESAMode(m320x200x64k);
2451
{ Get maximum number of scanlines for page flipping }
2452
ScanLines := GetMaxScanLines;
2455
procedure Init320x200x32k; {$ifndef fpc}far;{$endif fpc}
2457
SetVESAMode(m320x200x32k);
2458
{ Get maximum number of scanlines for page flipping }
2459
ScanLines := GetMaxScanLines;
2465
Procedure SaveStateVESA; {$ifndef fpc}far;{$endif fpc}
2468
regs: TDPMIRegisters;
2470
SaveSupported := FALSE;
2473
LogLn('Get the video mode...');
2475
{ Get the video mode }
2487
{ saving/restoring video state screws up Windows (JM) }
2491
LogLn('Prepare to save VESA video state');
2493
{ Prepare to save video state...}
2495
mov ax, 4F04h { get buffer size to save state }
2497
mov cx, 00001111b { Save DAC / Data areas / Hardware states }
2508
mov [SaveSupported],TRUE
2514
RealIntr($10, regs);
2515
StateSize := word(regs.ebx);
2516
if byte(regs.eax) = $4f then
2517
SaveSupported := TRUE;
2518
if SaveSupported then
2521
LogLn('allocating VESA save buffer of '+strf(64*StateSize));
2524
PtrLong:=GlobalDosAlloc(64*StateSize); { values returned in 64-byte blocks }
2526
PtrLong:=Global_Dos_Alloc(64*StateSize); { values returned in 64-byte blocks }
2530
SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
2532
{ In FPC mode, we can't do anything with this (no far pointers) }
2533
{ However, we still need to keep it to be able to free the }
2534
{ memory afterwards. Since this data is not accessed in PM code, }
2535
{ there's no need to save it in a seperate buffer (JM) }
2536
if not assigned(SavePtr) then
2539
RealStateSeg := word(PtrLong shr 16);
2541
FillChar(regs, sizeof(regs), #0);
2542
{ call the real mode interrupt ... }
2543
regs.eax := $4F04; { save the state buffer }
2544
regs.ecx := $0F; { Save DAC / Data areas / Hardware states }
2545
regs.edx := $01; { save state }
2546
regs.es := RealStateSeg;
2549
FillChar(regs, sizeof(regs), #0);
2550
{ restore state, according to Ralph Brown Interrupt list }
2551
{ some BIOS corrupt the hardware after a save... }
2552
regs.eax := $4F04; { restore the state buffer }
2553
regs.ecx := $0F; { rest DAC / Data areas / Hardware states }
2555
regs.es := RealStateSeg;
2561
procedure RestoreStateVESA; {$ifndef fpc}far;{$endif fpc}
2563
regs:TDPMIRegisters;
2565
{ go back to the old video mode...}
2577
{ then restore all state information }
2579
if assigned(SavePtr) and (SaveSupported=TRUE) then
2581
{ No far pointer support, so it's possible that that assigned(SavePtr) }
2582
{ would return false under FPC. Just check if it's different from nil. }
2583
if (SavePtr <> nil) and (SaveSupported=TRUE) then
2586
FillChar(regs, sizeof(regs), #0);
2587
{ restore state, according to Ralph Brown Interrupt list }
2588
{ some BIOS corrupt the hardware after a save... }
2589
regs.eax := $4F04; { restore the state buffer }
2590
regs.ecx := $0F; { rest DAC / Data areas / Hardware states }
2591
regs.edx := $02; { restore state }
2592
regs.es := RealStateSeg;
2596
if GlobalDosFree(longint(SavePtr) shr 16)<>0 then
2598
if Not(Global_Dos_Free(longint(SavePtr) shr 16)) then
2607
{**************************************************************}
2608
{* Real mode routines *}
2609
{**************************************************************}
2611
Procedure SaveStateVESA; far;
2614
SaveSupported := FALSE;
2615
{ Get the video mode }
2621
{ Prepare to save video state...}
2623
mov ax, 4f04h { get buffer size to save state }
2624
mov cx, 00001111b { Save DAC / Data areas / Hardware states }
2630
mov [SaveSupported],TRUE
2633
if SaveSupported then
2635
GetMem(SavePtr, 64*StateSize); { values returned in 64-byte blocks }
2636
if not assigned(SavePtr) then
2639
mov ax, 4F04h { save the state buffer }
2640
mov cx, 00001111b { Save DAC / Data areas / Hardware states }
2642
mov es, WORD PTR [SavePtr+2]
2643
mov bx, WORD PTR [SavePtr]
2646
{ restore state, according to Ralph Brown Interrupt list }
2647
{ some BIOS corrupt the hardware after a save... }
2649
mov ax, 4F04h { save the state buffer }
2650
mov cx, 00001111b { Save DAC / Data areas / Hardware states }
2652
mov es, WORD PTR [SavePtr+2]
2653
mov bx, WORD PTR [SavePtr]
2659
procedure RestoreStateVESA; far;
2661
{ go back to the old video mode...}
2668
{ then restore all state information }
2669
if assigned(SavePtr) and (SaveSupported=TRUE) then
2671
{ restore state, according to Ralph Brown Interrupt list }
2673
mov ax, 4F04h { save the state buffer }
2674
mov cx, 00001111b { Save DAC / Data areas / Hardware states }
2675
mov dx, 02h { restore state }
2676
mov es, WORD PTR [SavePtr+2]
2677
mov bx, WORD PTR [SavePtr]
2680
FreeMem(SavePtr, 64*StateSize);
2686
{************************************************************************}
2687
{* VESA Page flipping routines *}
2688
{************************************************************************}
2689
{ Note: These routines, according to the VBE3 specification, will NOT }
2690
{ work with the 24 bpp modes, because of the alignment. }
2691
{************************************************************************}
2693
{******************************************************** }
2694
{ Procedure SetVisualVESA() }
2695
{-------------------------------------------------------- }
2696
{ This routine changes the page which will be displayed }
2697
{ on the screen, since the method has changed somewhat }
2698
{ between VBE versions , we will use the old method where }
2699
{ the new pixel offset is used to display different pages }
2700
{******************************************************** }
2701
procedure SetVisualVESA(page: word); {$ifndef fpc}far;{$endif fpc}
2703
newStartVisible : word;
2705
if page > HardwarePages then
2707
_graphresult := grError;
2710
newStartVisible := (MaxY+1)*page;
2711
if newStartVisible > ScanLines then
2713
_graphresult := grError;
2718
mov bx, 0000h { set display start }
2719
mov cx, 0000h { pixel zero ! }
2720
mov dx, [NewStartVisible] { new scanline }
2731
procedure SetActiveVESA(page: word); {$ifndef fpc}far;{$endif fpc}
2733
{ video offset is in pixels under VESA VBE! }
2734
{ This value is reset after a mode set to page ZERO = YOffset = 0 ) }
2735
if page > HardwarePages then
2737
_graphresult := grError;
2740
YOffset := (MaxY+1)*page;
2741
LinearPageOfs := YOffset*(MaxX+1);
2746
Revision 1.12 2005/02/14 17:13:22 peter
2749
Revision 1.11 2005/02/02 11:57:19 jonas
2750
* fix from Tomas for calling conventions
added
removed
rtl/go32v2/vesa.inc
