{$O+,F+,R-,S-}
UNIT VideoBIOS;


INTERFACE

const
  VideoBiosInt=$10;

 { main video functions AH}
  viCharGenerator=$11;
  viSetVideoMode =$00;
  viGetVideoMode =$0F;
  viSetCursorCharacteristics=$01;
  viSetCursorPos =$02;
  viReadCursorPos=$03;
  viSelectVideoPage=$05;

 { AH:=viCharGenerator - sub video functions AL }
  viGetFontInfo=$30;
  viLoadUserGraphFont=$21;
  viLoadUserTextFont=$10;   {с перерасчетом значений видеопараметров (число строк, буфер и т.п.)}
  viReLoadUserTextFont=$00; {без перерасчета значений видеопараметров}

  viBlinkBitOff=$EF;

  ft8x8size=8;
  ft8x14size=14;
  ft8x16size=16;

  viMaxTextRows=50;
  viDoNotClearVideoBuffer=$80;

type
  TFont=(ft1F, ft43, ft8x14, ft8x8, ft8x8top, ft9x14, ft8x16, ft9x16,
	 ftUnknown);
  FontsSet=set of TFont;

  TCharImage8x8= array[1..ft8x8Size ] of byte;
  TCharImage8x14=array[1..ft8x14Size] of byte;
  TCharImage8x16=array[1..ft8x16Size] of byte;

  Table8x8 = array[Char] of TCharImage8x8;
  Table8x8top = array[128..255] of TCharImage8x8;
  Table8x14= array[Char] of TCharImage8x14;
  Table8x16= array[Char] of TCharImage8x16;

  Table8x8ptr  = ^Table8x8;
  Table8x14ptr = ^Table8x14;
  Table8x16ptr = ^Table8x16;

const
  CFont8x8TableSize=SizeOf(Table8x8);
  CFont8x8topTableSize=SizeOf(Table8x8top);
  CFont8x14TableSize=SizeOf(Table8x14);
  CFont8x16TableSize=SizeOf(Table8x16);

procedure SetVideoMode(mode:byte);
function VideoMode:byte;
function ColumnsOnScreen:byte;
function VideoPage:byte;

function LoadTextFont(FontPtr:pointer; CountToStore,CharOfs:word;
		      BlockToLoad,BytesPerChar:byte; Recalc:boolean):byte;

function LoadGraphFont(FontPtr:pointer; BytesPerChar:word; Rows:byte):byte;

procedure xLoadTxtFont(FontPtr:pointer;
		      FirstChar,CharNumber,BytePerChar,MaxBytesPerChar:Byte);
function LoadTxtFont(font:TFont; BlockToLoad:byte; Recalc:boolean):byte;
function LoadGrFont(font:TFont):byte;
function LoadFont(font:TFont; Recalc:boolean):byte;
procedure ReLoadFont;

procedure ResetVideoMode(ClearBuffer:boolean);

procedure GetFontInfo(font:TFont;
		      var FontPtr:pointer;
		      var BytesPerChar:word;
		      var Rows:byte);

function GetFontPtr(font:TFont):pointer;
function Font:TFont;

function GetCharImageSize(font:TFont):byte;

function EgaPresent:boolean;
function VgaPresent:boolean;

function FontTableSize(font:TFont):word;

function GraphicsMode:boolean; {!!!???}
function IsGraphicsMode:boolean; { вроде бы безопасная и надежная функция }

function IsTextVideoMode(Mode:byte):boolean;
function IsPresentVideoModeText:boolean;

procedure SelectVideoPage(pg:byte);

IMPLEMENTATION
  USES BiosData;


procedure Video; near; assembler;
asm
  PUSH	SI
  PUSH	DI
  PUSH	BP
  PUSH	ES
  INT	10H
  POP	ES
  POP	BP
  POP	DI
  POP	SI
end;

type
  TAlphaSet=object(TAlphaCharacterSetOverride)
    Mode,StopByte:byte;
  end;

  TGraphSet=object(TGraphicsCharacterSetOverride)
    Mode,StopByte:byte;
  end;

function IsTextVideoMode(Mode:byte):boolean;
{ Mode - видео режим для определения. Присваивается AL и вызывается Int 10h.
  Возвращает: True - если графическая мода.
	Разрушающая изображение и текущий видеорежим функция.
}
assembler;
var
  OldSetsPtrs:array[0..1] of pointer;
  AlphaTable:TAlphaSet;
  GraphTable:TGraphSet;

