fpc/rtl/dos/ppi/ibm.ppi

{
    $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;
    Temp : longint;
    St : string;
    w : word;
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);
               Oh_Kacke(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
          Oh_Kacke('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 Oh_Kacke('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 Oh_Kacke('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.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
  =============================================================================
}