fpc/rtl/go32v2/ppi/ibm.ppi
1999-05-04 17:17:31 +00:00

407 lines
12 KiB
Plaintext

{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1993,97 by the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
function DetectVESA:Boolean;
var Result_:longint;
begin
Result_:=Global_dos_alloc($0200);
Sel:=word(Result_);
Seg:=word(Result_ shr 16);
dregs.RealSP:=0; dregs.RealSS:=0;
dregs.RealES:=Seg; dregs.RealEDI:=0;
dregs.RealEAX:=$4F00; RealIntr($10,dregs);
if isDPMI
then MoveLong(sel,@VGAInfo,256)
else Move(pointer((seg shl 4)+core)^,VGAInfo,256);
global_dos_free(sel);
DetectVesa:=(dregs.RealEAX and $FF=$4F);
isVESA2:=VGAInfo.VESAHiVersion=2;
end;
function GetVESAInfo( Mode : WORD ):Boolean;
var Result_:longint;
St : string;
{$ifdef Test_linear}
Temp : longint;
{$endif Test_linear}
begin
Result_:=Global_dos_alloc($0200);
Sel:=word(Result_);
Seg:=word(Result_ shr 16);
dregs.RealECX:=mode;
dregs.RealSP:=0; dregs.RealSS:=0;
dregs.RealES:=Seg; dregs.RealEDI:=0;
dregs.RealEAX:=$4F01; RealIntr($10,dregs);
if isDPMI
then MoveLong(sel,@VESAInfo,256)
else Move(Pointer((seg shl 4)+core)^,VESAINFO,256);
global_dos_free(sel);
{ this is wrong because AH is set to one if mode not detected !!!
if (dregs.RealEAX and $ff) =$4F then must be replaced by }
if (dregs.RealEAX and $1ff) =$4F then
begin
GetVESAInfo:=true;
{ mode is supported only if bit 0 in modeAttributes is set }
if (VESAInfo.ModeAttributes and 1)=0 then
GetVESAInfo:=false;
BytesPerLine:=VESAInfo.BPL;
case VESAInfo.BitsPerPixel of
8 : begin
BytesPerPixel:=1;
ColorMask:=$ff;
end;
15,16 : begin
BytesPerPixel:=2;
ColorMask:=$ffff;
end;
{$ifdef TEST_24BPP}
24 : begin
BytesPerPixel:=3;
ColorMask:=$ffffff;
end;
32 : begin
BytesPerPixel:=4;
ColorMask:=$ffffff;
end;
{$endif TEST_24BPP}
else begin
str(VESAInfo.BitsPerPixel,St);
GraphFault(St+'-Bit Mode not implemented !');
exit;
end;
end;
_maxx:=VESAInfo.XResolution;
_maxy:=VESAInfo.YResolution;
{$ifdef TEST_24BPP}
{ problem with pseudo 32 bit modes !! }
if BytesPerPixel*VESAInfo.XResolution<>BytesPerLine then
begin
GraphFault('Unconsistant VESA data');
{ GetVesaInfo:=False; }
BytesPerPixel:=BytesPerLine div VESAInfo.XResolution;
end;
{$endif TEST_24BPP}
WinSize:=VESAInfo.Winsize*1024;
WinLoMask:=WinSize-1;
case VESAInfo.WinSize of
64 : WinShift:=16; { x div 65536 = x shr 16 }
32 : WinShift:=15; { x div 32768 = x shr 15 }
16 : WinShift:=14; { ... }
8 : WinShift:=13;
4 : WinShift:=12;
2 : WinShift:=11;
1 : WinShift:=10;
end;
Granularity:=VESAInfo.WinGranularity;
Granular:=VESAInfo.WinSize div Granularity;
case Granular of
256 : GranShift:=8;
128 : GranShift:=7;
64 : GranShift:=6;
32 : GranShift:=5;
16 : GranShift:=4;
8 : GranShift:=3;
4 : GranShift:=2;
2 : GranShift:=1;
1 : GranShift:=0;
end;
(* { on my ATI rage pro card these field are zeroed !! (PM) }
if VesaInfo.rf_pos=VesaInfo.bf_pos then
begin
VesaInfo.rm_size:=VESAInfo.BitsPerPixel div 3;
VesaInfo.bm_size:=VESAInfo.BitsPerPixel div 3;
VesaInfo.gm_size:=VESAInfo.BitsPerPixel -2*VesaInfo.bm_size;
VesaInfo.bf_pos:=0;
VesaInfo.gf_pos:=VesaInfo.bm_size;
VesaInfo.rf_pos:=VesaInfo.bm_size+VesaInfo.gm_size;
end; *)
if isDPMI then begin
set_segment_base_address(seg_write,$A000 shl 4);
set_segment_limit(seg_write,$FFFF);
set_segment_base_address(seg_read,$A000 shl 4);
set_segment_limit(seg_read,$FFFF);
end;
{ read and write window can be different !!! PM }
if ((VESAInfo.WinAAttributes and 5)=5) then
AW_Window:=AWindow
else if ((VESAInfo.WinBAttributes and 5)=5) then
AW_Window:=BWindow
else GraphFault('No write window !! ');
if ((VESAInfo.WinAAttributes and 3)=3) then
AR_Window:=AWindow
else if ((VESAInfo.WinBAttributes and 3)=3) then
AR_Window:=BWindow
else GraphFault('No read window !! ');
if AW_Window=AR_Window then
same_window:=true
else
same_window:=false;
if (VESAInfo.ModeAttributes and $80)=$80 then
LinearFrameBufferSupported:=true
else
LinearFrameBufferSupported:=false;
{$ifdef Test_linear}
(* bug was due to alignment problem in VesaInfoBlock !! PM
{ try to swap the FrameBuffer Physical Address }
if switch_physical_address then
begin
w:=VESAInfo.PhysAddress and $FFFF;
VESAInfo.PhysAddress:=(w shl 16) or (VESAInfo.PhysAddress shr 16);
end; *)
If LinearFrameBufferSupported then
begin
FrameBufferLinearAddress:=Get_linear_addr(VESAInfo.PhysAddress and $FFFF0000,VGAInfo.TotalMem shl 16);
if int31error<>0 then
writeln(stderr,'Error in get linear address for ',hexstr(VESAInfo.PhysAddress,8));
end
else
{$endif Test_linear}
FrameBufferLinearAddress:=$A0000;
{$ifdef Test_linear}
If isDPMI and LinearFrameBufferSupported and UseLinear then
UseLinearFrameBuffer:=true
else
UseLinearFrameBuffer:=false;
if UseLinearFrameBuffer then
begin
set_segment_base_address(seg_write,FrameBufferLinearAddress);
set_segment_limit(seg_write,(VGAInfo.TotalMem shl 16)-1);
set_segment_base_address(seg_read,FrameBufferLinearAddress);
set_segment_limit(seg_read,(VGAInfo.TotalMem shl 16)-1);
WinSize:=(VGAInfo.TotalMem shl 16);
WinLoMask:=(VGAInfo.TotalMem shl 16)-1;
WinShift:=15;
Temp:=VGAInfo.TotalMem;
while Temp>0 do
begin
inc(WinShift);
Temp:=Temp shr 1;
end;
end;
{$endif Test_linear}
SwitchCS:=hi(VESAInfo.RealWinFuncPtr);
SwitchIP:=lo(VESAInfo.RealWinFuncPtr);
{ usefull for boundary problems }
if BytesPerPixel=3 then
WinLoMaskMinusPixelSize:=WinLoMask-4
else
WinLoMaskMinusPixelSize:=WinLoMask-BytesPerPixel;
end else GetVESAInfo:=false;
end;
function SetVESAMode(Mode:WORD):Boolean;
begin
dregs.RealEBX:=Mode;
dregs.RealSP:=0; dregs.RealSS:=0;
dregs.RealEAX:=$4F02; RealIntr($10,dregs);
{ idem as above !!! }
if (dregs.RealEAX and $1FF) <> $4F then begin
writeln('Couldn''t initialize VESAMode ',HexStr(mode,4));
SetVESAMode:=false;
end
else SetVESAMode:=true;
end;
procedure SetDisplayPage(PageNum : word);
begin
dregs.RealSP:=0; dregs.RealSS:=0;
dregs.RealEAX:=$0500+(PageNum and $FF);
RealIntr($10,dregs);
end;
function SetVESADisplayStart(PageNum : word;x,y : integer):Boolean;
begin
if PageNum>VesaInfo.NumberOfPages then
PageNum:=0;
{$ifdef DEBUG}
if PageNum>0 then
writeln(stderr,'Setting Display Page ',PageNum);
{$endif DEBUG}
dregs.RealEBX:=0{ $80 for Wait for retrace };
dregs.RealECX:=x;
dregs.RealEDX:=y+PageNum*_maxy;
dregs.RealSP:=0; dregs.RealSS:=0;
dregs.RealEAX:=$4F07; RealIntr($10,dregs);
{ idem as above !!! }
if (dregs.RealEAX and $1FF) <> $4F then
begin
writeln(stderr,'Set Display start error');
SetVESADisplayStart:=false;
end
else
SetVESADisplayStart:=true;
end;
function GetVESAMode:Integer;
begin
dregs.RealSP:=0; dregs.RealSS:=0;
dregs.RealEAX:=$4F03; RealIntr($10,dregs);
GetVESAMode:=lo(dregs.RealEBX);
end;
procedure InitVESA;
var RM:Word;
begin
isDPMI:=false;
rm:=get_run_mode;
{$ifdef Debug}
case rm of
0 : writeln('unknown mode');
1 : writeln('RAW mode');
2 : writeln('XMS detected');
3 : writeln('VCPI detected');
4 : writeln('DPMI detected');
end; { case }
{$endif Debug}
if rm=4 then
isDPMI:=true;
if isDPMI then begin
seg_write:=allocate_ldt_descriptors(1);
seg_read:=allocate_ldt_descriptors(1);
end else begin
seg_write:=get_DS;
seg_read:=get_DS;
end;
end;
procedure DoneVESA;
begin
if isDPMI then begin
free_ldt_descriptor(seg_read);
free_ldt_descriptor(seg_write);
end;
end;
procedure Switchbank(bank:longint);
begin
with dregs do
begin
a_bank:=bank;
realedx:=bank shl granshift;
realcs:=switchcs;
realip:=switchip;
realebx:=aw_window;
realss:=0;
realsp:=0;
end;
asm
leal _DREGS,%edi
xorl %ecx,%ecx
movl %ecx,%ebx
movw $0x0301,%ax
int $0x31
end;
if not same_window then
with dregs do
begin
realedx:=bank shl granshift;
realcs:=switchcs;
realip:=switchip;
realebx:=ar_window;
realss:=0;
realsp:=0;
asm
leal _DREGS,%edi
xorl %ecx,%ecx
movl %ecx,%ebx
movw $0x0301,%ax
int $0x31
end;
end;
end;
{
$Log$
Revision 1.3 1999-05-04 17:17:32 florian
* some explicit language removed
Revision 1.2 1998/12/21 14:06:03 pierre
* var declaration was missing ??
Revision 1.1 1998/12/21 13:07:03 peter
* use -FE
Revision 1.7 1998/11/25 13:04:46 pierre
+ added multi page support
Revision 1.6 1998/11/20 18:42:08 pierre
* many bugs related to floodfill and ellipse fixed
Revision 1.5 1998/11/20 10:16:02 pierre
* Found out the LinerFrameBuffer problem
Was an alignment problem in VesaInfoBlock (see graph.pp file)
Compile with -dDEBUG and answer 'y' to 'Use Linear ?' to test
Revision 1.4 1998/11/18 12:12:54 pierre
* WinShift was wrong for LinearBuffer
Revision 1.3 1998/11/18 09:31:35 pierre
* changed color scheme
all colors are in RGB format if more than 256 colors
+ added 24 and 32 bits per pixel mode
(compile with -dDEBUG)
24 bit mode with banked still as problems on pixels across
the bank boundary, but works in LinearFrameBufferMode
Look at install/demo/nmandel.pp
Revision 1.2 1998/10/09 10:26:36 peter
* rename result -> result_
Revision 1.1.1.1 1998/03/25 11:18:42 root
* Restored version
Revision 1.6 1998/01/26 11:58:09 michael
+ Added log at the end
Working file: rtl/dos/ppi/ibm.ppi
description:
----------------------------
revision 1.5
date: 1997/12/11 11:26:54; author: pierre; state: Exp; lines: +165 -165
* forgot dtou !!
----------------------------
revision 1.4
date: 1997/12/11 11:24:19; author: pierre; state: Exp; lines: +165 -165
* bug in string at line 103 corrected
----------------------------
revision 1.3
date: 1997/12/04 08:52:35; author: florian; state: Exp; lines: +4 -4
+ vesa mode 1280x1024x256 added
----------------------------
revision 1.2
date: 1997/12/01 12:21:30; author: michael; state: Exp; lines: +13 -1
+ added copyright reference in header.
----------------------------
revision 1.1
date: 1997/11/27 08:33:51; author: michael; state: Exp;
Initial revision
----------------------------
revision 1.1.1.1
date: 1997/11/27 08:33:51; author: michael; state: Exp; lines: +0 -0
FPC RTL CVS start
=============================================================================
}