| blob | 061ebeadd682e5fdd2caaeb1578566d34e323fb6 |
1 {
2 $Id$
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 **********************************************************************}
16 type
18 palrec = packed record { record used for set/get DAC palette }
19 blue, green, red, align: byte;
20 end;
22 const
23 { VESA attributes }
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) }
38 { window attributes }
39 winSupported = $01;
40 winReadable = $02;
41 winWritable = $04;
43 { memory model }
44 modelText = $00;
45 modelCGA = $01;
46 modelHerc = $02;
47 model4plane = $03;
48 modelPacked = $04;
49 modelModeX = $05;
50 modelRGB = $06;
51 modelYUV = $07;
53 {$ifndef dpmi}
54 {$i vesah.inc}
55 { otherwise it's already included in graph.pp }
56 {$endif dpmi}
58 var
60 BytesPerLine: word; { Number of bytes per scanline }
61 YOffset : word; { Pixel offset for VESA page flipping }
63 { window management }
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;
81 const
82 HexTbl : array[0..15] of char='0123456789ABCDEF';
83 var
84 i : longint;
85 begin
86 hexstr[0]:=char(cnt);
87 for i:=cnt downto 1 do
88 begin
89 hexstr[i]:=hextbl[val and $f];
90 val:=val shr 4;
91 end;
92 end;
95 {$IFDEF DPMI}
97 function getVESAInfo(var VESAInfo: TVESAInfo) : boolean;
98 var
99 ptrlong : longint;
100 VESAPtr : ^TVESAInfo;
101 st : string[4];
102 regs : TDPMIRegisters;
103 {$ifndef fpc}
104 ModeSel: word;
105 offs: longint;
106 {$endif fpc}
107 { added... }
108 modelist: PmodeList;
109 i: longint;
110 RealSeg : word;
111 begin
112 { Allocate real mode buffer }
113 {$ifndef fpc}
114 Ptrlong:=GlobalDosAlloc(sizeof(TVESAInfo));
115 { Get selector value }
116 VESAPtr := pointer(Ptrlong shl 16);
117 {$else fpc}
118 Ptrlong:=Global_Dos_Alloc(sizeof(TVESAInfo));
119 New(VESAPtr);
120 {$endif fpc}
121 { Get segment value }
122 RealSeg := word(Ptrlong shr 16);
123 if not assigned(VESAPtr) then
124 RunError(203);
125 FillChar(regs, sizeof(regs), #0);
127 { Get VESA Mode information ... }
128 regs.eax := $4f00;
129 regs.es := RealSeg;
130 regs.edi := $00;
131 RealIntr($10, regs);
132 {$ifdef fpc}
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));
136 {$endif fpc}
137 St:=Vesaptr^.signature;
138 if st<>'VESA' then
139 begin
140 {$ifdef logging}
141 LogLn('No VESA detected.');
142 {$endif logging}
143 getVesaInfo := FALSE;
144 {$ifndef fpc}
145 GlobalDosFree(word(PtrLong and $ffff));
146 {$else fpc}
147 If not Global_Dos_Free(word(PtrLong and $ffff)) then
148 RunError(216);
149 { also free the extra allocated buffer }
150 Dispose(VESAPtr);
151 {$endif fpc}
152 exit;
153 end
154 else
155 getVesaInfo := TRUE;
157 {$ifndef fpc}
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 }
166 { returned. }
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);
181 {$else fpc}
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 }
184 New(ModeList);
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
196 RunError(216);
197 Dispose(VESAPtr);
198 {$endif fpc}
200 i:=0;
201 new(VESAInfo.ModeList);
202 while ModeList^[i]<> $ffff do
203 begin
204 {$ifdef logging}
205 LogLn('Found mode $'+hexstr(ModeList^[i],4));
206 {$endif loggin}
207 VESAInfo.ModeList^[i] := ModeList^[i];
208 Inc(i);
209 end;
210 VESAInfo.ModeList^[i]:=$ffff;
211 { Free the temporary selector used to get mode information }
212 {$ifdef logging}
213 LogLn(strf(i) + ' modes found.');
214 {$endif logging}
215 {$ifndef fpc}
216 FreeSelector(ModeSel);
217 {$else fpc}
218 Dispose(ModeList);
219 {$endif fpc}
220 end;
222 function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;
223 var
224 Ptr: longint;
225 {$ifndef fpc}
226 VESAPtr : ^TVESAModeInfo;
227 {$endif fpc}
228 regs : TDPMIRegisters;
229 RealSeg: word;
230 begin
231 { Alllocate real mode buffer }
232 {$ifndef fpc}
233 Ptr:=GlobalDosAlloc(sizeof(TVESAModeInfo));
234 { get the selector value }
235 VESAPtr := pointer(longint(Ptr shl 16));
236 if not assigned(VESAPtr) then
237 RunError(203);
238 {$else fpc}
239 Ptr:=Global_Dos_Alloc(sizeof(TVESAModeInfo));
240 {$endif fpc}
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...}
246 regs.eax := $4f01;
247 regs.es := RealSeg;
248 regs.edi := $00;
249 regs.ecx := mode;
250 RealIntr($10, regs);
251 if word(regs.eax) <> $4f then
252 getVESAModeInfo := FALSE
253 else
254 getVESAModeInfo := TRUE;
255 { copy to protected mode buffer ... }
256 {$ifndef fpc}
257 Move(VESAPtr^, ModeInfo, sizeof(ModeInfo));
258 {$else fpc}
259 DosMemGet(RealSeg,0,ModeInfo,sizeof(ModeInfo));
260 {$endif fpc}
261 { free real mode memory }
262 {$ifndef fpc}
263 GlobalDosFree(Word(Ptr and $ffff));
264 {$else fpc}
265 If not Global_Dos_Free(Word(Ptr and $ffff)) then
266 RunError(216);
267 {$endif fpc}
268 end;
270 {$ELSE}
271 function getVESAInfo(var VESAInfo: TVESAInfo) : boolean; assembler;
272 asm
273 mov ax,4F00h
274 les di,VESAInfo
275 int 10h
276 sub ax,004Fh {make sure we got 004Fh back}
277 cmp ax,1
278 sbb al,al
279 cmp word ptr es:[di],'V'or('E'shl 8) {signature should be 'VESA'}
280 jne @@ERR
281 cmp word ptr es:[di+2],'S'or('A'shl 8)
282 je @@X
283 @@ERR:
284 mov al,0
285 @@X:
286 end;
289 function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;assembler;
290 asm
291 mov ax,4F01h
292 mov cx,mode
293 les di,ModeInfo
294 int 10h
295 sub ax,004Fh {make sure it's 004Fh}
296 cmp ax,1
297 sbb al,al
298 end;
300 {$ENDIF}
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 {********************************************************}
308 var
309 i: word;
310 ModeSupported : Boolean;
311 begin
312 i:=0;
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;
317 repeat
318 if VESAInfo.ModeList^[i] = mode then
319 begin
320 { we found it, the card supports this mode... }
321 ModeSupported := TRUE;
322 break;
323 end;
324 Inc(i);
325 until VESAInfo.ModeList^[i] = $ffff;
326 { now check if the hardware supports it... }
327 If ModeSupported then
328 begin
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
335 else
336 ModeSupported := FALSE;
337 end;
338 SearchVESAModes := ModeSupported;
339 end;
343 procedure SetBankIndex(win: byte; BankNr: Integer); assembler;
344 asm
345 mov ax,4f05h
346 mov bh,00h
347 mov bl,[Win]
348 mov dx,[BankNr]
349 {$ifdef fpc}
350 push ebp
351 {$endif fpc}
352 int 10h
353 {$ifdef fpc}
354 pop ebp
355 {$endif fpc}
356 end;
358 {********************************************************}
359 { There are two routines for setting banks. This may in }
360 { in some cases optimize a bit some operations, if the }
361 { hardware supports it, because one window is used for }
362 { reading and one window is used for writing. }
363 {********************************************************}
364 procedure SetReadBank(BankNr: Integer);
365 begin
366 { check if this is the current bank... if so do nothing. }
367 if BankNr = CurrentReadBank then exit;
368 {$ifdef logging}
369 { LogLn('Setting read bank to '+strf(BankNr));}
370 {$endif logging}
371 CurrentReadBank := BankNr; { save current bank number }
372 BankNr := BankNr shl BankShift; { adjust to window granularity }
373 { we set both banks, since one may read only }
374 SetBankIndex(ReadWindow, BankNr);
375 { if the hardware supports only one window }
376 { then there is only one single bank, so }
377 { update both bank numbers. }
378 if ReadWindow = WriteWindow then
379 CurrentWriteBank := CurrentReadBank;
380 end;
382 procedure SetWriteBank(BankNr: Integer);
383 begin
384 { check if this is the current bank... if so do nothing. }
385 if BankNr = CurrentWriteBank then exit;
386 {$ifdef logging}
387 { LogLn('Setting write bank to '+strf(BankNr));}
388 {$endif logging}
389 CurrentWriteBank := BankNr; { save current bank number }
390 BankNr := BankNr shl BankShift; { adjust to window granularity }
391 { we set both banks, since one may read only }
392 SetBankIndex(WriteWindow, BankNr);
393 { if the hardware supports only one window }
394 { then there is only one single bank, so }
395 { update both bank numbers. }
396 if ReadWindow = WriteWindow then
397 CurrentReadBank := CurrentWriteBank;
398 end;
400 {************************************************************************}
401 {* 8-bit pixels VESA mode routines *}
402 {************************************************************************}
404 procedure PutPixVESA256(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
405 var
406 offs : longint;
407 begin
408 X:= X + StartXViewPort;
409 Y:= Y + StartYViewPort;
410 { convert to absolute coordinates and then verify clipping...}
411 if ClipPixels then
412 Begin
413 if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
414 exit;
415 if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
416 exit;
417 end;
418 Y := Y + YOffset; { adjust pixel for correct virtual page }
419 offs := longint(y) * BytesPerLine + x;
420 begin
421 SetWriteBank(integer(offs shr 16));
422 mem[WinWriteSeg : word(offs)] := byte(color);
423 end;
424 end;
426 procedure DirectPutPixVESA256(x, y : integer); {$ifndef fpc}far;{$endif fpc}
427 var
428 offs : longint;
429 col : byte;
430 begin
431 offs := (longint(y) + YOffset) * BytesPerLine + x;
432 Case CurrentWriteMode of
433 XorPut:
434 Begin
435 SetReadBank(integer(offs shr 16));
436 col := mem[WinReadSeg : word(offs)] xor byte(CurrentColor);
437 End;
438 AndPut:
439 Begin
440 SetReadBank(integer(offs shr 16));
441 col := mem[WinReadSeg : word(offs)] And byte(CurrentColor);
442 End;
443 OrPut:
444 Begin
445 SetReadBank(integer(offs shr 16));
446 col := mem[WinReadSeg : word(offs)] or byte(currentcolor);
447 End
448 else
449 Begin
450 If CurrentWriteMode <> NotPut then
451 col := Byte(CurrentColor)
452 else col := Not(Byte(CurrentColor));
453 End
454 End;
455 SetWriteBank(integer(offs shr 16));
456 mem[WinWriteSeg : word(offs)] := Col;
457 end;
459 function GetPixVESA256(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
460 var
461 offs : longint;
462 begin
463 X:= X + StartXViewPort;
464 Y:= Y + StartYViewPort + YOffset;
465 offs := longint(y) * BytesPerLine + x;
466 SetReadBank(integer(offs shr 16));
467 GetPixVESA256:=mem[WinReadSeg : word(offs)];
468 end;
470 Procedure GetScanLineVESA256(x1, x2, y: integer; var data); {$ifndef fpc}far;{$endif}
471 var offs: Longint;
472 l, amount, bankrest, index, pixels: longint;
473 curbank: integer;
474 begin
475 inc(x1,StartXViewPort);
476 inc(x2,StartXViewPort);
477 {$ifdef logging}
478 LogLn('getscanline256 '+strf(x1)+' - '+strf(x2)+' at '+strf(y+StartYViewPort));
479 {$endif logging}
480 index := 0;
481 amount := x2-x1+1;
482 Offs:=(Longint(y)+StartYViewPort+YOffset)*bytesperline+x1;
483 Repeat
484 curbank := integer(offs shr 16);
485 SetReadBank(curbank);
486 {$ifdef logging}
487 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
488 {$endif logging}
489 If ((amount >= 4) and
490 ((offs and 3) = 0)) or
491 (amount >= 4+4-(offs and 3)) Then
492 { allign target }
493 Begin
494 If (offs and 3) <> 0 then
495 { this cannot go past a window boundary bacause the }
496 { size of a window is always a multiple of 4 }
497 Begin
498 {$ifdef logging}
499 LogLn('Alligning by reading '+strf(4-(offs and 3))+' pixels');
500 {$endif logging}
501 for l := 1 to 4-(offs and 3) do
502 WordArray(Data)[index+l-1] :=
503 Mem[WinReadSeg:word(offs)+l-1];
504 inc(index, l);
505 inc(offs, l);
506 dec(amount, l);
507 End;
508 {$ifdef logging}
509 LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
510 {$endif logging}
511 { offs is now 4-bytes alligned }
512 If amount <= ($10000-(Offs and $ffff)) Then
513 bankrest := amount
514 else {the rest won't fit anymore in the current window }
515 bankrest := $10000 - (Offs and $ffff);
516 { it is possible that by aligning, we ended up in a new }
517 { bank, so set the correct bank again to make sure }
518 setreadbank(offs shr 16);
519 {$ifdef logging}
520 LogLn('Rest to be read from this window: '+strf(bankrest));
521 {$endif logging}
522 For l := 0 to (Bankrest div 4)-1 Do
523 begin
524 pixels := MemL[WinWriteSeg:word(offs)+l*4];
525 WordArray(Data)[index+l*4] := pixels and $ff;
526 pixels := pixels shr 8;
527 WordArray(Data)[index+l*4+1] := pixels and $ff;
528 pixels := pixels shr 8;
529 WordArray(Data)[index+l*4+2] := pixels and $ff;
530 pixels := pixels shr 8;
531 WordArray(Data)[index+l*4+3] := pixels{ and $ff};
532 end;
533 inc(index,l*4+4);
534 inc(offs,l*4+4);
535 dec(amount,l*4+4);
536 {$ifdef logging}
537 LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
538 {$endif logging}
539 End
540 Else
541 Begin
542 {$ifdef logging}
543 LogLn('Leftover: '+strf(amount)+' at offset '+hexstr(offs,8));
544 {$endif logging}
545 For l := 0 to amount - 1 do
546 begin
547 { this may cross a bank at any time, so adjust }
548 { because this loop alwys runs for very little pixels, }
549 { there's little gained by splitting it up }
550 setreadbank(offs shr 16);
551 WordArray(Data)[index+l] := mem[WinReadSeg:word(offs)];
552 inc(offs);
553 end;
554 amount := 0
555 End
556 Until amount = 0;
557 end;
559 procedure HLineVESA256(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
561 var Offs: Longint;
562 mask, l, bankrest: longint;
563 curbank, hlength: integer;
564 Begin
565 { must we swap the values? }
566 if x > x2 then
567 Begin
568 x := x xor x2;
569 x2 := x xor x2;
570 x:= x xor x2;
571 end;
572 { First convert to global coordinates }
573 X := X + StartXViewPort;
574 X2 := X2 + StartXViewPort;
575 Y := Y + StartYViewPort;
576 if ClipPixels then
577 Begin
578 if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
579 StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
580 exit;
581 end;
582 {$ifdef logging2}
583 LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
584 {$endif logging2}
585 HLength := x2 - x + 1;
586 {$ifdef logging2}
587 LogLn('length: '+strf(hlength));
588 {$endif logging2}
589 if HLength>0 then
590 begin
591 Offs:=(Longint(y)+YOffset)*bytesperline+x;
592 {$ifdef logging2}
593 LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
594 {$endif logging2}
595 Mask := byte(CurrentColor)+byte(CurrentColor) shl 8;
596 Mask := Mask + Mask shl 16;
597 Case CurrentWriteMode of
598 AndPut:
599 Begin
600 Repeat
601 curbank := integer(offs shr 16);
602 SetWriteBank(curbank);
603 SetReadBank(curbank);
604 {$ifdef logging2}
605 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
606 {$endif logging2}
607 If ((HLength >= 4) and
608 ((offs and 3) = 0)) or
609 (HLength >= 4+4-(offs and 3)) Then
610 { align target }
611 Begin
612 l := 0;
613 If (offs and 3) <> 0 then
614 { this cannot go past a window boundary bacause the }
615 { size of a window is always a multiple of 4 }
616 Begin
617 {$ifdef logging2}
618 LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
619 {$endif logging2}
620 for l := 1 to 4-(offs and 3) do
621 Mem[WinWriteSeg:word(offs)+l-1] :=
622 Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor);
623 End;
624 Dec(HLength, l);
625 inc(offs, l);
626 {$ifdef logging2}
627 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
628 {$endif logging}
629 { offs is now 4-bytes alligned }
630 If HLength <= ($10000-(Offs and $ffff)) Then
631 bankrest := HLength
632 else {the rest won't fit anymore in the current window }
633 bankrest := $10000 - (Offs and $ffff);
634 { it is possible that by aligningm we ended up in a new }
635 { bank, so set the correct bank again to make sure }
636 setwritebank(offs shr 16);
637 setreadbank(offs shr 16);
638 {$ifdef logging2}
639 LogLn('Rest to be drawn in this window: '+strf(bankrest));
640 {$endif logging}
641 For l := 0 to (Bankrest div 4)-1 Do
642 MemL[WinWriteSeg:word(offs)+l*4] :=
643 MemL[WinReadSeg:word(offs)+l*4] And Mask;
644 inc(offs,l*4+4);
645 dec(hlength,l*4+4);
646 {$ifdef logging2}
647 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
648 {$endif logging}
649 End
650 Else
651 Begin
652 {$ifdef logging2}
653 LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
654 {$endif logging}
655 For l := 0 to HLength - 1 do
656 begin
657 { this may cross a bank at any time, so adjust }
658 { becauese this loop alwys runs for very little pixels, }
659 { there's little gained by splitting it up }
660 setreadbank(offs shr 16);
661 setwritebank(offs shr 16);
662 Mem[WinWriteSeg:word(offs)] :=
663 Mem[WinReadSeg:word(offs)] And byte(currentColor);
664 inc(offs);
665 end;
666 HLength := 0
667 End
668 Until HLength = 0;
669 End;
670 XorPut:
671 Begin
672 Repeat
673 curbank := integer(offs shr 16);
674 SetWriteBank(curbank);
675 SetReadBank(curbank);
676 {$ifdef logging2}
677 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
678 {$endif logging}
679 If ((HLength >= 4) and
680 ((offs and 3) = 0)) or
681 (HLength >= 4+4-(offs and 3)) Then
682 { allign target }
683 Begin
684 l := 0;
685 If (offs and 3) <> 0 then
686 { this cannot go past a window boundary bacause the }
687 { size of a window is always a multiple of 4 }
688 Begin
689 {$ifdef logging2}
690 LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
691 {$endif logging}
692 for l := 1 to 4-(offs and 3) do
693 Mem[WinWriteSeg:word(offs)+l-1] :=
694 Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor);
695 End;
696 Dec(HLength, l);
697 inc(offs, l);
698 {$ifdef logging2}
699 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
700 {$endif logging}
701 { offs is now 4-bytes alligned }
702 If HLength <= ($10000-(Offs and $ffff)) Then
703 bankrest := HLength
704 else {the rest won't fit anymore in the current window }
705 bankrest := $10000 - (Offs and $ffff);
706 { it is possible that by aligningm we ended up in a new }
707 { bank, so set the correct bank again to make sure }
708 setwritebank(offs shr 16);
709 setreadbank(offs shr 16);
710 {$ifdef logging2}
711 LogLn('Rest to be drawn in this window: '+strf(bankrest));
712 {$endif logging}
713 For l := 0 to (Bankrest div 4)-1 Do
714 MemL[WinWriteSeg:word(offs)+l*4] :=
715 MemL[WinReadSeg:word(offs)+l*4] Xor Mask;
716 inc(offs,l*4+4);
717 dec(hlength,l*4+4);
718 {$ifdef logging2}
719 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
720 {$endif logging}
721 End
722 Else
723 Begin
724 {$ifdef logging2}
725 LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
726 {$endif logging}
727 For l := 0 to HLength - 1 do
728 begin
729 { this may cross a bank at any time, so adjust }
730 { because this loop alwys runs for very little pixels, }
731 { there's little gained by splitting it up }
732 setreadbank(offs shr 16);
733 setwritebank(offs shr 16);
734 Mem[WinWriteSeg:word(offs)] :=
735 Mem[WinReadSeg:word(offs)] xor byte(currentColor);
736 inc(offs);
737 end;
738 HLength := 0
739 End
740 Until HLength = 0;
741 End;
742 OrPut:
743 Begin
744 Repeat
745 curbank := integer(offs shr 16);
746 SetWriteBank(curbank);
747 SetReadBank(curbank);
748 {$ifdef logging2}
749 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
750 {$endif logging}
751 If ((HLength >= 4) and
752 ((offs and 3) = 0)) or
753 (HLength >= 4+4-(offs and 3)) Then
754 { allign target }
755 Begin
756 l := 0;
757 If (offs and 3) <> 0 then
758 { this cannot go past a window boundary bacause the }
759 { size of a window is always a multiple of 4 }
760 Begin
761 {$ifdef logging2}
762 LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
763 {$endif logging}
764 for l := 1 to 4-(offs and 3) do
765 Mem[WinWriteSeg:word(offs)+l-1] :=
766 Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor);
767 End;
768 Dec(HLength, l);
769 inc(offs, l);
770 { it is possible that by aligningm we ended up in a new }
771 { bank, so set the correct bank again to make sure }
772 setwritebank(offs shr 16);
773 setreadbank(offs shr 16);
774 {$ifdef logging2}
775 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
776 {$endif logging}
777 { offs is now 4-bytes alligned }
778 If HLength <= ($10000-(Offs and $ffff)) Then
779 bankrest := HLength
780 else {the rest won't fit anymore in the current window }
781 bankrest := $10000 - (Offs and $ffff);
782 {$ifdef logging2}
783 LogLn('Rest to be drawn in this window: '+strf(bankrest));
784 {$endif logging}
785 For l := 0 to (Bankrest div 4)-1 Do
786 MemL[WinWriteSeg:offs+l*4] :=
787 MemL[WinReadSeg:word(offs)+l*4] Or Mask;
788 inc(offs,l*4+4);
789 dec(hlength,l*4+4);
790 {$ifdef logging2}
791 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
792 {$endif logging}
793 End
794 Else
795 Begin
796 {$ifdef logging2}
797 LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
798 {$endif logging}
799 For l := 0 to HLength - 1 do
800 begin
801 { this may cross a bank at any time, so adjust }
802 { because this loop alwys runs for very little pixels, }
803 { there's little gained by splitting it up }
804 setreadbank(offs shr 16);
805 setwritebank(offs shr 16);
806 Mem[WinWriteSeg:word(offs)] :=
807 Mem[WinReadSeg:word(offs)] And byte(currentColor);
808 inc(offs);
809 end;
810 HLength := 0
811 End
812 Until HLength = 0;
813 End
814 Else
815 Begin
816 If CurrentWriteMode = NotPut Then
817 Mask := Not(Mask);
818 Repeat
819 curbank := integer(offs shr 16);
820 SetWriteBank(curbank);
821 {$ifdef logging2}
822 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8)+' -- '+strf(offs));
823 {$endif logging}
824 If ((HLength >= 4) and
825 ((offs and 3) = 0)) or
826 (HLength >= 4+4-(offs and 3)) Then
827 { allign target }
828 Begin
829 l := 0;
830 If (offs and 3) <> 0 then
831 { this cannot go past a window boundary bacause the }
832 { size of a window is always a multiple of 4 }
833 Begin
834 {$ifdef logging2}
835 LogLn('Alligning by drawing '+strf(4-(offs and 3))+' pixels');
836 {$endif logging}
837 for l := 1 to 4-(offs and 3) do
838 Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask);
839 End;
840 Dec(HLength, l);
841 inc(offs, l);
842 {$ifdef logging2}
843 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
844 {$endif logging}
845 { offs is now 4-bytes alligned }
846 If HLength <= ($10000-(Offs and $ffff)) Then
847 bankrest := HLength
848 else {the rest won't fit anymore in the current window }
849 bankrest := $10000 - (Offs and $ffff);
850 { it is possible that by aligningm we ended up in a new }
851 { bank, so set the correct bank again to make sure }
852 setwritebank(offs shr 16);
853 {$ifdef logging2}
854 LogLn('Rest to be drawn in this window: '+strf(bankrest)+' -- '+hexstr(bankrest,8));
855 {$endif logging}
856 For l := 0 to (Bankrest div 4)-1 Do
857 MemL[WinWriteSeg:word(offs)+l*4] := Mask;
858 inc(offs,l*4+4);
859 dec(hlength,l*4+4);
860 {$ifdef logging2}
861 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
862 {$endif logging}
863 End
864 Else
865 Begin
866 {$ifdef logging2}
867 LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
868 {$endif logging}
869 For l := 0 to HLength - 1 do
870 begin
871 { this may cross a bank at any time, so adjust }
872 { because this loop alwys runs for very little pixels, }
873 { there's little gained by splitting it up }
874 setwritebank(offs shr 16);
875 Mem[WinWriteSeg:word(offs)] := byte(mask);
876 inc(offs);
877 end;
878 HLength := 0
879 End
880 Until HLength = 0;
881 End;
882 End;
883 end;
884 end;
886 procedure VLineVESA256(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
888 var Offs: Longint;
889 l, bankrest: longint;
890 curbank, vlength: integer;
891 col: byte;
892 Begin
893 { must we swap the values? }
894 if y > y2 then
895 Begin
896 y := y xor y2;
897 y2 := y xor y2;
898 y:= y xor y2;
899 end;
900 { First convert to global coordinates }
901 X := X + StartXViewPort;
902 Y := Y + StartYViewPort;
903 Y2 := Y2 + StartYViewPort;
904 if ClipPixels then
905 Begin
906 if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
907 StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
908 exit;
909 end;
910 Col := Byte(CurrentColor);
911 {$ifdef logging2}
912 LogLn('vline '+strf(y)+' - '+strf(y2)+' on '+strf(x)+' in mode '+strf(currentwritemode));
913 {$endif logging}
914 VLength := y2 - y + 1;
915 {$ifdef logging2}
916 LogLn('length: '+strf(vlength));
917 {$endif logging}
918 if VLength>0 then
919 begin
920 Offs:=(Longint(y)+YOffset)*bytesperline+x;
921 {$ifdef logging2}
922 LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
923 {$endif logging}
924 Case CurrentWriteMode of
925 AndPut:
926 Begin
927 Repeat
928 curbank := integer(offs shr 16);
929 SetWriteBank(curbank);
930 SetReadBank(curbank);
931 {$ifdef logging2}
932 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
933 {$endif logging}
934 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
935 bankrest := VLength
936 else {the rest won't fit anymore in the current window }
937 bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
938 {$ifdef logging2}
939 LogLn('Rest to be drawn in this window: '+strf(bankrest));
940 {$endif logging}
941 For l := 0 to Bankrest-1 Do
942 begin
943 Mem[WinWriteSeg:word(offs)] :=
944 Mem[WinReadSeg:word(offs)] And Col;
945 inc(offs,bytesperline);
946 end;
947 dec(VLength,l+1);
948 {$ifdef logging2}
949 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
950 {$endif logging}
951 Until VLength = 0;
952 End;
953 XorPut:
954 Begin
955 Repeat
956 curbank := integer(offs shr 16);
957 SetWriteBank(curbank);
958 SetReadBank(curbank);
959 {$ifdef logging2}
960 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
961 {$endif logging}
962 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
963 bankrest := VLength
964 else {the rest won't fit anymore in the current window }
965 bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
966 {$ifdef logging2}
967 LogLn('Rest to be drawn in this window: '+strf(bankrest));
968 {$endif logging}
969 For l := 0 to Bankrest-1 Do
970 begin
971 Mem[WinWriteSeg:word(offs)] :=
972 Mem[WinReadSeg:word(offs)] Xor Col;
973 inc(offs,bytesperline);
974 end;
975 dec(VLength,l+1);
976 {$ifdef logging2}
977 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
978 {$endif logging}
979 Until VLength = 0;
980 End;
981 OrPut:
982 Begin
983 Repeat
984 curbank := integer(offs shr 16);
985 SetWriteBank(curbank);
986 SetReadBank(curbank);
987 {$ifdef logging2}
988 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
989 {$endif logging}
990 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
991 bankrest := VLength
992 else {the rest won't fit anymore in the current window }
993 bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
994 {$ifdef logging2}
995 LogLn('Rest to be drawn in this window: '+strf(bankrest));
996 {$endif logging}
997 For l := 0 to Bankrest-1 Do
998 begin
999 Mem[WinWriteSeg:word(offs)] :=
1000 Mem[WinReadSeg:word(offs)] Or Col;
1001 inc(offs,bytesperline);
1002 end;
1003 dec(VLength,l+1);
1004 {$ifdef logging2}
1005 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
1006 {$endif logging}
1007 Until VLength = 0;
1008 End;
1009 Else
1010 Begin
1011 If CurrentWriteMode = NotPut Then
1012 Col := Not(Col);
1013 Repeat
1014 curbank := integer(offs shr 16);
1015 SetWriteBank(curbank);
1016 {$ifdef logging2}
1017 LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
1018 {$endif logging}
1019 If (VLength-1)*bytesperline <= ($10000-(Offs and $ffff)) Then
1020 bankrest := VLength
1021 else {the rest won't fit anymore in the current window }
1022 bankrest := (($10000 - (Offs and $ffff)) div bytesperline)+1;
1023 {$ifdef logging2}
1024 LogLn('Rest to be drawn in this window: '+strf(bankrest));
1025 {$endif logging}
1026 For l := 0 to Bankrest-1 Do
1027 begin
1028 Mem[WinWriteSeg:word(offs)] := Col;
1029 inc(offs,bytesperline);
1030 end;
1031 dec(VLength,l+1);
1032 {$ifdef logging2}
1033 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
1034 {$endif logging}
1035 Until VLength = 0;
1036 End;
1037 End;
1038 end;
1039 end;
1041 procedure PatternLineVESA256(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
1042 {********************************************************}
1043 { Draws a horizontal patterned line according to the }
1044 { current Fill Settings. }
1045 {********************************************************}
1046 { Important notes: }
1047 { - CurrentColor must be set correctly before entering }
1048 { this routine. }
1049 {********************************************************}
1050 type
1051 TVESA256Fill = Record
1052 case byte of
1053 0: (data1, data2: longint);
1054 1: (pat: array[0..7] of byte);
1055 end;
1057 var
1058 fill: TVESA256Fill;
1059 bankrest, l : longint;
1060 offs, amount: longint;
1061 i : smallint;
1062 j : smallint;
1063 OldWriteMode : word;
1064 TmpFillPattern, patternPos : byte;
1065 begin
1066 { convert to global coordinates ... }
1067 x1 := x1 + StartXViewPort;
1068 x2 := x2 + StartXViewPort;
1069 y := y + StartYViewPort;
1070 { if line was fully clipped then exit...}
1071 if LineClipped(x1,y,x2,y,StartXViewPort,StartYViewPort,
1072 StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
1073 exit;
1074 OldWriteMode := CurrentWriteMode;
1075 CurrentWriteMode := NormalPut;
1076 { Get the current pattern }
1077 TmpFillPattern := FillPatternTable
1078 [FillSettings.Pattern][((y + startYViewPort) and $7)+1];
1079 {$ifdef logging2}
1080 LogLn('patternline '+strf(x1)+' - '+strf(x2)+' on '+strf(y));
1081 {$endif logging2}
1082 { how long is the line }
1083 amount := x2 - x1 + 1;
1084 { offset to start at }
1085 offs := (longint(y)+yoffset)*bytesperline+x1;
1086 { convert the pattern data into the actual color sequence }
1087 j := 1;
1088 FillChar(fill,sizeOf(fill),byte(currentBkColor));
1089 for i := 0 to 7 do
1090 begin
1091 if TmpFillPattern and j <> 0 then
1092 fill.pat[7-i] := currentColor;
1093 {$ifopt q+}
1094 {$q-}
1095 {$define overflowOn}
1096 {$endif}
1097 j := j shl 1;
1098 {$ifdef overflowOn}
1099 {$q+}
1100 {$undef overflowOn}
1101 {$endif}
1102 end;
1103 Repeat
1104 SetWriteBank(integer(offs shr 16));
1105 If (amount > 7) and
1106 (((offs and 7) = 0) or
1107 (amount > 7+8-(offs and 7))) Then
1108 Begin
1109 { align target }
1110 l := 0;
1111 If (offs and 7) <> 0 then
1112 { this cannot go past a window boundary bacause the }
1113 { size of a window is always a multiple of 8 }
1114 Begin
1115 { position in the pattern where to start }
1116 patternPos := offs and 7;
1117 {$ifdef logging2}
1118 LogLn('Aligning by drawing '+strf(8-(offs and 7))+' pixels');
1119 {$endif logging2}
1120 for l := 1 to 8-(offs and 7) do
1121 begin
1122 Mem[WinWriteSeg:word(offs)+l-1] := fill.pat[patternPos and 7];
1123 inc(patternPos)
1124 end;
1125 End;
1126 Dec(amount, l);
1127 inc(offs, l);
1128 {$ifdef logging2}
1129 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
1130 {$endif logging2}
1131 { offs is now 8-bytes alligned }
1132 If amount <= ($10000-(Offs and $ffff)) Then
1133 bankrest := amount
1134 else {the rest won't fit anymore in the current window }
1135 bankrest := $10000 - (Offs and $ffff);
1136 { it is possible that by aligningm we ended up in a new }
1137 { bank, so set the correct bank again to make sure }
1138 setwritebank(offs shr 16);
1139 {$ifdef logging2}
1140 LogLn('Rest to be drawn in this window: '+strf(bankrest));
1141 {$endif logging2}
1142 for l := 0 to (bankrest div 8)-1 Do
1143 begin
1144 MemL[WinWriteSeg:word(offs)+l*8] := fill.data1;
1145 MemL[WinWriteSeg:word(offs)+l*8+4] := fill.data2;
1146 end;
1147 inc(offs,l*8+8);
1148 dec(amount,l*8+8);
1149 {$ifdef logging2}
1150 LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
1151 {$endif logging2}
1152 End
1153 Else
1154 Begin
1155 {$ifdef logging2}
1156 LogLn('Drawing leftover: '+strf(amount)+' at offset '+hexstr(offs,8));
1157 {$endif logging2}
1158 patternPos := offs and 7;
1159 For l := 0 to amount - 1 do
1160 begin
1161 { this may cross a bank at any time, so adjust }
1162 { because this loop alwys runs for very little pixels, }
1163 { there's little gained by splitting it up }
1164 setwritebank(offs shr 16);
1165 Mem[WinWriteSeg:word(offs)] := fill.pat[patternPos and 7];
1166 inc(offs);
1167 inc(patternPos);
1168 end;
1169 amount := 0;
1170 End
1171 Until amount = 0;
1172 currentWriteMode := oldWriteMode;
1173 end;
1176 {************************************************************************}
1177 {* 256 colors VESA mode routines Linear mode *}
1178 {************************************************************************}
1179 {$ifdef FPC}
1180 type
1181 pbyte = ^byte;
1182 pword = ^word;
1184 procedure DirectPutPixVESA256Linear(x, y : integer); {$ifndef fpc}far;{$endif fpc}
1185 var
1186 offs : longint;
1187 col : byte;
1188 begin
1189 offs := longint(y) * BytesPerLine + x;
1190 Case CurrentWriteMode of
1191 XorPut:
1192 Begin
1193 if UseNoSelector then
1194 col:=pbyte(LFBPointer+offs+LinearPageOfs)^
1195 else
1196 seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
1197 col := col xor byte(CurrentColor);
1198 End;
1199 AndPut:
1200 Begin
1201 if UseNoSelector then
1202 col:=pbyte(LFBPointer+offs+LinearPageOfs)^
1203 else
1204 seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
1205 col := col and byte(CurrentColor);
1206 End;
1207 OrPut:
1208 Begin
1209 if UseNoSelector then
1210 col:=pbyte(LFBPointer+offs+LinearPageOfs)^
1211 else
1212 seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
1213 col := col or byte(CurrentColor);
1214 End
1215 else
1216 Begin
1217 If CurrentWriteMode <> NotPut then
1218 col := Byte(CurrentColor)
1219 else col := Not(Byte(CurrentColor));
1220 End
1221 End;
1222 if UseNoSelector then
1223 pbyte(LFBPointer+offs+LinearPageOfs)^:=col
1224 else
1225 seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,1);
1226 end;
1228 procedure PutPixVESA256Linear(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
1229 var
1230 offs : longint;
1231 begin
1232 X:= X + StartXViewPort;
1233 Y:= Y + StartYViewPort;
1234 { convert to absolute coordinates and then verify clipping...}
1235 if ClipPixels then
1236 Begin
1237 if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
1238 exit;
1239 if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
1240 exit;
1241 end;
1242 offs := longint(y) * BytesPerLine + x;
1243 {$ifdef logging}
1244 logln('putpix offset: '+hexstr(offs,8)+', color: '+strf(color)+', lpo: $'+
1245 hexstr(LinearPageOfs,8));
1246 {$endif logging}
1247 if UseNoSelector then
1248 pbyte(LFBPointer+offs+LinearPageOfs)^:=byte(color)
1249 else
1250 seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,1);
1251 end;
1253 function GetPixVESA256Linear(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
1254 var
1255 offs : longint;
1256 col : byte;
1257 begin
1258 X:= X + StartXViewPort;
1259 Y:= Y + StartYViewPort;
1260 offs := longint(y) * BytesPerLine + x;
1261 {$ifdef logging}
1262 logln('getpix offset: '+hexstr(offs,8)+', lpo: $'+
1263 hexstr(LinearPageOfs,8));
1264 {$endif logging}
1265 if UseNoSelector then
1266 col:=pbyte(LFBPointer+offs+LinearPageOfs)^
1267 else
1268 seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
1269 GetPixVESA256Linear:=col;
1270 end;
1271 (*
1272 function SetVESADisplayStart(PageNum : word;x,y : integer):Boolean;
1273 var
1274 dregs : registers;
1275 begin
1276 if PageNum>VesaModeInfo.NumberOfPages then
1277 PageNum:=0;
1278 {$ifdef DEBUG}
1279 if PageNum>0 then
1280 writeln(stderr,'Setting Display Page ',PageNum);
1281 {$endif DEBUG}
1282 dregs.RealEBX:=0{ $80 for Wait for retrace };
1283 dregs.RealECX:=x;
1284 dregs.RealEDX:=y+PageNum*maxy;
1285 dregs.RealSP:=0;
1286 dregs.RealSS:=0;
1287 dregs.RealEAX:=$4F07; RealIntr($10,dregs);
1288 { idem as above !!! }
1289 if (dregs.RealEAX and $1FF) <> $4F then
1290 begin
1291 {$ifdef DEBUG}
1292 writeln(stderr,'Set Display start error');
1293 {$endif DEBUG}
1294 SetVESADisplayStart:=false;
1295 end
1296 else
1297 SetVESADisplayStart:=true;
1298 end;
1299 *)
1300 {$endif FPC}
1303 {************************************************************************}
1304 {* 15/16bit pixels VESA mode routines *}
1305 {************************************************************************}
1307 procedure PutPixVESA32kOr64k(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
1308 var
1309 offs : longint;
1310 begin
1311 {$ifdef logging}
1312 logln('putpixvesa32kor64k('+strf(x)+','+strf(y)+')');
1313 {$endif logging}
1314 X:= X + StartXViewPort;
1315 Y:= Y + StartYViewPort;
1316 { convert to absolute coordinates and then verify clipping...}
1317 if ClipPixels then
1318 Begin
1319 if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
1320 exit;
1321 if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
1322 exit;
1323 end;
1324 Y := Y + YOffset; { adjust pixel for correct virtual page }
1325 offs := longint(y) * BytesPerLine + 2*x;
1326 SetWriteBank(integer(offs shr 16));
1327 {$ifdef logging}
1328 logln('putpixvesa32kor64k offset: '+strf(word(offs)));
1329 {$endif logging}
1330 memW[WinWriteSeg : word(offs)] := color;
1331 end;
1333 function GetPixVESA32kOr64k(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
1334 var
1335 offs : longint;
1336 begin
1337 X:= X + StartXViewPort;
1338 Y:= Y + StartYViewPort + YOffset;
1339 offs := longint(y) * BytesPerLine + 2*x;
1340 SetReadBank(integer(offs shr 16));
1341 GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)];
1342 end;
1344 procedure DirectPutPixVESA32kOr64k(x, y : integer); {$ifndef fpc}far;{$endif fpc}
1345 var
1346 offs : longint;
1347 col : word;
1348 begin
1349 {$ifdef logging}
1350 logln('directputpixvesa32kor64k('+strf(x)+','+strf(y)+')');
1351 {$endif logging}
1352 y:= Y + YOffset;
1353 offs := longint(y) * BytesPerLine + 2*x;
1354 SetWriteBank(integer((offs shr 16) and $ff));
1355 Case CurrentWriteMode of
1356 XorPut:
1357 Begin
1358 SetReadBank(integer(offs shr 16));
1359 memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] xor currentcolor;
1360 End;
1361 AndPut:
1362 Begin
1363 SetReadBank(integer(offs shr 16));
1364 memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] And currentcolor;
1365 End;
1366 OrPut:
1367 Begin
1368 SetReadBank(integer(offs shr 16));
1369 memW[WinWriteSeg : word(offs)] := memW[WinReadSeg : word(offs)] or currentcolor;
1370 End
1371 else
1372 Begin
1373 If CurrentWriteMode <> NotPut Then
1374 col := CurrentColor
1375 Else col := Not(CurrentColor);
1376 {$ifdef logging}
1377 logln('directputpixvesa32kor64k offset: '+strf(word(offs)));
1378 {$endif logging}
1379 memW[WinWriteSeg : word(offs)] := Col;
1380 End
1381 End;
1382 end;
1384 {$ifdef FPC}
1385 {************************************************************************}
1386 {* 15/16bit pixels VESA mode routines Linear mode *}
1387 {************************************************************************}
1389 procedure PutPixVESA32kor64kLinear(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
1390 var
1391 offs : longint;
1392 begin
1393 X:= X + StartXViewPort;
1394 Y:= Y + StartYViewPort;
1395 { convert to absolute coordinates and then verify clipping...}
1396 if ClipPixels then
1397 Begin
1398 if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
1399 exit;
1400 if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
1401 exit;
1402 end;
1403 offs := longint(y) * BytesPerLine + 2*x;
1404 if UseNoSelector then
1405 pword(LFBPointer+offs+LinearPageOfs)^:=color
1406 else
1407 seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,2);
1408 end;
1410 function GetPixVESA32kor64kLinear(x, y : integer): word; {$ifndef fpc}far;{$endif fpc}
1411 var
1412 offs : longint;
1413 color : word;
1414 begin
1415 X:= X + StartXViewPort;
1416 Y:= Y + StartYViewPort;
1417 offs := longint(y) * BytesPerLine + 2*x;
1418 if UseNoSelector then
1419 color:=pword(LFBPointer+offs+LinearPageOfs)^
1420 else
1421 seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@color),2);
1422 GetPixVESA32kor64kLinear:=color;
1423 end;
1425 procedure DirectPutPixVESA32kor64kLinear(x, y : integer); {$ifndef fpc}far;{$endif fpc}
1426 var
1427 offs : longint;
1428 col : word;
1429 begin
1430 offs := longint(y) * BytesPerLine + 2*x;
1431 Case CurrentWriteMode of
1432 XorPut:
1433 Begin
1434 if UseNoSelector then
1435 col:=pword(LFBPointer+offs+LinearPageOfs)^
1436 else
1437 seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
1438 col := col xor currentcolor;
1439 End;
1440 AndPut:
1441 Begin
1442 if UseNoSelector then
1443 col:=pword(LFBPointer+offs+LinearPageOfs)^
1444 else
1445 seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
1446 col := col and currentcolor;
1447 End;
1448 OrPut:
1449 Begin
1450 if UseNoSelector then
1451 col:=pword(LFBPointer+offs+LinearPageOfs)^
1452 else
1453 seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
1454 col := col or currentcolor;
1455 End
1456 else
1457 Begin
1458 If CurrentWriteMode <> NotPut Then
1459 col := CurrentColor
1460 Else col := Not(CurrentColor);
1461 End
1462 End;
1463 if UseNoSelector then
1464 pword(LFBPointer+offs+LinearPageOfs)^:=col
1465 else
1466 seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,2);
1467 end;
1469 {$endif FPC}
1471 {************************************************************************}
1472 {* 4-bit pixels VESA mode routines *}
1473 {************************************************************************}
1475 procedure PutPixVESA16(x, y : integer; color : word); {$ifndef fpc}far;{$endif fpc}
1476 var
1477 offs : longint;
1478 dummy : byte;
1479 begin
1480 X:= X + StartXViewPort;
1481 Y:= Y + StartYViewPort;
1482 { convert to absolute coordinates and then verify clipping...}
1483 if ClipPixels then
1484 Begin
1485 if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
1486 exit;
1487 if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
1488 exit;
1489 end;
1490 Y := Y + YOffset; { adjust pixel for correct virtual page }
1491 { }
1492 offs := longint(y) * BytesPerLine + (x div 8);
1493 SetWriteBank(integer(offs shr 16));
1495 PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
1496 PortW[$3ce] := color shl 8; { Index 00 : Enable correct plane and write color }
1498 Port[$3ce] := 8; { Index 08 : Bitmask register. }
1499 Port[$3cf] := $80 shr (x and $7); { Select correct bits to modify }
1501 dummy := Mem[WinWriteSeg: offs]; { Latch the data into host space. }
1502 Mem[WinWriteSeg: offs] := dummy; { Write the data into video memory }
1503 PortW[$3ce] := $ff08; { Enable all bit planes. }
1504 PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. }
1505 { }
1506 end;
1509 Function GetPixVESA16(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
1510 Var dummy, offset: Word;
1511 shift: byte;
1512 Begin
1513 X:= X + StartXViewPort;
1514 Y:= Y + StartYViewPort + YOffset;
1515 offset := longint(Y) * BytesPerLine + (x div 8);
1516 SetReadBank(integer(offset shr 16));
1517 Port[$3ce] := 4;
1518 shift := 7 - (X and 7);
1519 Port[$3cf] := 0;
1520 dummy := (Mem[WinReadSeg:offset] shr shift) and 1;
1521 Port[$3cf] := 1;
1522 dummy := dummy or (((Mem[WinReadSeg:offset] shr shift) and 1) shl 1);
1523 Port[$3cf] := 2;
1524 dummy := dummy or (((Mem[WinReadSeg:offset] shr shift) and 1) shl 2);
1525 Port[$3cf] := 3;
1526 dummy := dummy or (((Mem[WinReadSeg:offset] shr shift) and 1) shl 3);
1527 GetPixVESA16 := dummy;
1528 end;
1531 procedure DirectPutPixVESA16(x, y : integer); {$ifndef fpc}far;{$endif fpc}
1532 var
1533 offs : longint;
1534 dummy : byte;
1535 Color : word;
1536 begin
1537 y:= Y + YOffset;
1538 case CurrentWriteMode of
1539 XORPut:
1540 begin
1541 { getpixel wants local/relative coordinates }
1542 Color := GetPixVESA16(x-StartXViewPort,y-StartYViewPort);
1543 Color := CurrentColor Xor Color;
1544 end;
1545 OrPut:
1546 begin
1547 { getpixel wants local/relative coordinates }
1548 Color := GetPixVESA16(x-StartXViewPort,y-StartYViewPort);
1549 Color := CurrentColor Or Color;
1550 end;
1551 AndPut:
1552 begin
1553 { getpixel wants local/relative coordinates }
1554 Color := GetPixVESA16(x-StartXViewPort,y-StartYViewPort);
1555 Color := CurrentColor And Color;
1556 end;
1557 NotPut:
1558 begin
1559 Color := Not Color;
1560 end
1561 else
1562 Color := CurrentColor;
1563 end;
1564 offs := longint(y) * BytesPerLine + (x div 8);
1565 SetWriteBank(integer(offs shr 16));
1566 PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
1567 PortW[$3ce] := color shl 8; { Index 00 : Enable correct plane and write color }
1569 Port[$3ce] := 8; { Index 08 : Bitmask register. }
1570 Port[$3cf] := $80 shr (x and $7); { Select correct bits to modify }
1572 dummy := Mem[WinWriteSeg: offs]; { Latch the data into host space. }
1573 Mem[WinWriteSeg: offs] := dummy; { Write the data into video memory }
1574 PortW[$3ce] := $ff08; { Enable all bit planes. }
1575 PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. }
1576 end;
1581 {************************************************************************}
1582 {* VESA Palette entries *}
1583 {************************************************************************}
1586 {$IFDEF DPMI}
1587 Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
1588 BlueValue : Integer);
1589 var
1590 pal: palrec;
1591 regs: TDPMIRegisters;
1592 Ptr: longint;
1593 {$ifndef fpc}
1594 PalPtr : ^PalRec;
1595 {$endif fpc}
1596 RealSeg: word;
1597 FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
1598 begin
1599 if DirectColor then
1600 Begin
1601 {$ifdef logging}
1602 logln('setvesargbpalette called with directcolor = true');
1603 {$endif logging}
1604 _GraphResult := grError;
1605 exit;
1606 end;
1607 pal.align := 0;
1608 pal.red := byte(RedValue);
1609 pal.green := byte(GreenValue);
1610 pal.blue := byte(BlueValue);
1611 { use the set/get palette function }
1612 if VESAInfo.Version >= $0200 then
1613 Begin
1614 { check if blanking bit must be set when programming }
1615 { the RAMDAC. }
1616 if (VESAInfo.caps and attrSnowCheck) <> 0 then
1617 FunctionNr := $80
1618 else
1619 FunctionNr := $00;
1621 { Alllocate real mode buffer }
1622 {$ifndef fpc}
1623 Ptr:=GlobalDosAlloc(sizeof(palrec));
1624 { get the selector values }
1625 PalPtr := pointer(Ptr shl 16);
1626 if not assigned(PalPtr) then
1627 RunError(203);
1628 {$else fpc}
1629 Ptr:=Global_Dos_Alloc(sizeof(palrec));
1630 {$endif fpc}
1631 {get the segment value}
1632 RealSeg := word(Ptr shr 16);
1633 { setup interrupt registers }
1634 FillChar(regs, sizeof(regs), #0);
1635 { copy palette values to real mode buffer }
1636 {$ifndef fpc}
1637 move(pal, palptr^, sizeof(pal));
1638 {$else fpc}
1639 DosMemPut(RealSeg,0,pal,sizeof(pal));
1640 {$endif fpc}
1641 regs.eax := $4F09;
1642 regs.ebx := FunctionNr;
1643 regs.ecx := $01;
1644 regs.edx := ColorNum;
1645 regs.es := RealSeg;
1646 regs.edi := 0; { offset is always zero }
1647 RealIntr($10, regs);
1649 { free real mode memory }
1650 {$ifndef fpc}
1651 GlobalDosFree(word(Ptr and $ffff));
1652 {$else fpc}
1653 If not Global_Dos_Free(word(Ptr and $ffff)) then
1654 RunError(216);
1655 {$endif fpc}
1657 if word(regs.eax) <> $004F then
1658 begin
1659 {$ifdef logging}
1660 logln('setvesargbpalette failed while directcolor = false!');
1661 {$endif logging}
1662 _GraphResult := grError;
1663 exit;
1664 end;
1665 end
1666 else
1667 { assume it's fully VGA compatible palette-wise. }
1668 Begin
1669 SetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
1670 end;
1671 end;
1674 Procedure GetVESARGBPalette(ColorNum: integer; Var
1675 RedValue, GreenValue, BlueValue : integer);
1676 var
1677 pal: PalRec;
1678 {$ifndef fpc}
1679 palptr : ^PalRec;
1680 {$endif fpc}
1681 regs : TDPMIRegisters;
1682 RealSeg: word;
1683 ptr: longint;
1684 begin
1685 if DirectColor then
1686 Begin
1687 {$ifdef logging}
1688 logln('getvesargbpalette called with directcolor = true');
1689 {$endif logging}
1690 _GraphResult := grError;
1691 exit;
1692 end;
1693 { use the set/get palette function }
1694 if VESAInfo.Version >= $0200 then
1695 Begin
1696 { Alllocate real mode buffer }
1697 {$ifndef fpc}
1698 Ptr:=GlobalDosAlloc(sizeof(palrec));
1699 { get the selector value }
1700 PalPtr := pointer(longint(Ptr and $0000ffff) shl 16);
1701 if not assigned(PalPtr) then
1702 RunError(203);
1703 {$else fpc}
1704 Ptr:=Global_Dos_Alloc(sizeof(palrec));
1705 {$endif fpc}
1706 { get the segment value }
1707 RealSeg := word(Ptr shr 16);
1708 { setup interrupt registers }
1709 FillChar(regs, sizeof(regs), #0);
1711 regs.eax := $4F09;
1712 regs.ebx := $01; { get palette data }
1713 regs.ecx := $01;
1714 regs.edx := ColorNum;
1715 regs.es := RealSeg;
1716 regs.edi := 0; { offset is always zero }
1717 RealIntr($10, regs);
1719 { copy to protected mode buffer ... }
1720 {$ifndef fpc}
1721 Move(PalPtr^, Pal, sizeof(pal));
1722 {$else fpc}
1723 DosMemGet(RealSeg,0,Pal,sizeof(pal));
1724 {$endif fpc}
1725 { free real mode memory }
1726 {$ifndef fpc}
1727 GlobalDosFree(word(Ptr and $ffff));
1728 {$else fpc}
1729 If not Global_Dos_Free(word(Ptr and $ffff)) then
1730 RunError(216);
1731 {$endif fpc}
1733 if word(regs.eax) <> $004F then
1734 begin
1735 {$ifdef logging}
1736 logln('getvesargbpalette failed while directcolor = false!');
1737 {$endif logging}
1738 _GraphResult := grError;
1739 exit;
1740 end
1741 else
1742 begin
1743 RedValue := Integer(pal.Red);
1744 GreenValue := Integer(pal.Green);
1745 BlueValue := Integer(pal.Blue);
1746 end;
1747 end
1748 else
1749 GetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
1750 end;
1751 {$ELSE}
1753 Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
1754 BlueValue : Integer); far;
1755 var
1756 FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
1757 pal: ^palrec;
1758 Error : boolean; { VBE call error }
1759 begin
1760 if DirectColor then
1761 Begin
1762 _GraphResult := grError;
1763 exit;
1764 end;
1765 Error := FALSE;
1766 new(pal);
1767 if not assigned(pal) then RunError(203);
1768 pal^.align := 0;
1769 pal^.red := byte(RedValue);
1770 pal^.green := byte(GreenValue);
1771 pal^.blue := byte(BlueValue);
1772 { use the set/get palette function }
1773 if VESAInfo.Version >= $0200 then
1774 Begin
1775 { check if blanking bit must be set when programming }
1776 { the RAMDAC. }
1777 if (VESAInfo.caps and attrSnowCheck) <> 0 then
1778 FunctionNr := $80
1779 else
1780 FunctionNr := $00;
1781 asm
1782 mov ax, 4F09h { Set/Get Palette data }
1783 mov bl, [FunctionNr] { Set palette data }
1784 mov cx, 01h { update one palette reg. }
1785 mov dx, [ColorNum] { register number to update }
1786 les di, [pal] { get palette address }
1787 int 10h
1788 cmp ax, 004Fh { check if success }
1789 jz @noerror
1790 mov [Error], TRUE
1791 @noerror:
1792 end;
1793 if not Error then
1794 Dispose(pal)
1795 else
1796 begin
1797 _GraphResult := grError;
1798 exit;
1799 end;
1800 end
1801 else
1802 { assume it's fully VGA compatible palette-wise. }
1803 Begin
1804 SetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
1805 end;
1806 end;
1811 Procedure GetVESARGBPalette(ColorNum: integer; Var RedValue, GreenValue,
1812 BlueValue : integer); far;
1813 var
1814 Error: boolean;
1815 pal: ^palrec;
1816 begin
1817 if DirectColor then
1818 Begin
1819 _GraphResult := grError;
1820 exit;
1821 end;
1822 Error := FALSE;
1823 new(pal);
1824 if not assigned(pal) then RunError(203);
1825 FillChar(pal^, sizeof(palrec), #0);
1826 { use the set/get palette function }
1827 if VESAInfo.Version >= $0200 then
1828 Begin
1829 asm
1830 mov ax, 4F09h { Set/Get Palette data }
1831 mov bl, 01h { Set palette data }
1832 mov cx, 01h { update one palette reg. }
1833 mov dx, [ColorNum] { register number to update }
1834 les di, [pal] { get palette address }
1835 int 10h
1836 cmp ax, 004Fh { check if success }
1837 jz @noerror
1838 mov [Error], TRUE
1839 @noerror:
1840 end;
1841 if not Error then
1842 begin
1843 RedValue := Integer(pal^.Red);
1844 GreenValue := Integer(pal^.Green);
1845 BlueValue := Integer(pal^.Blue);
1846 Dispose(pal);
1847 end
1848 else
1849 begin
1850 _GraphResult := grError;
1851 exit;
1852 end;
1853 end
1854 else
1855 GetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
1857 end;
1858 {$ENDIF}
1859 type
1860 heaperrorproc=function(size:longint):integer;
1862 Const
1863 HeapErrorIsHooked : boolean = false;
1864 OldHeapError : HeapErrorProc = nil;
1865 DsLimit : dword = 0;
1867 function NewHeapError(size : longint) : integer;
1868 begin
1869 set_segment_limit(get_ds,DsLimit);
1870 NewHeapError:=OldHeapError(size);
1871 DsLimit:=get_segment_limit(get_ds);
1872 { The base of ds can be changed
1873 we need to compute the address again PM }
1874 LFBPointer:=pointer(FrameBufferLinearAddress-get_segment_base_address(get_ds));
1875 if dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1 > DsLimit then
1876 set_segment_limit(get_ds,dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1);
1877 end;
1879 procedure HookHeapError;
1880 begin
1881 if HeapErrorIsHooked then
1882 exit;
1883 DsLimit:=get_segment_limit(get_ds);
1884 OldHeapError:=HeapErrorProc(HeapError);
1885 HeapError:=@NewHeapError;
1886 HeapErrorIsHooked:=true;
1887 end;
1889 procedure UnHookHeapError;
1890 begin
1891 if not HeapErrorIsHooked then
1892 exit;
1893 LFBPointer:=nil;
1894 set_segment_limit(get_ds,DsLimit);
1895 HeapError:=OldHeapError;
1896 HeapErrorIsHooked:=false;
1897 end;
1899 function SetupLinear(var ModeInfo: TVESAModeInfo;mode : word) : boolean;
1900 begin
1901 SetUpLinear:=false;
1902 {$ifdef FPC}
1903 case mode of
1904 m320x200x32k,
1905 m320x200x64k,
1906 m640x480x32k,
1907 m640x480x64k,
1908 m800x600x32k,
1909 m800x600x64k,
1910 m1024x768x32k,
1911 m1024x768x64k,
1912 m1280x1024x32k,
1913 m1280x1024x64k :
1914 begin
1915 DirectPutPixel:=@DirectPutPixVESA32kor64kLinear;
1916 PutPixel:=@PutPixVESA32kor64kLinear;
1917 GetPixel:=@GetPixVESA32kor64kLinear;
1918 { linear mode for lines not yet implemented PM }
1919 HLine:=@HLineDefault;
1920 VLine:=@VLineDefault;
1921 GetScanLine := @GetScanLineDefault;
1922 PatternLine := @PatternLineDefault;
1923 end;
1924 m640x400x256,
1925 m640x480x256,
1926 m800x600x256,
1927 m1024x768x256,
1928 m1280x1024x256:
1929 begin
1930 DirectPutPixel:=@DirectPutPixVESA256Linear;
1931 PutPixel:=@PutPixVESA256Linear;
1932 GetPixel:=@GetPixVESA256Linear;
1933 { linear mode for lines not yet implemented PM }
1934 HLine:=@HLineDefault;
1935 VLine:=@VLineDefault;
1936 GetScanLine := @GetScanLineDefault;
1937 PatternLine := @PatternLineDefault;
1938 end;
1939 else
1940 exit;
1941 end;
1942 FrameBufferLinearAddress:=Get_linear_addr(VESAModeInfo.PhysAddress and $FFFF0000,
1943 VESAInfo.TotalMem shl 16);
1944 {$ifdef logging}
1945 logln('framebuffer linear address: '+hexstr(FrameBufferLinearAddress div (1024*1024),8));
1946 logln('total mem shl 16: '+strf(vesainfo.totalmem shl 16));
1947 {$endif logging}
1948 if int31error<>0 then
1949 begin
1950 {$ifdef logging}
1951 logln('Unable to get linear address for '+hexstr(VESAModeInfo.PhysAddress,8));
1952 {$endif logging}
1953 writeln(stderr,'Unable to get linear address for ',hexstr(VESAModeInfo.PhysAddress,8));
1954 exit;
1955 end;
1956 if UseNoSelector then
1957 begin
1958 HookHeapError;
1959 LFBPointer:=pointer(FrameBufferLinearAddress-get_segment_base_address(get_ds));
1960 if dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1 > dword(get_segment_limit(get_ds)) then
1961 set_segment_limit(get_ds,dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1);
1962 end
1963 else
1964 begin
1965 WinWriteSeg:=allocate_ldt_descriptors(1);
1966 {$ifdef logging}
1967 logln('writeseg1: '+hexstr(winwriteseg,8));
1968 {$endif logging}
1969 set_segment_base_address(WinWriteSeg,FrameBufferLinearAddress);
1970 set_segment_limit(WinWriteSeg,(VESAInfo.TotalMem shl 16)-1);
1971 lock_linear_region(FrameBufferLinearAddress,(VESAInfo.TotalMem shl 16));
1972 if int31error<>0 then
1973 begin
1974 {$ifdef logging}
1975 logln('Error in linear memory selectors creation');
1976 {$endif logging}
1977 writeln(stderr,'Error in linear memory selectors creation');
1978 exit;
1979 end;
1980 end;
1981 LinearPageOfs := 0;
1982 InLinear:=true;
1983 SetUpLinear:=true;
1984 { WinSize:=(VGAInfo.TotalMem shl 16);
1985 WinLoMask:=(VGAInfo.TotalMem shl 16)-1;
1986 WinShift:=15;
1987 Temp:=VGAInfo.TotalMem;
1988 while Temp>0 do
1989 begin
1990 inc(WinShift);
1991 Temp:=Temp shr 1;
1992 end; }
1993 {$endif FPC}
1994 end;
1996 procedure SetupWindows(var ModeInfo: TVESAModeInfo);
1997 begin
1998 InLinear:=false;
1999 { now we check the windowing scheme ...}
2000 if (ModeInfo.WinAAttr and WinSupported) <> 0 then
2001 { is this window supported ... }
2002 begin
2003 { now check if the window is R/W }
2004 if (ModeInfo.WinAAttr and WinReadable) <> 0 then
2005 begin
2006 ReadWindow := 0;
2007 WinReadSeg := ModeInfo.WinASeg;
2008 end;
2009 if (ModeInfo.WinAAttr and WinWritable) <> 0 then
2010 begin
2011 WriteWindow := 0;
2012 WinWriteSeg := ModeInfo.WinASeg;
2013 end;
2014 end;
2015 if (ModeInfo.WinBAttr and WinSupported) <> 0 then
2016 { is this window supported ... }
2017 begin
2019 { OPTIMIZATION ... }
2020 { if window A supports both read/write, then we try to optimize }
2021 { everything, by using a different window for Read and/or write.}
2022 if (WinReadSeg <> 0) and (WinWriteSeg <> 0) then
2023 begin
2024 { check if winB supports read }
2025 if (ModeInfo.WinBAttr and winReadable) <> 0 then
2026 begin
2027 WinReadSeg := ModeInfo.WinBSeg;
2028 ReadWindow := 1;
2029 end
2030 else
2031 { check if WinB supports write }
2032 if (ModeInfo.WinBAttr and WinWritable) <> 0 then
2033 begin
2034 WinWriteSeg := ModeInfo.WinBSeg;
2035 WriteWindow := 1;
2036 end;
2037 end
2038 else
2039 { Window A only supported Read OR Write, no we have to make }
2040 { sure that window B supports the other mode. }
2041 if (WinReadSeg = 0) and (WinWriteSeg<>0) then
2042 begin
2043 if (ModeInfo.WinBAttr and WinReadable <> 0) then
2044 begin
2045 ReadWindow := 1;
2046 WinReadSeg := ModeInfo.WinBSeg;
2047 end
2048 else
2049 { impossible, this VESA mode is WRITE only! }
2050 begin
2051 WriteLn('Invalid VESA Window attribute.');
2052 Halt(255);
2053 end;
2054 end
2055 else
2056 if (winWriteSeg = 0) and (WinReadSeg<>0) then
2057 begin
2058 if (ModeInfo.WinBAttr and WinWritable) <> 0 then
2059 begin
2060 WriteWindow := 1;
2061 WinWriteSeg := ModeInfo.WinBSeg;
2062 end
2063 else
2064 { impossible, this VESA mode is READ only! }
2065 begin
2066 WriteLn('Invalid VESA Window attribute.');
2067 Halt(255);
2068 end;
2069 end
2070 else
2071 if (winReadSeg = 0) and (winWriteSeg = 0) then
2072 { no read/write in this mode! }
2073 begin
2074 WriteLn('Invalid VESA Window attribute.');
2075 Halt(255);
2076 end;
2077 end;
2079 { if both windows are not supported, then we can assume }
2080 { that there is ONE single NON relocatable window. }
2081 if (WinWriteSeg = 0) and (WinReadSeg = 0) then
2082 begin
2083 WinWriteSeg := ModeInfo.WinASeg;
2084 WinReadSeg := ModeInfo.WinASeg;
2085 end;
2087 { 16-bit Protected mode checking code... }
2088 { change segment values to protected mode }
2089 { selectors. }
2090 if WinReadSeg = $A000 then
2091 WinReadSeg := SegA000
2092 else
2093 if WinReadSeg = $B000 then
2094 WinReadSeg := SegB000
2095 else
2096 if WinReadSeg = $B800 then
2097 WinReadSeg := SegB800
2098 else
2099 begin
2100 WriteLn('Invalid segment address.');
2101 Halt(255);
2102 end;
2103 if WinWriteSeg = $A000 then
2104 WinWriteSeg := SegA000
2105 else
2106 if WinWriteSeg = $B000 then
2107 WinWriteSeg := SegB000
2108 else
2109 if WinWriteSeg = $B800 then
2110 WinWriteSeg := SegB800
2111 else
2112 begin
2113 WriteLn('Invalid segment address.');
2114 Halt(255);
2115 end;
2117 end;
2121 function setVESAMode(mode:word):boolean;
2122 var i:word;
2123 res: boolean;
2124 begin
2125 { Init mode information, for compatibility with VBE < 1.1 }
2126 FillChar(VESAModeInfo, sizeof(TVESAModeInfo), #0);
2127 { get the video mode information }
2128 if getVESAModeInfo(VESAmodeinfo, mode) then
2129 begin
2130 { checks if the hardware supports the video mode. }
2131 if (VESAModeInfo.attr and modeAvail) = 0 then
2132 begin
2133 SetVESAmode := FALSE;
2134 {$ifdef logging}
2135 logln(' vesa mode '+strf(mode)+' not supported!!!');
2136 {$endif logging}
2137 _GraphResult := grError;
2138 exit;
2139 end;
2141 SetVESAMode := TRUE;
2142 BankShift := 0;
2143 while (64 shr BankShift) <> VESAModeInfo.WinGranularity do
2144 Inc(BankShift);
2145 CurrentWriteBank := -1;
2146 CurrentReadBank := -1;
2147 BytesPerLine := VESAModeInfo.BytesPerScanLine;
2149 { These are the window adresses ... }
2150 WinWriteSeg := 0; { This is the segment to use for writes }
2151 WinReadSeg := 0; { This is the segment to use for reads }
2152 ReadWindow := 0;
2153 WriteWindow := 0;
2155 { VBE 2.0 and higher supports >= non VGA linear buffer types...}
2156 { this is backward compatible. }
2157 if (((VESAModeInfo.Attr and ModeNoWindowed) <> 0) or UseLFB) and
2158 ((VESAModeInfo.Attr and ModeLinearBuffer) <> 0) then
2159 begin
2160 if not SetupLinear(VESAModeInfo,mode) then
2161 SetUpWindows(VESAModeInfo);
2162 end
2163 else
2164 { if linear and windowed is supported, then use windowed }
2165 { method. }
2166 SetUpWindows(VESAModeInfo);
2168 {$ifdef logging}
2169 LogLn('Entering vesa mode '+strf(mode));
2170 LogLn('Read segment: $'+hexstr(winreadseg,4));
2171 LogLn('Write segment: $'+hexstr(winwriteseg,4));
2172 LogLn('Window granularity: '+strf(VESAModeInfo.WinGranularity)+'kb');
2173 LogLn('Window size: '+strf(VESAModeInfo.winSize)+'kb');
2174 LogLn('Bytes per line: '+strf(bytesperline));
2175 {$endif logging}
2176 { Select the correct mode number if we're going to use linear access! }
2177 if InLinear then
2178 inc(mode,$4000);
2180 asm
2181 mov ax,4F02h
2182 mov bx,mode
2183 {$ifdef fpc}
2184 push ebp
2185 {$endif fpc}
2186 int 10h
2187 {$ifdef fpc}
2188 pop ebp
2189 {$endif fpc}
2190 sub ax,004Fh
2191 cmp ax,1
2192 sbb al,al
2193 mov res,al
2194 end;
2195 if not res then
2196 _GraphResult := GrNotDetected
2197 else _GraphResult := grOk;
2198 end;
2199 end;
2201 (*
2202 function getVESAMode:word;assembler;
2203 asm {return -1 if error}
2204 mov ax,4F03h
2205 {$ifdef fpc}
2206 push ebp
2207 {$endif fpc}
2208 int 10h
2209 {$ifdef fpc}
2210 pop ebp
2211 {$endif fpc}
2212 cmp ax,004Fh
2213 je @@OK
2214 mov ax,-1
2215 jmp @@X
2216 @@OK:
2217 mov ax,bx
2218 @@X:
2219 end;
2220 *)
2224 {************************************************************************}
2225 {* VESA Modes inits *}
2226 {************************************************************************}
2228 {$IFDEF DPMI}
2230 {******************************************************** }
2231 { Function GetMaxScanLines() }
2232 {-------------------------------------------------------- }
2233 { This routine returns the maximum number of scan lines }
2234 { possible for this mode. This is done using the Get }
2235 { Scan Line length VBE function. }
2236 {******************************************************** }
2237 function GetMaxScanLines: word;
2238 var
2239 regs : TDPMIRegisters;
2240 begin
2241 FillChar(regs, sizeof(regs), #0);
2242 { play it safe, call the real mode int, the 32-bit entry point }
2243 { may not be defined as stated in VBE v3.0 }
2244 regs.eax := $4f06; {_ setup function }
2245 regs.ebx := $0001; { get scan line length }
2246 RealIntr($10, regs);
2247 GetMaxScanLines := (regs.edx and $0000ffff);
2248 end;
2250 {$ELSE}
2252 function GetMaxScanLines: word; assembler;
2253 asm
2254 mov ax, 4f06h
2255 mov bx, 0001h
2256 int 10h
2257 mov ax, dx
2258 end;
2260 {$ENDIF}
2262 procedure Init1280x1024x64k; {$ifndef fpc}far;{$endif fpc}
2263 begin
2264 SetVesaMode(m1280x1024x64k);
2265 { Get maximum number of scanlines for page flipping }
2266 ScanLines := GetMaxScanLines;
2267 end;
2269 procedure Init1280x1024x32k; {$ifndef fpc}far;{$endif fpc}
2270 begin
2271 SetVESAMode(m1280x1024x32k);
2272 { Get maximum number of scanlines for page flipping }
2273 ScanLines := GetMaxScanLines;
2274 end;
2276 procedure Init1280x1024x256; {$ifndef fpc}far;{$endif fpc}
2277 begin
2278 SetVESAMode(m1280x1024x256);
2279 { Get maximum number of scanlines for page flipping }
2280 ScanLines := GetMaxScanLines;
2281 end;
2284 procedure Init1280x1024x16; {$ifndef fpc}far;{$endif fpc}
2285 begin
2286 SetVESAMode(m1280x1024x16);
2287 { Get maximum number of scanlines for page flipping }
2288 ScanLines := GetMaxScanLines;
2289 end;
2291 procedure Init1024x768x64k; {$ifndef fpc}far;{$endif fpc}
2292 begin
2293 SetVESAMode(m1024x768x64k);
2294 { Get maximum number of scanlines for page flipping }
2295 ScanLines := GetMaxScanLines;
2296 end;
2298 procedure Init640x480x32k; {$ifndef fpc}far;{$endif fpc}
2299 begin
2300 SetVESAMode(m640x480x32k);
2301 { Get maximum number of scanlines for page flipping }
2302 ScanLines := GetMaxScanLines;
2303 end;
2305 procedure Init1024x768x256; {$ifndef fpc}far;{$endif fpc}
2306 begin
2307 SetVESAMode(m1024x768x256);
2308 { Get maximum number of scanlines for page flipping }
2309 ScanLines := GetMaxScanLines;
2310 end;
2312 procedure Init1024x768x16; {$ifndef fpc}far;{$endif fpc}
2313 begin
2314 SetVESAMode(m1024x768x16);
2315 { Get maximum number of scanlines for page flipping }
2316 ScanLines := GetMaxScanLines;
2317 end;
2319 procedure Init800x600x64k; {$ifndef fpc}far;{$endif fpc}
2320 begin
2321 SetVESAMode(m800x600x64k);
2322 { Get maximum number of scanlines for page flipping }
2323 ScanLines := GetMaxScanLines;
2324 end;
2326 procedure Init800x600x32k; {$ifndef fpc}far;{$endif fpc}
2327 begin
2328 SetVESAMode(m800x600x32k);
2329 { Get maximum number of scanlines for page flipping }
2330 ScanLines := GetMaxScanLines;
2331 end;
2333 procedure Init800x600x256; {$ifndef fpc}far;{$endif fpc}
2334 begin
2335 SetVESAMode(m800x600x256);
2336 { Get maximum number of scanlines for page flipping }
2337 ScanLines := GetMaxScanLines;
2338 end;
2340 procedure Init800x600x16; {$ifndef fpc}far;{$endif fpc}
2341 begin
2342 SetVesaMode(m800x600x16);
2343 { Get maximum number of scanlines for page flipping }
2344 ScanLines := GetMaxScanLines;
2345 end;
2347 procedure Init640x480x64k; {$ifndef fpc}far;{$endif fpc}
2348 begin
2349 SetVESAMode(m640x480x64k);
2350 { Get maximum number of scanlines for page flipping }
2351 ScanLines := GetMaxScanLines;
2352 end;
2355 procedure Init640x480x256; {$ifndef fpc}far;{$endif fpc}
2356 begin
2357 SetVESAMode(m640x480x256);
2358 { Get maximum number of scanlines for page flipping }
2359 ScanLines := GetMaxScanLines;
2360 end;
2362 procedure Init640x400x256; {$ifndef fpc}far;{$endif fpc}
2363 begin
2364 SetVESAMode(m640x400x256);
2365 { Get maximum number of scanlines for page flipping }
2366 ScanLines := GetMaxScanLines;
2367 end;
2369 procedure Init320x200x64k; {$ifndef fpc}far;{$endif fpc}
2370 begin
2371 SetVESAMode(m320x200x64k);
2372 { Get maximum number of scanlines for page flipping }
2373 ScanLines := GetMaxScanLines;
2374 end;
2376 procedure Init320x200x32k; {$ifndef fpc}far;{$endif fpc}
2377 begin
2378 SetVESAMode(m320x200x32k);
2379 { Get maximum number of scanlines for page flipping }
2380 ScanLines := GetMaxScanLines;
2381 end;
2384 {$IFDEF DPMI}
2386 Procedure SaveStateVESA; {$ifndef fpc}far;{$endif fpc}
2387 var
2388 PtrLong: longint;
2389 regs: TDPMIRegisters;
2390 begin
2391 SaveSupported := FALSE;
2392 SavePtr := nil;
2393 {$ifdef logging}
2394 LogLn('Get the video mode...');
2395 {$endif logging}
2396 { Get the video mode }
2397 asm
2398 mov ah,0fh
2399 {$ifdef fpc}
2400 push ebp
2401 {$endif fpc}
2402 int 10h
2403 {$ifdef fpc}
2404 pop ebp
2405 {$endif fpc}
2406 mov [VideoMode], al
2407 end;
2408 {$ifdef logging}
2409 LogLn('Prepare to save VESA video state');
2410 {$endif logging}
2411 { Prepare to save video state...}
2412 asm
2413 mov ax, 4F04h { get buffer size to save state }
2414 mov dx, 00h
2415 mov cx, 00001111b { Save DAC / Data areas / Hardware states }
2416 {$ifdef fpc}
2417 push ebp
2418 {$endif fpc}
2419 int 10h
2420 {$ifdef fpc}
2421 pop ebp
2422 {$endif fpc}
2423 mov [StateSize], bx
2424 cmp al,04fh
2425 jnz @notok
2426 mov [SaveSupported],TRUE
2427 @notok:
2428 end;
2429 regs.eax := $4f04;
2430 regs.edx := $0000;
2431 regs.ecx := $000F;
2432 RealIntr($10, regs);
2433 StateSize := word(regs.ebx);
2434 if byte(regs.eax) = $4f then
2435 SaveSupported := TRUE;
2436 if SaveSupported then
2437 begin
2438 {$ifdef logging}
2439 LogLn('allocating VESA save buffer of '+strf(64*StateSize));
2440 {$endif logging}
2441 {$ifndef fpc}
2442 PtrLong:=GlobalDosAlloc(64*StateSize); { values returned in 64-byte blocks }
2443 {$else fpc}
2444 PtrLong:=Global_Dos_Alloc(64*StateSize); { values returned in 64-byte blocks }
2445 {$endif fpc}
2446 if PtrLong = 0 then
2447 RunError(203);
2448 SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
2449 {$ifndef fpc}
2450 { In FPC mode, we can't do anything with this (no far pointers) }
2451 { However, we still need to keep it to be able to free the }
2452 { memory afterwards. Since this data is not accessed in PM code, }
2453 { there's no need to save it in a seperate buffer (JM) }
2454 if not assigned(SavePtr) then
2455 RunError(203);
2456 {$endif fpc}
2457 RealStateSeg := word(PtrLong shr 16);
2459 FillChar(regs, sizeof(regs), #0);
2460 { call the real mode interrupt ... }
2461 regs.eax := $4F04; { save the state buffer }
2462 regs.ecx := $0F; { Save DAC / Data areas / Hardware states }
2463 regs.edx := $01; { save state }
2464 regs.es := RealStateSeg;
2465 regs.ebx := 0;
2466 RealIntr($10,regs);
2467 FillChar(regs, sizeof(regs), #0);
2468 { restore state, according to Ralph Brown Interrupt list }
2469 { some BIOS corrupt the hardware after a save... }
2470 regs.eax := $4F04; { restore the state buffer }
2471 regs.ecx := $0F; { rest DAC / Data areas / Hardware states }
2472 regs.edx := $02;
2473 regs.es := RealStateSeg;
2474 regs.ebx := 0;
2475 RealIntr($10,regs);
2476 end;
2477 end;
2479 procedure RestoreStateVESA; {$ifndef fpc}far;{$endif fpc}
2480 var
2481 regs:TDPMIRegisters;
2482 begin
2483 { go back to the old video mode...}
2484 asm
2485 mov ah,00
2486 mov al,[VideoMode]
2487 {$ifdef fpc}
2488 push ebp
2489 {$endif fpc}
2490 int 10h
2491 {$ifdef fpc}
2492 pop ebp
2493 {$endif fpc}
2494 end;
2495 { then restore all state information }
2496 {$ifndef fpc}
2497 if assigned(SavePtr) and (SaveSupported=TRUE) then
2498 {$else fpc}
2499 { No far pointer support, so it's possible that that assigned(SavePtr) }
2500 { would return false under FPC. Just check if it's different from nil. }
2501 if (SavePtr <> nil) and (SaveSupported=TRUE) then
2502 {$endif fpc}
2503 begin
2504 FillChar(regs, sizeof(regs), #0);
2505 { restore state, according to Ralph Brown Interrupt list }
2506 { some BIOS corrupt the hardware after a save... }
2507 regs.eax := $4F04; { restore the state buffer }
2508 regs.ecx := $0F; { rest DAC / Data areas / Hardware states }
2509 regs.edx := $02; { restore state }
2510 regs.es := RealStateSeg;
2511 regs.ebx := 0;
2512 RealIntr($10,regs);
2513 (* Done in exitproc (Jonas)
2514 {$ifndef fpc}
2515 if GlobalDosFree(longint(SavePtr) shr 16)<>0 then
2516 {$else fpc}
2517 if Not(Global_Dos_Free(longint(SavePtr) shr 16)) then
2518 {$endif fpc}
2519 RunError(216);
2520 SavePtr := nil;
2521 *)
2522 end;
2523 end;
2525 {$ELSE}
2527 {**************************************************************}
2528 {* Real mode routines *}
2529 {**************************************************************}
2531 Procedure SaveStateVESA; far;
2532 begin
2533 SavePtr := nil;
2534 SaveSupported := FALSE;
2535 { Get the video mode }
2536 asm
2537 mov ah,0fh
2538 int 10h
2539 mov [VideoMode], al
2540 end;
2541 { Prepare to save video state...}
2542 asm
2543 mov ax, 4f04h { get buffer size to save state }
2544 mov cx, 00001111b { Save DAC / Data areas / Hardware states }
2545 mov dx, 00h
2546 int 10h
2547 mov [StateSize], bx
2548 cmp al,04fh
2549 jnz @notok
2550 mov [SaveSupported],TRUE
2551 @notok:
2552 end;
2553 if SaveSupported then
2554 Begin
2555 GetMem(SavePtr, 64*StateSize); { values returned in 64-byte blocks }
2556 if not assigned(SavePtr) then
2557 RunError(203);
2558 asm
2559 mov ax, 4F04h { save the state buffer }
2560 mov cx, 00001111b { Save DAC / Data areas / Hardware states }
2561 mov dx, 01h
2562 mov es, WORD PTR [SavePtr+2]
2563 mov bx, WORD PTR [SavePtr]
2564 int 10h
2565 end;
2566 { restore state, according to Ralph Brown Interrupt list }
2567 { some BIOS corrupt the hardware after a save... }
2568 asm
2569 mov ax, 4F04h { save the state buffer }
2570 mov cx, 00001111b { Save DAC / Data areas / Hardware states }
2571 mov dx, 02h
2572 mov es, WORD PTR [SavePtr+2]
2573 mov bx, WORD PTR [SavePtr]
2574 int 10h
2575 end;
2576 end;
2577 end;
2579 procedure RestoreStateVESA; far;
2580 begin
2581 { go back to the old video mode...}
2582 asm
2583 mov ah,00
2584 mov al,[VideoMode]
2585 int 10h
2586 end;
2588 { then restore all state information }
2589 if assigned(SavePtr) and (SaveSupported=TRUE) then
2590 begin
2591 { restore state, according to Ralph Brown Interrupt list }
2592 asm
2593 mov ax, 4F04h { save the state buffer }
2594 mov cx, 00001111b { Save DAC / Data areas / Hardware states }
2595 mov dx, 02h { restore state }
2596 mov es, WORD PTR [SavePtr+2]
2597 mov bx, WORD PTR [SavePtr]
2598 int 10h
2599 end;
2600 { Done in exitproc (JM)
2601 FreeMem(SavePtr, 64*StateSize); }
2602 SavePtr := nil;
2603 end;
2604 end;
2605 {$ENDIF DPMI}
2607 {************************************************************************}
2608 {* VESA Page flipping routines *}
2609 {************************************************************************}
2610 { Note: These routines, according to the VBE3 specification, will NOT }
2611 { work with the 24 bpp modes, because of the alignment. }
2612 {************************************************************************}
2614 {******************************************************** }
2615 { Procedure SetVisualVESA() }
2616 {-------------------------------------------------------- }
2617 { This routine changes the page which will be displayed }
2618 { on the screen, since the method has changed somewhat }
2619 { between VBE versions , we will use the old method where }
2620 { the new pixel offset is used to display different pages }
2621 {******************************************************** }
2622 procedure SetVisualVESA(page: word); {$ifndef fpc}far;{$endif fpc}
2623 var
2624 newStartVisible : word;
2625 begin
2626 if page > HardwarePages then exit;
2627 newStartVisible := (MaxY+1)*page;
2628 if newStartVisible > ScanLines then exit;
2629 asm
2630 mov ax, 4f07h
2631 mov bx, 0000h { set display start }
2632 mov cx, 0000h { pixel zero ! }
2633 mov dx, [NewStartVisible] { new scanline }
2634 {$ifdef fpc}
2635 push ebp
2636 {$endif}
2637 int 10h
2638 {$ifdef fpc}
2639 pop ebp
2640 {$endif}
2641 end;
2642 end;
2644 procedure SetActiveVESA(page: word); {$ifndef fpc}far;{$endif fpc}
2645 begin
2646 { video offset is in pixels under VESA VBE! }
2647 { This value is reset after a mode set to page ZERO = YOffset = 0 ) }
2648 YOffset := (MaxY+1)*page;
2649 end;
2651 (*
2652 $Log$
2653 Revision 1.1 2002/02/19 08:25:17 sasu
2654 Initial revision
2656 Revision 1.1.2.3 2000/12/16 15:57:16 jonas
2657 * removed 64bit evaluations when range checking is on
2659 Revision 1.1.2.2 2000/08/01 05:58:49 jonas
2660 * set _graphresult to grnotdetected if the vesa setmode interrupt
2661 call returns an error
2663 Revision 1.1.2.1 2000/07/16 07:47:01 jonas
2664 * fixed several savevideo/restorevideostate related problems
2665 * moved exitsave pointer from graphh.inc to grap.inc to avoid name
2666 conflicts with people using this name in their own programs
2668 Revision 1.1 2000/07/13 06:30:40 michael
2669 + Initial import
2671 Revision 1.25 2000/07/08 07:48:38 jonas
2672 * LFB modes finally work! You have to add $4000 to the mode number
2673 if you use LFB access!
2675 Revision 1.24 2000/06/07 07:41:44 jonas
2676 * always set SetupLinear to false at the start of the routine (there
2677 were some "exit" statements which returned without the function
2678 result being set otherwise)
2680 Revision 1.23 2000/05/13 14:08:42 jonas
2681 * set some more procedures back to the defaults when using linear
2682 VESA modes because they only work for windowed VESA modes
2684 Revision 1.22 2000/03/19 11:20:13 peter
2685 * graph unit include is now independent and the dependent part
2686 is now in graph.pp
2687 * ggigraph unit for linux added
2689 Revision 1.21 2000/03/12 22:32:22 pierre
2690 + UseLFB and UseNoSelector vars to force LinearFrameBuffer use
2691 with or without specific selector.
2693 Revision 1.20 2000/03/09 22:32:22 pierre
2694 * fixes for LFB mode
2696 Revision 1.19 2000/02/12 13:39:19 jonas
2697 + new, faster fillpoly from Thomas Schatzl
2698 * some logging commands in vesa.inc disabled
2700 Revision 1.18 2000/01/07 16:41:32 daniel
2701 * copyright 2000
2703 Revision 1.17 2000/01/07 16:32:24 daniel
2704 * copyright 2000 added
2706 Revision 1.16 2000/01/06 15:19:42 jonas
2707 * fixed bug in getscanlinevesa256 and hlinevesa256 for short lines (<8 pixels)
2709 Revision 1.15 2000/01/02 18:51:05 jonas
2710 * again small fix to patternline-, hline- and getscanlinevesa256
2712 Revision 1.14 1999/12/29 12:15:41 jonas
2713 * fixed small bug in hlinevesa256, getscanlinevesa25 and patternlinevesa256
2714 * small speed-up in the above procedures
2716 Revision 1.13 1999/12/27 12:10:57 jonas
2717 * fixed VESA palrec structure
2719 Revision 1.12 1999/12/26 10:36:00 jonas
2720 * finished patternlineVESA256 and enabled it
2721 * folded (direct)put/getpixVESA32k and 64k into one procedure since
2722 they were exactly the same code
2724 Revision 1.11 1999/12/25 22:31:09 jonas
2725 + patternlineVESA256, not yet used because I'm not yet sure it's
2726 already working 100%
2727 * changed {$ifdef logging} to {$ifdef logging2} for vlineVESA256 and
2728 hlineVESA256 (they're used a lot a working properly afaik)
2730 Revision 1.10 1999/12/21 17:42:17 jonas
2731 * changed vesa.inc so it doesn't try to use linear modes anymore (doesn't work
2732 yet!!)
2733 * fixed mode detection so the low modenumber of a driver doesn't have to be zero
2734 anymore (so VESA autodetection now works)
2736 Revision 1.9 1999/12/12 13:34:20 jonas
2737 * putimage now performs the lipping itself and uses directputpixel
2738 (note: this REQUIRES or/and/notput support in directputpixel,
2739 this is not yet the case in the assembler versions!)
2740 * YOffset addition moved in hlinevesa256 and vlinevesa256
2741 because it uses still putpixel afterwards
2743 Revision 1.8 1999/12/11 23:41:39 jonas
2744 * changed definition of getscanlineproc to "getscanline(x1,x2,y:
2745 integer; var data);" so it can be used by getimage too
2746 * changed getimage so it uses getscanline
2747 * changed floodfill, getscanline16 and definitions in Linux
2748 include files so they use this new format
2749 + getscanlineVESA256 for 256 color VESA modes (banked)
2751 Revision 1.7 1999/12/10 12:52:54 pierre
2752 * some LinearFrameBuffer code, not finished
2754 Revision 1.6 1999/12/09 02:06:00 carl
2755 + page flipping for all VESA modes.
2756 (important note: The VESAModeInfo structure returns the MAXIMUM
2757 number of image pages, and not the actual available number of
2758 pages (cf. VBE 3.0 specification), that is the reason why
2759 SetVisualPage() has so much checking).
2761 Revision 1.5 1999/12/02 22:34:14 pierre
2762 * avoid FPC problem in array of char comp
2764 Revision 1.4 1999/11/30 02:25:15 carl
2765 * GetPixVESA16 bugfix with read segment.
2767 Revision 1.3 1999/11/28 12:18:39 jonas
2768 + all available mode numbers are logged if you compile the unit with
2769 -dlogging
2771 Revision 1.2 1999/11/27 21:48:01 jonas
2772 * fixed VlineVESA256 and re-enabled it in graph.inc
2773 * added procedure detectgraph to interface of graph unit
2775 Revision 1.1 1999/11/08 11:15:21 peter
2776 * move graph.inc to the target dir
2778 Revision 1.21 1999/11/03 20:23:01 florian
2779 + first release of win32 gui support
2781 Revision 1.20 1999/10/24 15:50:23 carl
2782 * Bugfix in TP mode SaveStateVESA
2784 Revision 1.19 1999/10/24 03:37:15 carl
2785 + GetPixVESA16 (not tested yet...)
2787 Revision 1.18 1999/09/28 13:56:31 jonas
2788 * reordered some local variables (first 4 byte vars, then 2 byte vars
2789 etc)
2790 * font data is now disposed in exitproc, exitproc is now called
2791 GraphExitProc (was CleanModes) and resides in graph.pp instead of in
2792 modes.inc
2794 Revision 1.17 1999/09/27 23:34:42 peter
2795 * new graph unit is default for go32v2
2796 * removed warnings/notes
2798 Revision 1.16 1999/09/26 13:31:07 jonas
2799 * changed name of modeinfo variable to vesamodeinfo and fixed
2800 associated errors (fillchar(modeinfo,sizeof(tmodeinfo),#0) instead
2801 of sizeof(TVesamodeinfo) etc)
2802 * changed several sizeof(type) to sizeof(varname) to avoid similar
2803 errors in the future
2805 Revision 1.15 1999/09/24 22:52:39 jonas
2806 * optimized patternline a bit (always use hline when possible)
2807 * isgraphmode stuff cleanup
2808 * vesainfo.modelist now gets disposed in cleanmode instead of in
2809 closegraph (required moving of some declarations from vesa.inc to
2810 new vesah.inc)
2811 * queryadapter gets no longer called from initgraph (is called from
2812 initialization of graph unit)
2813 * bugfix for notput in 32k and 64k vesa modes
2814 * a div replaced by / in fillpoly
2816 Revision 1.14 1999/09/23 14:00:42 jonas
2817 * -dlogging no longer required to fuction correctly
2818 * some typo's fixed
2820 Revision 1.13 1999/09/20 09:34:30 florian
2821 * conflicts solved
2823 Revision 1.12 1999/09/18 22:21:11 jonas
2824 + hlinevesa256 and vlinevesa256
2825 + support for not/xor/or/andput in vesamodes with 32k/64k colors
2826 * lots of changes to avoid warnings under FPC
2828 Revision 1.11 1999/09/15 11:40:30 jonas
2829 * fixed PutPixVESA256
2831 Revision 1.10 1999/09/11 19:43:02 jonas
2832 * FloodFill: did not take into account current viewport settings
2833 * GetScanLine: only get line inside viewport, data outside of it
2834 is not used anyway
2835 * InternalEllipseDefault: fix for when xradius or yradius = 0 and
2836 increase xradius and yradius always by one (TP does this too)
2837 * fixed conlict in vesa.inc from last update
2838 * some conditionals to avoid range check and overflow errors in
2839 places where it doesn't matter
2841 Revision 1.9 1999/08/01 14:51:07 jonas
2842 * removed and/or/xorput support from vesaputpix256 (not in TP either)
2843 * added notput support to directputpix256
2845 Revision 1.8 1999/07/18 15:07:21 jonas
2846 + xor-, and- and orput support for VESA256 modes
2847 * compile with -dlogging if you wnt some info to be logged to grlog.txt
2849 Revision 1.7 1999/07/14 15:21:49 jonas
2850 * fixed initialization of bankshift var ('64 shr banshift' instead of shl)
2852 Revision 1.6 1999/07/14 13:17:29 jonas
2853 * bugfix in getmodeinfo (SizeOf(TModeInfo) -> SizeOf(TVESAModeInfo))
2854 * as the result of the above bugfix, the graph unit doesn't crash
2855 anymore under FPC if compiler with -dsupportVESA, but it doesn't
2856 work yet either...
2858 Revision 1.5 1999/07/12 13:28:33 jonas
2859 * forgot log tag in previous commit
2861 *)