asm
  push ds

  mov al,Mode
  mov ah,0FFh
  mov word(AlphaTable.Mode),ax
  mov word(GraphTable.Mode),ax

  or Mode,(1 shl 7);

    { Заполнение таблиц подстановки шрифтов }

     mov AlphaTable.LengthOfChar,8;
     mov AlphaTable.BankToLoad,0
     mov AlphaTable.NumberOfChar,0
     mov AlphaTable.FirstChar,0;
     mov AlphaTable.Rows,24
     push ft8x8; call GetFontPtr;
     mov word(AlphaTable.FontTablePtr),ax
     mov word(AlphaTable.FontTablePtr)[2],dx

     mov GraphTable.Rows,24
     mov GraphTable.LengthOfChar,14
     push ft8x14; call GetFontPtr;
     mov word(GraphTable.FontTablePtr),dx
     mov word(GraphTable.FontTablePtr)[2],ax

    { Переопределение указателей на таблицы подстановки для шрифтов }
    mov	ds,Seg0040
    push ds
    lds si,DataOfBios([0]).VideoSaveTablePtr
    add si,OFFSET TVideoSaveTable.AlphaCharSetPtr
    lea di,OldSetsPtrs; push ss; pop es;
    push ds; push si; push di
    mov bx,-2
    pushf; cli;
      movsw;
      lea ax,AlphaTable
      mov word([si][bx]),ax
      movsw;
      mov [si][bx],ss
      movsw;
      lea ax,GraphTable
      mov word([si][bx]),ax
      movsw;
      mov [si][bx],ss
    {sti}
    popf

    mov al,Mode; xor ah,ah
    call Video

    pop si; pop di; pop es; push ss; pop ds;
    pushf; cld; cli; movsw; movsw; movsw; movsw; {sti} popf

    pop ds

    xor al,al
    cmp DataOfBios([0]).VideoCharacterHeightInScanLines,8;
    jne @GraphModeDetected

  @TextModeDetected:
    inc al

  @GraphModeDetected:

  pop ds
end;

(*function IsTextMode(Mode:byte):boolean;
{ Mode - видео режим для определения. Присваивается AL и вызывается Int 10h.
  Возвращает: True - если графическая мода.
	Разрушающая изображение функция.
}
const ModeTypes:set of Byte=[];

var tm:boolean; md:byte;
begin
  md:=Mode shl 1;
  if md in ModeTypes then begin
    IsTextMode:=not Succ(md) in ModeTypes;
  end else begin
    tm:=IsTextVideoMode(Mode);
    IsTextMode:=tm;
    Include(ModeTypes, md);
    if not tm then Include(ModeTypes, Succ(md));
  end;
end;
*)

function IsPresentVideoModeText:boolean;
  var mode:word;
begin
(*  asm
    { сохранение характеристик: положения курсора и т.п.}
    call VideoMode;
    and ax,($FF xor viDoNotClearVideoBuffer); mov mode,ax
    push bx
    mov ah,viReadCursorPos
    call Video
    push cx; push bx; push dx
  end;*)
  IsPresentVideoModeText:=IsTextVideoMode(VideoMode);
(*  asm
    { восстановление характеристик курсора }
    push mode; call SetVideoMode
    pop dx; pop bx
    mov ah,viSetCursorPos
    call Video
    pop cx; mov ax,mode
    mov ah,viSetCursorCharacteristics
    call Video
    pop ax; mov al,ah; push ax; call SelectVideoPage
  end;*)
end;

procedure GetCursor; near; assembler;
asm
  call VideoPage
  MOV	AH,viReadCursorPos
  jmp   Video
end;

function GetTextAttribute:byte; assembler;
asm
  call  VideoPage
  MOV	AH,8
  CALL	Video
  MOV	AL,AH
  AND	AL,7FH
end;

{ Загрузка знакогенератора текстовых режимов }
procedure xLoadTxtFont(FontPtr:pointer;
		      FirstChar,CharNumber,BytePerChar,MaxBytesPerChar:Byte);
assembler;
asm
  mov bl,CharNumber; or bl,bl; jz @End
  mov al,bl; add al,FirstChar; jc @End
  mov cl,BytePerChar; xor ch,ch; jcxz @End
  mov dl,MaxBytesPerChar; or dl,dl; jz @End
  cmp cl,dl; ja @End
  push ds
  lds si,FontPtr;
  mov ax,$A000; mov es,ax;
  xor dh,dh; mov ax,dx; mul FirstChar; mov di,ax
  mov ax,cx; sub dl,cl
  cld
    @Loop:
      mov cx,ax;
      rep movsb
      add di,dx
      dec bl
    jnz @Loop
  pop ds
  @End:
end;

