{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                    VESA支持单元                         ***}
{***************************************************************}
{$F+,O+,X+,S-}
Unit FVesa;
Interface

Type
  VESAInfo=record
       VESASignature:array[0..3] of byte;  {4个标识字节}
       VESAVersion:integer;      {VESA版本号}
       OEMStringPtr:pchar; {指向OEM名字串的长指针}
       Capabilities:byte;      {显示视频环境的能力}
       VideoModePtr:pointer;  {指向支持的Super VGA显示方式集的长指针}
       TotalMemory:integer;        {显示存储器的数目(64K为单位)}
       Reserved:array[0..241] of byte;     {保留将来使用}
  end;

  ModeInfo=record
       ModeAttributes:integer;    {显示方式属性}
       WinAAttributes:byte;    {主机视频窗口A的属性}
       WinBAttributes:byte;    {主机视频窗口B的属性}
       WinGranularity:integer;    {主机视频窗口的粒度}
       WinSize:integer;           {主机视频窗口的长度}
       WinASegment:integer;       {主机视频窗口A的起始段地址}
       WinBSegment:integer;       {主机视频窗口B的起始段地址}
       WinFuncPtr:Procedure;   {主机视频窗口功能调用入口地址}
       BytesPerScanLine:integer;  {每条扫描线的字节数}
{ Optional information (When bit1 of ModeAttributes is set) }
       XResolution:integer;       {水平分辨率}
       YResolution:integer;       {垂直分辨率}
       XCharSize:byte;         {字符宽度}
       YCharSize:byte;         {字符高度}
       NumberOfPlanes:byte;    {显示存储器的位平面个数}
       BitsPerPixel:byte;      {每个象素对应的位数}
       NumberOfBanks:byte;     {显示存储器分块数}
       MemoryModel:byte;       {显示存储器组织模型}
       BankSize:byte;          {显示存储器块的长度(以KB为单位)}
       NumberOfImagePages:byte;{图象数}
       Reserved:array[0..225] of byte;     {保留将来使用}
  end;

Const
  Maxx    :Integer=639;
  Maxy    :Integer=479;
  MaxColor:Integer=256;

Var
  VESA_Info:VESAInfo;
  VESA_ModeInfo:ModeInfo;
  Current_Page,OldPage:Integer;
  Current_Mode:Word;
  Current_Color:byte;

Function  GetVESAInfo:Boolean;
Function  GetVESAModeInfo(Mode:Word):Boolean;
Function  SetVideoMode(Mode:Word):Boolean;
Function  GetVideoMode:Word;
Procedure SelectPageVESA(Page:Integer);
Function  GetPageVESA:Integer;
Function  GetPixel8(X,Y:Integer):Byte;
Procedure PutPixel8(X,Y:Integer;Color:Byte);
Procedure PutLine8(X,Y:Integer;Sg,Sc:Word;Len:Integer);
Procedure LockVesaPage;
Procedure UnLockVesaPage;
Implementation
Uses
  Dos;

Const
  ScanLeng:Integer=640;

Var
  R:Registers;

Function GetVESAInfo:Boolean;
begin
  GetVESAInfo:=False;
  R.AX:=$4F00;
  R.ES:=Seg(VESA_Info);
  R.Di:=Ofs(VESA_Info);
  Intr($10,R);
  if R.AX=$004F then
    GetVESAInfo:=True;
end;

function GetVESAModeInfo(Mode:Word):Boolean;
begin
  GetVESAModeInfo:=False;
  R.AX:=$4F01;
  R.CX:=Mode;
  R.ES:=Seg(VESA_ModeInfo);
  R.DI:=Ofs(VESA_ModeInfo);
  Intr($10,R);
  if R.AX=$004F then
  begin
    GetVESAModeInfo:=True;
    ScanLeng:=Longint(VESA_ModeInfo.XResolution)*Longint(VESA_ModeInfo.BitsPerPixel)
              div (8*VESA_ModeInfo.NumberOfPlanes);
  end;
end;

