(* ================================================================ *)
(*       EGA/VGA-BIOS-Aufrufe und -Variablen (Kapitel 5...9)        *)
(*           (C) 1990 Matthias Uphoff & Addison Wesley              *)
(* ================================================================ *)

UNIT EVBios;

INTERFACE

{$ifdef unix}
uses vbios;
{$endif}

CONST SingleFrame = #201#205#187#186#186#200#205#188;
      DoubleFrame = #218#196#191#179#179#192#196#217;

      (* Konstanten für die Zusammenstellung von Palettenwerten: *)
      PBlue = 1;          (* Farbwert für primäres Blau   *)
      PGreen = 2;         (* Farbwert für primäres Grün   *)
      PRed = 4;           (* Farbwert für primäres Rot    *)
      SBlue = 8;          (* Farbwert für sekundäres Blau *)
      SGreen = 16;        (* Farbwert für sekundäres Grün *)
      SRed = 32;          (* Farbwert für sekundäres Rot  *)

      (* Konstanten für das Retten des VGA-Videostatus: *)
      VRegs = 1;      (* Bit 0: Videoregisterinhalte *)
      VData = 2;      (* Bit 1: Video-Datenbereiche *)
      DACRegs = 4;    (* Bit 2: DAC- und Farbregister *)

TYPE FrameStr = String[8];        (* Stringtyp für Rahmenart *)
        (* Arraytyp für 16 Paletten- und einen Overscan-Wert: *)
     PalType = PalTable;
        (* Der Farbwert: *)
     ColorValue=ARRAY[0..2]OF byte;
        (* Die EGA/VGA-Zeichensätze als Aufzählungstyp: *)
     FontName = (INT1F, INT43, ROM8x14, ROM8x8, ROM8x8Hi,
                 ROM9x14, ROM8x16, ROM9x16);
        (* 0 = INT1F    = 2. Hälfte des 8x8-CGA-Grafikfonts     *)
        (* 1 = INT43    = aktueller Font für EGA/VGA-Grafikmodi *)
        (* 2 = ROM8x14  = ROM 8x14-Font                         *)
        (* 3 = ROM8x8   = ROM 8x8-Font                          *)
        (* 4 = ROM8x8Hi = ROM 2. Hälfte des 8x8-Fonts           *)
        (* 5 = ROM9x14  = ROM 9x14-Ersatzzeichen                *)
        (* 6 = ROM8x16  = ROM 8x16-Font, nur VGA                *)
        (* 7 = ROM9x16  = ROM 9x16-Ersatzzeichen, nur VGA       *)

     PosType = RECORD x,y: Byte; END;   (* Cursorposition Spalte/Zeile: *)

VAR CursorChar: Char;    (* Zeichen für Grafikcursor *)

{$ifndef unix}
       (* Der BIOS-Variablenbereich: *)
    VideoMode: Byte ABSOLUTE 0:$449;    (* aktueller Videomodus *)
    NrOfColumns: Word ABSOLUTE 0:$44A;  (* darstellbare Textspalten *)
    PageSize: Word ABSOLUTE 0:$44C;     (* Bildseitengröße *)
    PageStart: Word ABSOLUTE 0:$44E;    (* Offsetadresse Bildseite *)
    CursorPos: ARRAY[0..7] OF PosType ABSOLUTE 0:$450;
    CursorStart: Byte ABSOLUTE 0:$460;  (* Erste Cursorrasterzeile *)
    CursorEnd: Byte ABSOLUTE 0:$461;    (* Letzte Cursorrasterzeile *)
    ActivePage: Byte ABSOLUTE 0:$462;   (* Aktive Bildseite *)
    CRTCPort: Word ABSOLUTE 0:$463;     (* CRTC-Portadresse *)
    NrOfRows: Byte ABSOLUTE 0:$484;     (* Textzeilen - 1 *)
    CharSize: Word ABSOLUTE 0:$485;     (* aktuelle Zeichenhöhe - 1 *)
    StatusBits: Byte ABSOLUTE 0:$487;   (* Diverse Statusinfos *)
    ConfigBits: Byte ABSOLUTE 0:$488;   (* DIP-Schalterstellung *)
    SaveTablePtr: Pointer ABSOLUTE 0:$4A8;  (* Save Table Pointer *)
{$endif}

