{$ASMMODE Intel}
{$MODE FPC}
{**********************************************************}
{*    Vypotil    : BENN,  benn2@seznam.cz                 *}
{*    Vypoceno v : FreePascal 0.9.2 IDE DOS target GO32V2 *}
{**********************************************************}
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,Go32;

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  DosAddr                    :Longint;
     DosSegment                 :Word;
     DosSelector                :Word;

     RealRegs                   :TRealRegs;
     VESAInfoBlok               :TVESAInfoBlok;
     VESAInfoMode               :TVESAInfoMode;

     VelikostVideoRAM           :Longint;
     FyzickaAdresaVideoRAM      :Longint;
     LinearniAdresaVideoRAM     :Longint;
     LFBPointer                 :Pointer;

     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}
  DosAddr     := Global_DOS_Alloc(256);
  DosSegment  := Word(DosAddr shr 16);
  DosSelector := Word(DosAddr);

  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}

  FillChar(RealRegs,SizeOf(RealRegs),0);    {Nulovani}
  RealRegs.AX := $4F00;
  RealRegs.ES := DosSegment;
  RealRegs.DI := 00;
  If Not RealIntr($10,RealRegs) Then
    Begin
      Writeln('Chyba DPMI pri volani sluzby BIOSu');
      Halt(0);
    End;

  DosMemGet(DosSegment,00,VESAInfoBlok,SizeOf(VESAInfoBlok));
  VelikostVideoRAM := VESAInfoBlok.CelkovaPamet*65536;  {Prepocet na byty}
  Writeln('Velikost videopameti: ',VelikostVideoRAM div 1024,'kB');

  {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+}

  FillChar(RealRegs,SizeOf(RealRegs),0);
  RealRegs.AX := $4F01;
  RealRegs.CX := PozadovanyMod;    {Vybrany mod pro LFB}
  RealRegs.ES := DosSegment;
  RealRegs.DI := 00;
  If Not RealIntr($10,RealRegs) Then
    Begin
      Writeln('Chyba DPMI pri volani sluzby BIOSu');
      Halt(0);
    End;

  DosMemGet(DosSegment,00,VESAInfoMode,SizeOf(VESAInfoMode));
  FyzickaAdresaVideoRAM := VESAInfoMode.FyzickaAdresa;
  Writeln('Fyzicka adresa videopameti: ',HexStr(FyzickaAdresaVideoRAM,8),'h');

  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.}
  LinearniAdresaVideoRAM := Get_Linear_Addr(FyzickaAdresaVideoRAM,VelikostVideoRAM);
  Writeln('Linearni adresa videopameti: ',HexStr(LinearniAdresaVideoRAM,8),'h');

  {Od linearni adresy odecteme bazovou adresu datoveho deskriptoru }
  LFBPointer:=Pointer(LinearniAdresaVideoRAM-Get_Segment_Base_Address(Get_DS));

  {Zvetsime limit datoveho deskriptoru, pokud je maly}
  If DWord(LFBPointer)+VelikostVideoRAM-1 > DWord(Get_Segment_Limit(Get_DS)) then
       Set_Segment_Limit(Get_DS,DWord(LFBPointer)+VelikostVideoRAM-1);


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

  Writeln;
  Writeln('Enter pro pokracovani...');
  Readln;
  {Nyni staci nastavit graficky mod s LFB. LFB se voli bitem 14, ktery ma}
  {hodnotu 1. Takze staci orovat pozadovany mod ciselnou hodnotou 4000h}
  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 dva body v protejsich rozich obrazovky}
  Asm
    MOV EDI,LFBPointer
    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;

  {Nebo bez assembleru}
  For Y:=100 to 150 do
  For X:=100 to 150 do PByte(LFBPointer+X+Y*640)^:=White;

  Repeat until KeyPressed;
  TextMode(C80);
End.