{**********************************************************}
{*    Vypotil    : BENN,  benn2@seznam.cz                 *}
{*    Vypoceno v : TMT Pascal 3.90                        *}
{**********************************************************}
Program LFB;
{Pro nastaveni grafickeho rezimu v LFB je nutne 32-bitove prostredi, 32-bitove}
{DPMI a verzi VESA BIOS 2.0+. Je dobre take vedet, ze ne vsechny graficke mody}
{umoznuji LFB. Uvedeny priklad pouze urci adresu k video pameti v PM, kde neni}
{nutne prepinat banky video RAM. Je vyuzito funkci DPMI, ktere jsou popsany napr.}
{ATHelpu.}
{K nastaveni LFB je nutno znat velikost video RAM a fyzickou adresu. Z techto}
{dvou parametru namapujem video pamet DPMI funkci 800h a vrati se nam linearni}
{adresa. Potom staci nastavit mod s LFB rezimem. To je vse}
Uses Crt,DPMI,Strings;
Const  PozadovanyMod :Word = $100{640x400 256 barev}

Type  TVESAInfoBlok = Record
      VESASignatura             :Array[1..4of Char;
      VESAVerze                 :Word;
      OEMStringPtr              :^String;
      Vlastnosti                :Longint;
      VideoModPtr               :Pointer;
      CelkovaPamet              :Word;    {!!! DULEZITE !!!}
      OEMSWRevision             :Word;
      OEMVendorNamePtr          :^String;
      OEMProductNamePtr         :^String;
      OEMProductRevPtr          :^String;
      Reserved                  :Array[1..222of Byte;
   End;

Type  TVESAInfoMode = Record
      Atributy                  :Word;
      AtribA,AtribB             :Byte;
      Granularita               :Word;
      VelikostOkna              :Word;
      PocSegmentA,PocSegmentB   :Word;
      FARAdresa                 :Pointer;
      ScanovyRadek              :Word;
      Sirka,Vyska               :Word;
      SirkaZnaku,VyskaZnaku     :Byte;
      PocetRovin                :Byte;
      BityNaPixel               :Byte;
      PocetBanku                :Byte;
      TypPametovehoModelu       :Byte;
      VelikostBanku             :Byte;
      PocetObrazovychStranek    :Byte;
      Rezerv                    :Byte;
      VelMaskyR,PoziceMaskyR    :Byte;
      VelMaskyG,PoziceMaskyG    :Byte;
      VelMaskyB,PoziceMaskyB    :Byte;
      VelMaskyRez,PoziceMaskyRez:Byte;
      DirectScreen              :Byte;
      FyzickaAdresa             :Longint;    {!!! DULEZITE !!!}
      Reserved                  :Array[1..256-41of Byte;
   End;

Var  DosSegment                 :Word;
     RealRegs                   :TRmRegs;
     VESAInfoBlok               :TVESAInfoBlok;
     VESAInfoMode               :TVESAInfoMode;

     VelikostVideoRAM           :Longint;
     FyzickaAdresaVideoRAM      :Longint;
     LinearniAdresaVideoRAM     :Longint;

     X,Y                        :Word;

Begin
   ClrScr;
  {Alokovani dosoveho segmentu pro nacteni informaci VESA v realnem modu}
  {Staci alokovat 256B, vetsinou vypadne segment a selektor k alokovane pameti}
  {Segment slouzi pro sluzby DOSu, ktere neco vraci, selektor pro pristup z PM}
  {Z PM lze k informacim pristupovat take i za pomoci segmentu*16}
  {Vyuziva se sluzby DPMI funkce 100h viz ATHelp}
  DosSegment := DosMemoryAlloc(256);
  If DosSegment = 0 Then
    Begin
      Writeln('Chyba DPMI pri alokaci');
      Halt(0);
    End;

  {Z PM nelze vyuzivat sluzeb DOSu a BIOSu primo. Sluzby jsou volany pres DPMI}
  {funkce 300h. Zde se budou cist informace o VESA, ze kterych urcim velikost}
  {video RAM}
  ClearRmRegs(RealRegs);
  RealRegs.AX := $4F00;
  RealRegs.ES := DosSegment;
  RealRegs.DI := 00;
  If Not RealModeInt($10,RealRegs) Then
    Begin
      Writeln('Chyba DPMI pri volani sluzby BIOSu');
      Halt(0);
    End;

  Move(Mem[DosSegment*16],VESAInfoBlok,SizeOf(VESAInfoBlok));
  VelikostVideoRAM := VESAInfoBlok.CelkovaPamet*65536;  {Prepocet na Byty}
  Writeln('Velikost videopameti: ',VelikostVideoRAM div 1024,'kB');
(*
  Asm
   XOR EAX,EAX
   MOV AX,DosSegment
   SHL EAX,4
   MOV BX,[EAX].TVESAInfoBlok.CelkovaPamet
   SHL EBX,16
   MOV VelikostVideoRam,EBX
  End;
*)

  {Z VESA informaci o zvolenem modu bude pro LFB dulezita fyzicka adresa video}
  {pameti. Pokud bude nulova, tak LFB pro tento mod nelze pouzit nebo verze}
  {VESA BIOS neni 2.0+}
  ClearRmRegs(RealRegs);
  RealRegs.AX := $4F01;
  RealRegs.CX := PozadovanyMod;    {Vybrany mod pro LFB}
  RealRegs.ES := DosSegment;
  RealRegs.DI := 00;
  If Not RealModeInt($10,RealRegs) Then
    Begin
      Writeln('Chyba DPMI pri volani sluzby BIOSu');
      Halt(0);
    End;

  Move(Mem[DosSegment*16],VESAInfoMode,SizeOf(VESAInfoMode));
  FyzickaAdresaVideoRAM := VESAInfoMode.FyzickaAdresa;
  Writeln('Fyzicka adresa videopameti: ',IntToHex(FyzickaAdresaVideoRAM,8));

(*
  Asm
   XOR EAX,EAX
   MOV AX,DosSegment
   SHL EAX,4
   MOV EBX,[EAX].TVESAInfoMode.FyzickaAdresa
   MOV FyzickaAdresaVideoRAM,EBX
  End;
*)

  If FyzickaAdresaVideoRAM = 0 Then
    Begin
      Writeln('Chyba : LFB pro tento mod neni podporovan');
      Halt(0);
    End;

  {Fyzicka adresa video pameti a jeho velikost umozni tuto pamet namapovat}
  {pomoci DPMI funkce 800h. Vysledkem je linearni adresa, kterou muzem adresovat.}
  LinearniAdresaVideoRAM := MapPhysicalToLinear(FyzickaAdresaVideoRAM,VelikostVideoRAM);
  Writeln('Linearni adresa videopameti: ',IntToHex(LinearniAdresaVideoRAM,8));

  {V tuto chvili jiz mohu uvolnit alokovanou pamet pomoci DPMI funkce 101h}
  If Not DosMemoryFree(DosSegment) Then
    Begin
      Writeln('Chyba DPMI pri uvolnovani pameti');
      Halt(0);
    End;

  {Nyni staci nastavit graficky mod s LFB. LFB se voli bitem 14, ktery ma}
  {hodnotu 1. Takze staci orovat pozadovany mod ciselnou hodnotou 4000h}
  Writeln;
  Writeln('Enter pro pokracovani...');
  Readln;
  Asm
    MOV AX,4F02h
    MOV BX,PozadovanyMod
    OR  BX, 4000h             {Pozadovany mod OR 4000h pro LFB}
    INT 10h
  End;

  {A to je vse, uvedeny kratky kod zobrazi 4 body}
  Asm
    MOV EDI,LinearniAdresaVideoRAM
    MOV AL,White
    MOV [EDI],AL               {pixel v hornim levem rohu}
    MOV [EDI+640*400-1],AL     {pixel v dolnim pravem rohu}
    MOV [EDI+640-1],AL         {pixel v hornim pravem rohu}
    MOV [EDI+640*399],AL       {pixel v dolnim levem rohu}
    MOV [EDI+640*400/2+320],AL {pixel uprostred}
  End;
  {bez assembleru}
  For Y:=100 to 150 do
  For X:=100 to 150 do
       Byte(Pointer(LinearniAdresaVideoRAM+X+Y*640)^):=White;
      {Mem[LinearniAdresaVideoRAM+X+Y*640]:=White;}

  Repeat Until KeyPressed;
End.