(* ----------------------- Hilfsprozeduren ------------------------ *)

{$ifndef unix}
function getvideoseg:word;
procedure FillWord(var Dest; Count: Word; Data: Word);
{$endif}

(* ----------------- Die Prozeduren aus Kapitel 5 ----------------- *)

{$ifndef unix}
procedure SetVideoMode(mode:word);inline($58/$b4/$00/$cd/$10);
   (* Setzt den Videomodus mode *)
{$endif}

PROCEDURE WriteCAXY(x,y:byte;ch: Char; Attr: Byte; Count: Word;Page: Byte);
(* ---------------------------------------------------------- *)
(* Setzt die Cursorposition der Seite Page auf (x;y) und gibt *)
(* dort Count mal das Zeichen Ch in der Farbe Attr aus        *)
(* ---------------------------------------------------------- *)

PROCEDURE GraphCursor;
   (* Läßt in den Grafikmodi an der aktuellen Cursorposition der *)
   (* Seite 0 einen Cursor erscheinen bzw. wieder verschwinden,  *)
   (* falls schon vorhanden. (Nicht für 256-Farben-Modus)        *)

PROCEDURE ShowPage(Page: Byte);
   (* Aktiviert die Bildseite mit der Nummer Page *)

PROCEDURE ScrollUp(x1,y1,x2,y2:byte;Lines:integer;Attr: Byte);
   (* ----------------------------------------------------------- *)
   (* Scrollt einen Bildschirmauschnitt auf der aktiven Bildseite *)
   (* um Lines Textzeilen nach oben.                              *)
   (* x1,y1 = links oben, x2,y2 = rechts unten in Textkoordinaten *)
   (* Neuen Zeilen werden mit dem Attribut/der Farbe Attr gefüllt *)
   (* Bei Lines = 0 wird das gesamte Fenster gelöscht             *)
   (* ----------------------------------------------------------- *)

PROCEDURE BPlot(x,y: Word; Color, Page: Byte);
   (* Setzt einen Punkt auf Bildseite Page   *)
   (* an der Position x,y in der Farbe Color *)

FUNCTION BDotColor(x,y: Word; Page: Byte): Byte;
   (* Gibt die Farbe des Punktes an der      *)
   (* Position x,y der Bildseite Page zurück *)

PROCEDURE Frame(fs: FrameStr; x1,y1,x2,y2,Attr,Page: Byte);
   (* Zeichnet einen Rahmen auf Bildseite Page mit den *)
   (* in fs enthaltenen Zeichen und dem Attribut Attr  *)
   (* x1,y1 liegt links oben, x2,y2 rechts unten       *)
   (* x1,y1 = links oben, x2,y2 = rechts unten         *)

PROCEDURE WriteString(st: String; x, y, Color: Byte);
   (* Schreibt in den Grafikmodi einen String an die Textposition *)
   (* x,y der Seite 0 mit der Vordergrundfarbe ForeColor und der  *)
   (* Hintergrundfarbe BackColor. Seite 0 muß aktiv sein!         *)
   (* Funktioniert nicht im 256-Farben-Modus (siehe 5.4)          *)

(* ----------------- Die Prozeduren aus Kapitel 6 ----------------- *)

{$ifndef unix}
PROCEDURE SetColorReg(RegNr: Word; Color: ColorValue);
   (* Schreibt in das Farbregister RegNr den Farbwert Color *)
{$endif}

(* ----------------- Die Prozeduren aus Kapitel 7 ----------------- *)

PROCEDURE UserTextFont(BlockNr, Size: Byte; NrOfChar, FirstChar: Word;
                       Adjust: Boolean; VAR MTable);
   (* Selbstdefinierte Textmodus-Zeichen installieren *)
   (* BlockNr:   Nummer des Ziel-Speicherblocks       *)
   (* Size:      Zeichenhöhe in Rasterzeilen          *)
   (* NrOfChar:  Anzahl der neuen Zeichen             *)
   (* FirstChar: Erstes zu änderndes Zeichen          *)
   (* Adjust:    Zeilenanpassung ja/nein              *)
   (* MTable:    Array mit Zeichenmatritzen           *)