{----------101130-----------------------------
INT 10 - VIDEO - GET FONT INFORMATION (EGA, MCGA, VGA)
	AX = 1130h
	BH = pointer specifier
	    00h INT 1Fh pointer
	    01h INT 44h pointer
	    02h ROM 8 by 14 character font pointer
	    03h ROM 8 by 8 double dot font pointer
	    04h ROM 8 by 8 DD font (top half)
	    05h ROM alpha alternate (9 by 14) pointer
Return: ES:BP = specified pointer
	CX    = bytes/character
	DL    = character rows on screen
}
procedure GetFontInfo(font:TFont;
		      var FontPtr:pointer;
		      var BytesPerChar:word;
		      var Rows:byte);
assembler;
asm
  push bp
  mov ax,$1130
  mov bh,font
  int $10
  mov bx,es
  mov ax,bp
  pop bp
  cld
  les di,FontPtr
  stosw; mov ax,bx; stosw
  les di,BytesPerChar
  mov ax,cx; stosw
  les di,Rows
  mov al,dl; stosb
end;

function GetFontPtr(font:TFont):pointer;
assembler;
asm
  push bp
  mov ax,1130h; mov bh,font
  int $10
  mov dx,es; mov ax,bp
  pop bp
end;

function EgaPresent:boolean;
assembler;
asm
  mov ax,BiosDataSeg
  mov es,ax
  mov al,es:DataOfBios([BiosDataOfs]).VideoEgaVgaControl
  or al,al; jz @End
    and al,evEgaVgaInactive; jnz @NotActive
    mov al,True
  ret
  @NotActive:
    xor al,al
  @End:
end;

function VgaPresent:boolean;
assembler;
 const
   VgaActive=(1 shl Ord(mvVgaActive));
asm
  push cs
  call near(EgaPresent)
  or al,al; jz @End
    test es:DataOfBios([BiosDataOfs]).VideoMCgaVgaModeSetOptionControl,VgaActive
    jnz @End
      xor al,al
  @End:
end;

function GetCharImageSize(font:TFont):byte;
assembler;
asm
  mov al,font
  cmp al,ft8x14;    je @14
  cmp al,ft8x16;    je @16
  cmp al,ft8x8top;  jbe @8
  xor al,al; jmp @end
    @8 : mov al,ft8x8size; jmp @End;
    @14: mov al,ft8x14size; jmp @End;
    @16: mov al,ft8x16size;
  @End:
end;

function FontTableSize(font:TFont):word;
assembler;
asm
  mov al,font
  cmp al,ft8x14;    je @14
  cmp al,ft8x16;    je @16
  cmp al,ft8x8;     je @8
  cmp al,ft8x8top;  je @8top
  xor ax,ax; jmp @End
    @8 : mov ax,CFont8x8TableSize; jmp @End;
    @8top : mov ax,CFont8x8topTableSize; jmp @End;
    @14: mov ax,CFont8x14TableSize; jmp @End;
    @16: mov ax,CFont8x16TableSize;
  @End:
end;

function GraphicsMode:boolean; { Внимание! здесь надо бы разобраться }
{begin
  GraphicsMode:=not IsPresentVideoModeText;
end;}
assembler;
asm
  mov ax,BiosDataSEG; mov es,ax
   mov al,es:DataOfBios([0]).VideoRowsOnScreenMinusOne; xor ah,ah; add ax,2
   mul es:DataOfBios([0]).VideoColumnsOnScreen
   or dx,dx; jnz @GraphMode
   mov bx,es:DataOfBios([0]).VideoPageSize
   cmp ax,bx; ja @TextMode
   shr bx,1; cmp ax,bx; jae @TextMode
   shr bx,1; cmp ax,bx; jb @GraphMode

   mov ax,es:DataOfBios([0]).VideoCursorType;
   or al,al; jz @GraphMode; or ah,ah; jz @GraphMode
  @TextMode:
    xor al,al
  ret
  @GraphMode:
    mov al,TRUE; or al,al
end;

function IsGraphicsMode;
{ Возвращает: FALSE; изменяет: AX, CX, DX}
assembler;
asm
  push bx
  mov al,0FFh
  call near(@Int10)
  not al; or al,al; jnz @GraphMode

  xor al,al
  call near(@Int10)
  or al,al; jnz @GraphMode

  @TextMode: mov al,FALSE; jmp @End
  @GraphMode: mov al,TRUE; jmp @End

    @Int10:
      mov ah,0Dh {ah=0Dh - read pixel from screen }
      xor bh,bh  {= page number}
      mov CX,1   { = column}
      mov DX,CX  {= row}
      int 10h
    retn

  @End:
  pop bx
end;


