(* ================================================================ *)
(*    Prozeduren mit Direktzugriff auf den Textmodus-Bildspeicher   *)
(*                          (Kapitel 10)                            *)
(*           (C) 1990 Matthias Uphoff & Addison Wesley              *)
(* ================================================================ *)

UNIT EVText;

INTERFACE
uses EVBios;         (* BIOS-Prozeduren und -Variablen einbinden *)

CONST MaxPage = 7;   (* Maximale Bildseitennummer *)

{$ifndef unix}
FUNCTION GetScrSeg: Word;
    (* Ermittelt die Segmentadresse des Textmodus-Bildspeichers *)
{$endif}
PROCEDURE InitText;
   (* Initialisiert einen 80x25-Textmodus (je nach Monitor    *)
   (* 3 oder 7) und ermittelt die Bildspeicher-Segmentadresse *)
PROCEDURE WriteCharD(c: Char; a, x, y: Byte);
   (* Schreibt das Zeichen c und das Attribut a   *)
   (* an die Textposition x,y in den Bildspeicher *)
PROCEDURE WriteStringD(s: String; a, x, y, p: Byte);
   (* Schreibt einen String mit dem Attribut a an die Position x,y *)
   (* der Bildseite p. Endgültige Version für alle Textmodi.       *)
{$ifndef unix}
PROCEDURE OpenWindow(fs:framestr;x1,y1,x2,y2,color,BackColor: Byte);
   (* Rettet den Bildinhalt und erzeugt ein Fenster  *)
   (* x1,y1 liegt links oben, x2,y2 rechts unten     *)
   (* Koordinaten nach Turbo Pascal-Konvention       *)
   (* Benötigt die Prozedur ScrollUp aus 5.6, um das *)
   (* Fenster mit der Farbe BackColor zu löschen     *)
PROCEDURE CloseWindow;
   (* Schließt das jeweils zuletzt geöffnete Fenster *)
{$endif}

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

IMPLEMENTATION

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

VAR
{$ifndef unix}
	ScrSeg: Word;       (* Bildspeicher-Segmentadr. *)
{$endif}
	LastPage: Byte;     (* Nummer der zuletzt benutzten Bildseite *)

{$ifndef unix}
FUNCTION GetScrSeg: Word;
(* -------------------------------------------------------- *)
(* Ermittelt die Segmentadresse des Textmodus-Bildspeichers *)
(* -------------------------------------------------------- *)
{  VAR CRTCPort: Word ABSOLUTE ;   (* BIOS: CRTC-Portadresse *)}
BEGIN
  IF mem[seg0040:$63]{CRTCPort} = $3B4 THEN  (* Monochrommonitor angeschlossen: *)
    GetScrSeg := segB000
  ELSE                     (* Farbmonitor angeschlossen *)
    GetScrSeg := segB800;
END;
{$endif}

PROCEDURE InitText;
(* ------------------------------------------------------- *)
(* Initialisiert einen 80x25-Textmodus (je nach Monitor    *)
(* 3 oder 7) und ermittelt die Bildspeicher-Segmentadresse *)
(* Benötigt die Prozedur SetVideoMode aus 5.1              *)
(* ------------------------------------------------------- *)
BEGIN
{$ifndef unix}
  ScrSeg := GetScrSeg;    (* Bildspeicher-Segmentadresse holen *)
  IF ScrSeg = $B000 THEN  (* Monochrommonitor angeschlossen: *)
    SetVideoMode(7)         (* Monochrom-Textmodus 7 initialisieren *)
  ELSE                    (* Farbmonitor angeschlossen *)
{$endif}
    SetVideoMode(3);        (* Farb-Textmodus 3 initialisieren *)
END;

PROCEDURE WriteCharD(c: Char; a, x, y: Byte);
(* ------------------------------------------- *)
(* Schreibt das Zeichen c und das Attribut a   *)
(* an die Textposition x,y in den Bildspeicher *)
(* ------------------------------------------- *)
{$ifndef unix}
   VAR ScrOfs: Word;
       NrOfColumns: Word ABSOLUTE 0:$44A;   (* BIOS: Anzahl Spalten *)