FUNCTION GetCharSize: Word;
   (* Gibt die aktuelle Zeichenhöhe zurück *)
{$ifndef unix}
PROCEDURE DefChar(CharNr: Byte; VAR MTable);
   (* Installiert unter der Zeichennummer CharNr die in *)
   (* MTable enthaltene Matrix im Bildspeicherblock 0   *)
{$endif}
PROCEDURE SelectBlock(BlockA, BlockB: Byte);
   (* Selektiert die Zeichensatz-Speicherblöcke         *)
   (* BlockA = BlockB: Ein Font aktiv (256 Zeichen)     *)
   (* BlockA <> BlockB: Zwei Fonts aktiv (512 Zeichen)  *)
PROCEDURE UserGraFont(Size: Word; Rows: Byte; VAR MTable);
   (* Userzeichensatz für Grafikmodi installieren *)
   (* Size:   Zeichenhöhe in Rasterzeilen         *)
   (* Rows:   Anzahl Bildschirm-Textzeilen        *)
   (* MTable: Array mit Zeichenmatritzen          *)
FUNCTION FontAddr(Font: FontName): Pointer;
   (* Gibt Zeiger auf (ROM-)Zeichensatz zurück *)

(* -------------------- Ergänzung aus Anhang A -------------------- *)
{$ifndef unix}
FUNCTION LoadFont(FileName: String; VAR MTable): Integer;
   (* Lädt die Fontdatei Filename in die     *)
   (* Variable MTable. Rückgabewerte:        *)
   (*   0: Datei konnte nicht geladen werden *)
   (*  -1: Falsches Dateiformat              *)
   (* > 0: Dateigröße in Bytes               *)
{$endif}

(* ================================================================ *)

IMPLEMENTATION

{$ifndef unix}
USES Dos;
{$else}
uses xcrt,rom8x8;

procedure nimp;
begin
	writeln('not implemented');
	halt;
end;

{$endif}

{$ifndef unix}
function getvideoseg:word;
begin
 case videomode of
  0..6:getvideoseg:=$b800;
  7:getvideoseg:=$b000;
 else
  getvideoseg:=$a000;
 end;
end;
{$endif}

procedure FillWord(var Dest; Count: Word; Data: Word);
{$ifndef unix}
begin
  inline(
    $C4/$7E/<Dest/   { LES   DI,Dest[BP]  }
    $8B/$4E/<Count/  { MOV   CX,Count[BP] }
    $8B/$46/<Data/   { MOV   AX,Data[BP]  }
    $FC/             { CLD                }
    $F3/$AB);        { REP   STOSW        }
{$else}
var
	d:^aword;
	i:integer;
begin
	d:=@Dest;
	for i:=1 to count do d^[i-1]:=Data;
{$endif}
end;

(* ----------------- Die Prozeduren aus Kapitel 5 ----------------- *)

FUNCTION GetVideoMode: Byte;
{$ifndef unix}
VAR R: Registers;
BEGIN
  R.AH := $F;            (* Funktionsnummer nach AH *)
  Intr($10,R);           (* BIOS-Aufruf über Interrupt 10h *)
  GetVideoMode := R.AL AND $7F;   (* Modus wird in AL zurückgegeben *)
{$else}
begin
	return VideoMode;
{$endif}
END;

PROCEDURE WriteCAXY(x,y:byte;ch: Char; Attr: Byte; Count: Word;Page: Byte);
BEGIN
 setcursorxy(x,y,page);
 Writeca(ch,attr,count,page);
END;

PROCEDURE GraphCursor;
BEGIN
  WriteCA(CursorChar,$8F,1,0);  (* Farbbit 7 = 1 für XOR-Modus *)
END;

PROCEDURE ShowPage(Page: Byte);
(* ------------------------------------------- *)
(* Aktiviert die Bildseite mit der Nummer Page *)
(* ------------------------------------------- *)
{$ifndef unix}
   VAR R: Registers;
BEGIN
  R.AH := 5;       (* Funktionsnummer *)
  R.AL := Page;    (* Nummer der Bildseite *)
  Intr($10,R);     (* BIOS-Aufruf *)
{$else}
begin
  setvideopage(page);
{$endif}
END;