function Font:TFont;
assembler;
asm
  mov ax,BiosDataSEG; mov es,ax;
  mov ax,es:DataOfBios([BiosDataOfs]).VideoCharacterHeightInScanLines
  push cs; pop es; mov di,OFFSET @FontsSize; mov cx,3
  cld; repne scasb; jne @Unknown
  add di,2; mov al,es:[di]
ret
  @FontsSize: db 8, 14, 16
  @Fonts:     db ft8x8, ft8x14, ft8x16

@Unknown:
  mov al,ftUnknown
end;

function Rows:byte;
assembler;
asm
  mov ax,BiosDataSEG; mov es,ax
  mov al,es:DataOfBios([BiosDataOfs]).VideoRowsOnScreenMinusOne
end;

function VideoMode:byte;
assembler;
asm
  mov ah,viGetVideoMode
  call Video
end;

procedure SetVideoMode(mode:byte);
assembler;
asm
  mov ah,viSetVideoMode
  mov al,mode
  call Video
end;

function VideoPage:byte;
assembler;
asm
  call VideoMode; mov al,bh
end;

procedure SelectVideoPage(pg:byte);
assembler;
asm
  mov ah,05h
  mov al,pg
  int 10h
end;

function LoadTextFont(FontPtr:pointer; CountToStore,CharOfs:word;
		      BlockToLoad,BytesPerChar:byte; Recalc:boolean):byte;
assembler;
asm
  push bp
  mov cx,CountToStore; mov dx,CharOfs
  mov bl,BlockToLoad; mov bh,BytesPerChar
  mov al,0
  cmp Recalc,False; je @Cont
    mov al,10h
  @Cont:
  les bp,FontPtr
  mov ah,11h
  call Video
  pop bp
end;

function LoadGraphFont(FontPtr:pointer; BytesPerChar:word; Rows:byte):byte;
assembler;
asm
  push bp
  mov cx,BytesPerChar; xor bl,bl; mov dl,Rows
  mov ax,1121h
  les bp,FontPtr
  call Video
  pop bp
end;

function LoadTxtFont(font:TFont; BlockToLoad:byte; Recalc:boolean):byte;
assembler;
asm
  push word(font); call GetFontPtr; push dx; push ax
  mov ax,word(font); mov bx,256; xor dx,dx
  push cs; pop es; mov di,OFFSET @Top; mov cx,2
  cld; repne scasb; jne @Cont
    shr bx,1; mov dx,bx
  @Cont:
  push bx; push dx; push word(BlockToLoad);
  push ax; call GetCharImageSize; xor ah,ah; push ax
  push word(Recalc);
  call LoadTextFont
  jmp @End
    @Top: db ft1F, ft8x8top
  @End:
end;

function LoadGrFont(font:TFont):byte;
assembler;
asm
  push cs; pop es; mov di,OFFSET @Top; mov cx,2
  mov al,font;
  cld; repne scasb; je @Error
  push word(font); call GetFontPtr; push dx; push ax
  push word(font); call GetCharImageSize; xor ah,ah; push ax
  call Rows; xor ah,ah; push ax
  call LoadGraphFont
  jmp @End
    @Top: db ft1F, ft8x8top
  @Error: mov al,0FFh
  @End:
end;

function LoadFont(font:TFont; Recalc:boolean):byte;
assembler;
asm
  push word(font);
  call GraphicsMode; or al,al; jz @TextLoad
    call LoadGrFont
  jmp @End
  @TextLoad:
     xor ax,ax; push ax; push word(Recalc)
     call LoadTxtFont
  @End:
end;

procedure ReLoadFont;
assembler;
asm
  call VideoMode; push ax
  mov ah,viReadCursorPos
  call Video
  push cx; push bx; push dx
  call Font;
  push ax; mov ax,FALSE; push ax; call LoadFont
  pop dx; pop bx
  mov ah,viSetCursorPos
  call Video
  pop cx; pop ax
  mov ah,viSetCursorCharacteristics
  call Video
end;

procedure ResetVideoMode(ClearBuffer:boolean);
assembler;
  var mode:word;
asm
  call VideoMode;
  and ax,($FF xor viDoNotClearVideoBuffer); mov mode,ax
  push bx
  mov ah,viReadCursorPos
  call Video
  push cx; push bx; push dx
  cmp ClearBuffer,FALSE; jne @Cont
    or mode,viDoNotClearVideoBuffer
  @Cont:
  push mode; call SetVideoMode
  pop dx; pop bx
  mov ah,viSetCursorPos
  call Video
  pop cx; mov ax,mode
  mov ah,viSetCursorCharacteristics
  call Video
  pop ax; mov al,ah; push ax; call SelectVideoPage
end;

function ColumnsOnScreen:byte;
assembler;
asm
  call VideoMode; mov al,ah
end;

END.