BEGIN
  ScrOfs := (NrOfColumns * y + x) * 2;   (* Offsetadresse berechnen *)
  Mem[ScrSeg:ScrOfs] := Byte(c);         (* Zeichencode schreiben *)
  Mem[ScrSeg:ScrOfs+1] := a;             (* Attribut schreiben *)
{$else}
begin
  WriteCAXY(x,y,c,a,0,0);
{$endif}
END;

PROCEDURE WriteStringD(s: String; a, x, y, p: Byte);
(* ------------------------------------------------------------ *)
(* Schreibt einen String mit dem Attribut a an die Position x,y *)
(* der Bildseite p. Endgültige Version für alle Textmodi.       *)
(* ------------------------------------------------------------ *)
  VAR ScrOfs, i: Word;
BEGIN
  (* Offsetadresse aus Seitennummer und Textkoordinaten berechnen: *)
{$ifndef unix}
  ScrOfs := PageSize * p + (NrOfColumns * y + x) * 2;
  FOR i := 1 TO Length(s) DO BEGIN
    Mem[ScrSeg:ScrOfs] := Byte(s[i]);  (* Zeichen schreiben *)
    Inc(ScrOfs);                       (* Offsetadresse erhöhen *)
    Mem[ScrSeg:ScrOfs] := a;           (* Attribut schreiben *)
    Inc(ScrOfs);                       (* Offsetadresse erhöhen *)
{$else}
  x:=x-1;
  FOR i := 1 TO Length(s) DO BEGIN
	WriteCAXY(x+i,y,s[i],a,0,0);
{$endif}
  END;
END;
{$ifndef unix}
PROCEDURE OpenWindow(fs:framestr;x1,y1,x2,y2,color,BackColor: Byte);
(* ---------------------------------------------- *)
(* Rettet den Bildinhalt und erzeugt ein Fenster  *)
(* x1,y1 liegt links oben, x2,y2 rechts unten     *)
(* Koordinaten nach Turbo Pascal-Konvention       *)
(* Benötigt die Prozedur ScrollUp aus 5.6, um das *)
(* Fenster mit der Farbe BackColor zu löschen     *)
(* ---------------------------------------------- *)
   VAR PageOfs: Word;
BEGIN
  IF LastPage < MaxPage THEN BEGIN    (* noch eine Seite frei *)
    LastPage := LastPage + 1;         (* Seitennummer erhöhen *)
    PageOfs := LastPage * PageSize;   (* Seitenoffsetadr. berechnen *)
    Move( Mem[ScrSeg:0],              (* Bildseite 0 retten *)
	  Mem[ScrSeg:PageOfs],
	  PageSize );
    (* Fenster löschen, Anpassung an BIOS-Koordinaten erforderlich *)
    ScrollUp(x1-1, y1-1, x2-1, y2-1, 0, BackColor );
    frame(fs,x1-1, y1-1, x2-1, y2-1, Color ,0);
  END;
END;

PROCEDURE CloseWindow;
(* ---------------------------------------------- *)
(* Schließt das jeweils zuletzt geöffnete Fenster *)
(* ---------------------------------------------- *)
   VAR PageOfs: Word;
BEGIN
  IF LastPage > 0 THEN BEGIN        (* noch eine Kopie vorhanden *)
    PageOfs := LastPage * PageSize; (* Seitenoffsetadr. berechnen *)
    Move( Mem[ScrSeg:PageOfs],      (* Bildinhalt zurückkopieren *)
          Mem[ScrSeg:0],
          PageSize );
    LastPage := LastPage - 1;       (* eine Bildseite zurück *)
  END;
END;
{$endif}
(* ================================================================ *)

BEGIN  (* Initialisierungsteil *)
{$ifndef unix}
  ScrSeg := GetScrSeg;
{$endif}
  LastPage := 0;
END.

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