PROCEDURE ScrollUp(x1,y1,x2,y2:byte;Lines:integer;Attr: Byte);
(* ----------------------------------------------------------- *)
(* Scrollt einen Bildschirmauschnitt auf der aktiven Bildseite *)
(* um Lines Textzeilen nach oben.                              *)
(* x1,y1 = links oben, x2,y2 = rechts unten in Textkoordinaten *)
(* Neuen Zeilen werden mit dem Attribut/der Farbe Attr gefüllt *)
(* Bei Lines = 0 wird das gesamte Fenster gelöscht             *)
(* ----------------------------------------------------------- *)
{$ifndef unix}
   VAR R: Registers;
BEGIN
  R.AH := 6+lines shr 15;     (* Funktionsnummer *)
  R.AL := abs(Lines);         (* Anzahl Zeilen *)
  R.BH := Attr;               (* Farbe für neue Zeilen *)
  R.CH := y1; R.CL := x1;     (* Fensterkoordinaten *)
  R.DH := y2; R.DL := x2;
  Intr($10,R);
{$else}
begin
	ScrollUpDown(x1,y1,x2,y2,lines,attr,true);
{$endif}
END;

PROCEDURE BPlot(x,y: Word; Color, Page: Byte);
(* -------------------------------------- *)
(* Setzt einen Punkt auf Bildseite Page   *)
(* an der Position x,y in der Farbe Color *)
(* -------------------------------------- *)
BEGIN
{$ifndef unix}
  setpixel(x,y,Color,Page);
{$else}
	plot(x,y,color);
{$endif}
END;

FUNCTION BDotColor(x,y: Word; Page: Byte): Byte;
(* -------------------------------------- *)
(* Gibt die Farbe des Punktes an der      *)
(* Position x,y der Bildseite Page zurück *)
(* -------------------------------------- *)
BEGIN
	BDotColor:=GetPixel(x,y,page);
END;

PROCEDURE Frame(fs: FrameStr; x1,y1,x2,y2,Attr,Page: Byte);
(* ------------------------------------------------ *)
(* Zeichnet einen Rahmen auf Bildseite Page mit den *)
(* in fs enthaltenen Zeichen und dem Attribut Attr  *)
(* x1,y1 = links oben, x2,y2 = rechts unten         *)
(* in Textkoordinaten                               *)
(* ------------------------------------------------ *)
   VAR y: Byte;
BEGIN
  SetCursorXY(x1,y1,Page);             (* Ecke links oben *)
  WriteCA(fs[1],Attr,1,Page);
  IF x1+1 <= x2-1 THEN BEGIN           (* obere Linie *)
    SetCursorXY(x1+1,y1,Page);
    WriteCA(fs[2],Attr,x2-x1-1,Page);  (* BIOS-Wiederholfunktion! *)
  END;
  SetCursorXY(x2,y1,Page);             (* Ecke rechts oben *)
  WriteCA(fs[3],Attr,1,Page);
  FOR y := y1+1 TO y2-1 DO BEGIN       (* vertikale Linien *)
    SetCursorXY(x1,y,Page);
    WriteCA(fs[4],Attr,1,Page);
    SetCursorXY(x2,y,Page);
    WriteCA(fs[5],Attr,1,Page);
  END;
  SetCursorXY(x1,y2,Page);               (* Ecke links unten *)
  WriteCA(fs[6],Attr,1,Page);
  IF x1+1 <= x2-1 THEN BEGIN           (* untere Linie *)
    SetCursorXY(x1+1,y2,Page);
    WriteCA(fs[7],Attr,x2-x1-1,Page);  (* BIOS-Wiederholfunktion! *)
  END;
  SetCursorXY(x2,y2,Page);             (* Ecke rechts unten *)
  WriteCA(fs[8],Attr,1,Page);
END;

PROCEDURE WriteString(st: String; x, y, Color: Byte);
(* ----------------------------------------------------------- *)
(* Schreibt in den Grafikmodi einen String an die Textposition *)
(* x,y der Seite 0 mit der Vordergrundfarbe ForeColor und der  *)
(* Hintergrundfarbe BackColor. Seite 0 muß aktiv sein!         *)
(* Funktioniert nicht im 256-Farben-Modus (siehe 5.4)          *)
(* Benötigt WriteCA aus 5.2 und ScrollUp aus 5.6               *)
(* ----------------------------------------------------------- *)
  VAR i: Word;
  var forecolor,backcolor:byte;