Procedure SelectPageVESA(Page:Integer);assembler;
asm   MOV BX,0
      MOV DX,Page
      MOV AX,4F05H
      INT 10H
      MOV Current_Page,DX
end;

Function GetPageVESA:Integer;assembler;
asm   MOV BX,0100H
      MOV AX,4F05H
      INT 10H
      MOV AX,DX
end;

Procedure LockVesaPage;
begin
  OldPage:=GetPageVesa;
  SelectPageVesa(OldPage);
end;

Procedure UnLockVesaPage;
begin
  SelectPageVesa(OldPage);
end;

Function GetVideoMode:Word;
begin
  R.AX:=$4F03;
  Intr($10,R);
  if (R.AX=$004F)and(R.BX>$FF) then
  begin
    GetVideoMode:=R.BX;
    GetVESAModeInfo(R.BX);
    Maxx:=VESA_ModeInfo.XResolution-1;
    Maxy:=VESA_ModeInfo.YResolution-1;
    MaxColor:=1 shl VESA_ModeInfo.BitsPerPixel;
    SelectPageVESA(GetPageVESA);
  end;
end;

Function SetVideoMode(Mode:Word):Boolean;
begin
  SetVideoMode:=True;
  if Mode>=$100 then
  begin
    R.AX:=$4F02;
    R.BX:=Mode;
    Intr($10,R);
    if R.AX<>$4F then
    begin
      SetVideoMode:=False;
      Exit;
    end;
    Current_Mode:=GetVideoMode;
    SelectPageVESA(0);
  end;
end;

Function GetPixel8(X,Y:Integer):Byte;assembler;
asm   MOV  AX,Y
      MUL  ScanLeng
      ADD  AX,X
      JNC  @@1
      INC  DX
  @@1:MOV  DI,AX
      CMP  DX,Current_Page
      JE   @@2
      MOV  BX,0
      MOV  AX,4F05H
      INT  10H
      MOV  Current_Page,DX
  @@2:MOV  AX,0A000H
      MOV  ES,AX
      MOV  AL,ES:[DI]
end;

Procedure PutPixel8(X,Y:Integer;Color:Byte);assembler;
asm   MOV  AX,Y
      MUL  ScanLeng
      ADD  AX,X
      JNC  @@1
      INC  DX
  @@1:MOV  DI,AX
      CMP  DX,Current_Page
      JE   @@2
      MOV  BX,0
      MOV  AX,4F05H
      INT  10H
      MOV  Current_Page,DX
  @@2:MOV  AX,0A000H
      MOV  ES,AX
      MOV  AL,Color
      MOV  ES:[DI],AL
end;

Procedure PutLine8(X,Y:Integer;Sg,Sc:Word;Len:Integer);assembler;
asm   PUSH DS
      PUSH ES

{     MOV  BX,0100H
      MOV  AX,4F05H
      INT  10H
      MOV  OldPage,DX
      MOV  Current_Page,DX
}
      MOV  AX,Y
      MUL  ScanLeng
      ADD  AX,X
      JNC  @@1
      INC  DX
  @@1:MOV  DI,AX
      PUSH AX
      CMP  DX,Current_Page
      JE   @@2
      MOV  BX,0
      MOV  AX,4F05H
      INT  10H
      MOV  Current_Page,DX
  @@2:MOV  AX,0A000H
      MOV  ES,AX
      MOV  AX,SG
      MOV  DS,AX
      MOV  SI,SC
      MOV  CX,Len
      POP  AX
      ADD  AX,Len
      JNC  @@3
      SUB  CX,AX
      PUSH AX
      REP  MOVSB
      INC  DX
      MOV  BX,0
      MOV  AX,4F05H
      INT  10H
      MOV  Current_Page,DX
      POP  CX
  @@3:REP  MOVSB

{     MOV  BX,0
      MOV  DX,OldPage
      MOV  AX,4F05H
      INT  10H
      MOV  Current_Page,DX
}
      POP  ES
      POP  DS
end;

end.