BEGIN
  ForeColor := ((Color and $f) XOR (Color shr 4)) OR $80;
                                     (* Bit 7 = 1 für XOR-Ausgabe *)
  IF Length(st) > 0 THEN             (* Fläche unter String färben *)
    ScrollUp(x,y,x+Length(st)-1,y,0,(Color shr 4));
  FOR i := 1 TO Length(st) DO BEGIN
    SetCursorXY(x+i-1,y,0);          (* Textausgabeposition *)
    WriteCA(st[i],ForeColor,1,0);    (* Zeichen ausgeben *)
  END;
END;

(* ----------------- Die Prozeduren aus Kapitel 6 ----------------- *)

{$ifndef unix}
PROCEDURE SetColorReg(RegNr: Word; Color: ColorValue);
(* ----------------------------------------------------- *)
(* Schreibt in das Farbregister RegNr den Farbwert Color *)
(* ----------------------------------------------------- *)
   VAR R: Registers;
BEGIN
  R.AH := $10;            (* Funktionsnummer *)
  R.AL := $10;            (* Unterfunktionsnummer *)
  R.BX := RegNr;          (* Registernummer nach BX *)
  R.CH := Color[IGreen];   (* Grünanteil nach CH *)
  R.CL := Color[IBlue];    (* Blauanteil nach CL *)
  R.DH := Color[IRed];     (* Rotanteil nach DH *)
  Intr($10,R);            (* BIOS-Aufruf *)
END;
{$endif}

(* ----------------- Die Prozeduren aus Kapitel 7 ----------------- *)

PROCEDURE UserTextFont(BlockNr, Size: Byte; NrOfChar, FirstChar: Word;
                       Adjust: Boolean; VAR MTable);
(* ----------------------------------------------- *)
(* Selbstdefinierte Textmodus-Zeichen installieren *)
(* BlockNr:   Nummer des Ziel-Speicherblocks       *)
(* Size:      Zeichenhöhe in Rasterzeilen          *)
(* NrOfChar:  Anzahl der neuen Zeichen             *)
(* FirstChar: Erstes zu änderndes Zeichen          *)
(* Adjust:    Zeilenanpassung ja/nein              *)
(* MTable:    Array mit Zeichenmatritzen           *)
(* ----------------------------------------------- *)
{$ifndef unix}
  VAR R: Registers;
BEGIN
   R.AH := $11;          (* Funktionsnummer *)
   IF Adjust THEN        (* mit Textzeilenanpassung *)
     R.AL := $10           (* Unterfunktionsnummer *)
   ELSE                  (* ohne Textzeilenanpassung *)
     R.AL := $00;          (* Unterfunktionsnummer *)
   R.BL := BlockNr;      (* zu ladender Speicherblock *)
   R.BH := Size;         (* Höhe der Zeichen *)
   R.CX := NrOfChar;     (* Anzahl der Zeichen *)
   R.DX := FirstChar;    (* Nummer des 1. Zeichens *)
   R.ES := Seg(MTable);  (* Segmentadr. der Zeichenmatritzen *)
   R.BP := Ofs(MTable);  (* Offsetadr. der Zeichenmatritzen *)
   Intr($10,R);          (* BIOS-Aufruf *)
{$else}
begin
nimp;
{$endif}
END;

FUNCTION GetCharSize: Word;
(* ------------------------------------ *)
(* Gibt die aktuelle Zeichenhöhe zurück *)
(* ------------------------------------ *)
{$ifndef unix}
  VAR R: Registers;
BEGIN
  R.AH := $11;            (* Funktionsnummer *)
  R.AL := $30;            (* Unterfunktionsnummer *)
  R.BH := 1;              (* Im Prinzip egal *)
  Intr($10,R);            (* BIOS-Aufruf *)
  GetCharSize := R.CX;    (* Zeichenhöhe wird in CX mitgeteilt *)
{$else}
begin
	return CharSize+1;
{$endif}
END;

{$ifndef unix}
PROCEDURE DefChar(CharNr: Byte; VAR MTable);
(* ------------------------------------------------- *)
(* Installiert unter der Zeichennummer CharNr die in *)
(* MTable enthaltene Matrix im Bildspeicherblock 0   *)
(* ------------------------------------------------- *)
  VAR R: Registers;
BEGIN
  UserTextFont(0, GetCharSize, 1, CharNr, True, MTable);
END;
{$endif}

PROCEDURE UserGraFont(Size: Word; Rows: Byte; VAR MTable);
(* ------------------------------------------- *)
(* Userzeichensatz für Grafikmodi installieren *)
(* Size:   Zeichenhöhe in Rasterzeilen         *)
(* Rows:   Anzahl Bildschirm-Textzeilen        *)
(* MTable: Array mit Zeichenmatritzen          *)
(* ------------------------------------------- *)
{$ifndef unix}
  VAR R: Registers;
BEGIN
  R.AH := $11;             (* Funktionsnummer *)
  R.AL := $21;             (* Unterfunktionsnummer *)
  R.BL := 0;               (* Zeilenanzahl frei wählbar *)
  R.CX := Size;            (* Höhe der Zeichen *)
  R.DL := Rows;            (* Anzahl Textzeilen *)
  R.ES := Seg(MTable);     (* Segmentadresse Zeichensatz *)
  R.BP := Ofs(MTable);     (* Offsetadresse Zeichensatz *)
  Intr($10,R);             (* BIOS-Aufruf *)
{$else}
begin
    NrOfRows:= Rows-1;     (* Textzeilen - 1 *)
    CharSize:= Size-1;     (* aktuelle Zeichenhöhe - 1 *)
    GCharset:= @MTable;
{$endif}
END;

FUNCTION FontAddr(Font: FontName): Pointer;
(* ---------------------------------------- *)
(* Gibt Zeiger auf (ROM-)Zeichensatz zurück *)
(* ---------------------------------------- *)
{$ifndef unix}
  VAR R: Registers;
BEGIN
  R.AH := $11;            (* Funktionsnummer *)
  R.AL := $30;            (* Unterfunktionsnummer *)
  R.BH := ORD(Font);      (* ORD verwandelt Fontname in Kennziffer *)
  Intr($10,R);            (* BIOS-Aufruf *)
  FontAddr := Ptr(R.ES,R.BP);  (* Segment in ES, Offset in BP *)
{$else}
begin
	case Font of
		ROM8x8:
			FontAddr:= @Font_Rom8x8;
		INT1F,ROM8x8Hi:
			FontAddr:= @Font_Rom8x8[128];
	else
		halt(126);
	end;
{$endif}
END;

(* -------------------- Ergänzung aus Anhang A -------------------- *)

{$ifndef unix}
FUNCTION LoadFont(FileName: String; VAR MTable): Integer;
(* -------------------------------------- *)
(* Lädt die Fontdatei Filename in die     *)
(* Variable MTable. Rückgabewerte:        *)
(*   0: Datei konnte nicht geladen werden *)
(*  -1: Falsches Dateiformat              *)
(* > 0: Dateigröße in Bytes               *)
(* -------------------------------------- *)
  VAR f: File;
      fsize: LongInt;
BEGIN
  (*$I-*)                (* Kein Abbruch bei I/O-Fehler *)
  Assign(f,FileName);
  Reset(f,1);                  (* Recordgröße 1 *)
  (*$I+*)
  IF IOResult <> 0 THEN BEGIN  (* Datei existiert nicht *)
    LoadFont := 0; Exit;
  END;
  fsize := FileSize(f);
  IF (fsize MOD 8 > 0)
    OR (fsize > 32*256) THEN   (* Kein Zeichensatz-Format *)
    LoadFont := -1
  ELSE BEGIN                   (* Datei lesen *)
    BlockRead(f,MTable,fsize);
    LoadFont := fsize;
  END;
  Close(f);
END;
{$endif}

(* ================================================================ *)

BEGIN  (* Initialisierungsteil *)
  CursorChar := #220;
END.

(* ================================================================ *)