{$g+,n+,e+}
(* ================================================================ *)
(*  Prozeduren mit Direktzugriff auf den Grafikmodus-Bildspeicher   *)
(*                      (Kapitel 11 und 13)                         *)
(*           (C) 1990 Matthias Uphoff & Addison Wesley              *)
(* ================================================================ *)

UNIT EVGraph;

INTERFACE

{$ifdef unix}
uses Xcrt;
{$endif}
(* ----------------- Die Prozeduren aus Kapitel 11 ---------------- *)

(* ------------------ Plotprozeduren für diverse Grafikmodi: *)

{$ifndef unix}
PROCEDURE Plot5(x,y: Word; Color: Byte);
   (* Setzt im CGA-kompatiblen Modus 5 einen Punkt *)
   (* in der Farbe Color an die Position x,y       *)
PROCEDURE Plot6(x,y: Word; Color: Byte);
   (* Setzt im CGA-kompatiblen Modus 6 einen Punkt *)
   (* in der Farbe Color an die Position x,y       *)
PROCEDURE Plot11(x,y: Word; Color: Byte);
   (* Setzt im VGA-Modus 11h einen Punkt     *)
   (* in der Farbe Color an die Position x,y *)
PROCEDURE PlotF(x,y: Word; Color: Byte);
   (* Setzt im Monochrom-Grafikmodus Fh einen Punkt *)
   (* mit dem Attribut Color an die Position x,y    *)

(* ------------------- Prozeduren für den 256-Farben-Modus $13: *)

PROCEDURE Rectangle13(x1,y1,x2,y2: Word; Color: Byte);
   (* Erzeugt im 256-Farben-Modus 13h ein gefülltes      *)
   (* Rechteck in der Farbe Color. Der Punkt x1,y1 liegt *)
   (* links oben und der Punkt x2,y2 rechts unten.       *)
PROCEDURE WriteChar13(c: Char; x,y: Word; ForeColor, BackColor: Byte);
   (* Schreibt im 256-Farben-Modus das Zeichen c an die     *)
   (* Position x,y (Grafikkoordinaten) mit der Vordergrund- *)
   (* farbe ForeColor und der Hintergrundfarbe BackColor    *)
   (* x,y markiert die linke obere Ecke des Zeichens.       *)

(* -------------------- Prozeduren für die 16-Farben-Grafikmodi: *)

PROCEDURE SaveScreen(x1,y1,x2,y2: Word; Filename: String);
   (* Speichert einen Bildausschnitt in den 16-Farben-Modi unter *)
   (* dem Dateinamen Filename ab. x1,y1 markiert die linke obere *)
   (* und x2,y2 die rechte untere Ecke in Grafikkoordinaten      *)
PROCEDURE LoadScreen(x1,y1: Word; FileName: String);
   (* Lädt einen Bildauschnitt mit dem Dateinamen Filename      *)
   (* von Diskette in den Bildspeicher, so daß die linke        *)
   (* obere Ecke am Punkt x1,y1 liegt. x1 wird auf die nächste  *)
   (* Bytegrenze (d.h. einen durch 8 teilbaren Wert) abgerundet *)
{$endif}

(* ----------------- Die Prozeduren aus Kapitel 13 ---------------- *)
(* ----------------- nur für 16-Farben-Grafikmodi: *)

{$ifndef unix}
(* These functions are implemented in Xcrt *)
PROCEDURE ClearScreen(Color: Byte);
PROCEDURE Plot(x,y: Word; Color: Byte);
PROCEDURE HLine(x1,x2,y: Word; Color: Byte);
PROCEDURE VLine(x,y1,y2: Word; Color,Logic: Byte);
   (* Zeichnet eine vertikale Linie von x,y1 nach  *)
   (* x,y2 mit der Farbe Color.Der Parameter Logic *)
   (* bestimmt die Verknüpfung mit der bereits im  *)
   (* Bildspeicher vorhandenen Punktfarbe:         *)
   (*   0 = Überschreiben    1 = AND-Verknüpfung   *)
   (*   2 = OR-Verknüpfung   3 = XOR-Verknüpfung   *)
PROCEDURE  WriteChar(c: Char; x,y: Word; ForeColor, BackColor: Byte);
   (* Schreibt in den 16-Farben-Modi das Zeichen c an die    *)
   (* Position x,y (Grafikkoordinaten) mit der Vordergrund-  *)
   (* farbe ForeColor und der Hintergrundfarbe BackColor.    *)
   (* x,y markiert die linke obere Ecke des Zeichens.        *)

(* proc-vars *)

PROCEDURE FilledRectangle(x1,y1,x2,y2: Word; Color: Byte);

{$else}

var
 FilledRectangle:procedure(x1,y1,x2,y2: Word; Color: Byte) absolute Xfrect8;
{$endif}

PROCEDURE Plot2(x,y: Word; Color,logic: Byte);
   (* Setzt in den 16-Farben-Modi einen Punkt *)
   (* mit der Farbe Color an der Position x,y *)
PROCEDURE HLine2(x1,x2,y: Word; Color,logic: Byte);
   (* Zeichnet eine horizontale Linie von *)
   (* x1,y nach x2,y in der Farbe Color.  *)
PROCEDURE FilledRectangle2(x1,y1,x2,y2: Word; Color,logic: Byte);
PROCEDURE Rectangle(x1,y1,x2,y2: Word; Color: Byte);
PROCEDURE Rectangle2(x1,y1,x2,y2: Word; Color,logic: Byte);
PROCEDURE RRectangle(x1,y1,x2,y2: Word; Color,logic: Byte);{rounded}
   (* Erzeugt ein (gefülltes) Rechteck in der Farbe Color   *)
   (* Die Ecke x1,y1 liegt links oben, x2,y2 rechts unten *)
procedure circle(x,y,r:word;color:byte);
procedure fcircle(x,y,r:word;color:byte);
procedure circle2(x,y,r:word;color,mode:byte);
procedure circle3(x,y,x1,y1,dx,dy,r:integer;color,mode:byte);
procedure fcircle2(x,y,r:word;color,mode:byte);
Procedure Line(x1,y1,x2,y2:word;color,logic:byte);
PROCEDURE SetRWMode(RMode,WMode: Byte);
   (* Setzt den Lesemodus RMode (0..1) und den   *)
   (* Schreibmodus WMode (0..3) im Mode Register *)
PROCEDURE CopyPage(SPage,DPage: Word);
   (* Kopiert in den 16-Farben-Grafikmodi Bildseite *)
   (* SPage (Source) nach Seite DPage (Destination) *)
FUNCTION DotColor(x,y: Word): Byte;
   (* Gibt die Punktfarbe an der Stelle x,y zurück *)
PROCEDURE HLineXColor(x1,x2,y: Word; Color1,Color2: Byte);
   (* Tauscht entlang der horizontalen Linie von       *)
   (* x1,y nach x2,y die Farbe Color1 gegen Color2 aus *)

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

IMPLEMENTATION
uses
 dos,
 utils,
 tstring,
 vbios;

{$ifdef unix}

procedure nimp;
begin
	writeln('not implemented');
	halt;
end;
{$endif}

procedure circle2(x,y,r:word;color,mode:byte);
var
 i:byte;
 c,s:extended;
 da,db:word;

 procedure plot3(x,y:word;c,m:byte);
 begin
  if (x<640)and(y<480) then plot2(x,y,c,m);
 end;

begin
 for i:=0 to (3*r+3) div 4 do begin
  if r<>0 then s:=i/r else s:=1;
  c:=sqrt(1-s*s);{sin²+cos²=1}
  da:=trunc(c*r+0.5);
  db:=trunc(s*r+0.5);

  plot3(x+da,y+db,color,mode);
  plot3(x+da,y-db,color,mode);
  plot3(x-da,y+db,color,mode);
  plot3(x-da,y-db,color,mode);

  plot3(x+db,y+da,color,mode);
  plot3(x+db,y-da,color,mode);
  plot3(x-db,y+da,color,mode);
  plot3(x-db,y-da,color,mode);
 end;
end;

procedure circle3(x,y,x1,y1,dx,dy,r:integer;color,mode:byte);
var
 i:integer;
 c,s:extended;
 da,db:word;

 procedure plot3(x,y:integer;c,m:byte);
 begin
  {if ((x<=dx)or(x>=0))and((y<=dy)or(y>=0)) then }begin
   if x<0 then x:=0;
   if y<0 then y:=0;
   if x>dx then x:=dx;
   if y>dy then y:=dy;
   plot2(x+x1,y+y1,c,m);
  end;
 end;

begin
 for i:=0 to (3*r+3) div 4 do begin
  if r<>0 then s:=i/r else s:=1;
  c:=sqrt(1-s*s);{sin²+cos²=1}
  da:=trunc(c*r+0.5);
  db:=trunc(s*r+0.5);

  plot3(x+da,y+db,color,mode);
  plot3(x+da,y-db,color,mode);
  plot3(x-da,y+db,color,mode);
  plot3(x-da,y-db,color,mode);

  plot3(x+db,y+da,color,mode);
  plot3(x+db,y-da,color,mode);
  plot3(x-db,y+da,color,mode);
  plot3(x-db,y-da,color,mode);
 end;
end;

procedure circle(x,y,r:word;color:byte);
var
 i:byte;
 c,s:extended;
 da,db:word;

 procedure plot3(x,y:word;c,m:byte);
 begin
  if (x<640)and(y<480) then plot2(x,y,c,m);
 end;

begin
 for i:=0 to (3*r+3) div 4 do begin
  if r<>0 then s:=i/r else s:=1;
  c:=sqrt(1-s*s);{sin²+cos²=1}
  da:=trunc(c*r+0.5);
  db:=trunc(s*r+0.5);

  plot(x+da,y+db,color);
  plot(x+da,y-db,color);
  plot(x-da,y+db,color);
  plot(x-da,y-db,color);

  plot(x+db,y+da,color);
  plot(x+db,y-da,color);
  plot(x-db,y+da,color);
  plot(x-db,y-da,color);
 end;
end;

procedure fcircle(x,y,r:word;color:byte);
var
 i:byte;
 c,s:extended;
 da,db:word;

begin
 for i:=0 to (3*r+3) div 4 do begin
  if r<>0 then s:=i/r else s:=1;
  c:=sqrt(1-s*s);{sin²+cos²=1}
  da:=trunc(c*r+0.5);
  db:=trunc(s*r+0.5);

  hline(x-da,x+da,y+db,color);
  hline(x-da,x+da,y-db,color);

  hline(x-db,x+db,y+da,color);
  hline(x-db,x+db,y-da,color);
 end;
end;

procedure fcircle2(x,y,r:word;color,mode:byte);
var
 i:byte;
 c,s:extended;
 da,db:word;

 procedure hline3(x1,x2,y:integer;c,m:byte);
 begin
  if (word(y)<480)and(x2>0)and(x1<640) then begin
   if x2>=640 then x2:=639;
   if x1<0 then x1:=0;
   hline2(x1,x2,y,c,m);
  end;
 end;

begin
 for i:=0 to (3*r+3) div 4 do begin
  if r<>0 then s:=i/r else s:=1;
  c:=sqrt(1-s*s);{sin²+cos²=1}
  da:=trunc(c*r+0.5);
  db:=trunc(s*r+0.5);

  hline3(x-da,x+da,y+db,color,mode);
  hline3(x-da,x+da,y-db,color,mode);

  hline3(x-db,x+db,y+da,color,mode);
  hline3(x-db,x+db,y-da,color,mode);
 end;
end;
(* ----------------- Die Prozeduren aus Kapitel 11 ---------------- *)

{$ifndef unix}
PROCEDURE Plot5(x,y: Word; Color: Byte);
(* -------------------------------------------- *)
(* Setzt im CGA-kompatiblen Modus 5 einen Punkt *)
(* in der Farbe Color an die Position x,y       *)
(* -------------------------------------------- *)
  CONST sega000 = $B800;
	CByte: ARRAY[0..3] OF Byte = ($00,$55,$AA,$FF);
  VAR   ScrOfs: Word;
	Bitmask: Byte;
BEGIN
     (* Die Berechnung der Bildspeicher-Offsetadresse *)
  ScrOfs := 8152 * (y AND 1) + y * 40 + x DIV 4;
     (* Die Erzeugung der Bitmaske aus der X-Koordinate:  *)
  Bitmask := $C0 SHR ((x AND 3) * 2);
     (* Abschließend die Manipulation des Bildschirmbytes: *)
  Mem[sega000:ScrOfs] := (Mem[sega000:ScrOfs] AND NOT Bitmask)
                     OR (CByte[Color] AND Bitmask);
END;

PROCEDURE Plot6(x,y: Word; Color: Byte);
(* -------------------------------------------- *)
(* Setzt im CGA-kompatiblen Modus 6 einen Punkt *)
(* in der Farbe Color an die Position x,y       *)
(* -------------------------------------------- *)
  CONST sega000 = $B800;
  VAR   ScrOfs: Word;
        Bitmask: Byte;
BEGIN
  ScrOfs := 8152 * (y AND 1) + y * 40 + x DIV 8;   (* Offsetadresse *)
  Bitmask := $80 SHR (x AND 7);                    (* Bitmaske *)
  IF Color = 0 THEN                    (* Farbnummer 0, Bit löschen *)
    Mem[sega000:ScrOfs] := Mem[sega000:ScrOfs] AND NOT Bitmask
  ELSE                                 (* Farbnummer 1, Bit setzen *)
    Mem[sega000:ScrOfs] := Mem[sega000:ScrOfs] OR Bitmask;
END;

PROCEDURE Plot11(x,y: Word; Color: Byte);
(* -------------------------------------- *)
(* Setzt im VGA-Modus 11h einen Punkt     *)
(* in der Farbe Color an die Position x,y *)
(* -------------------------------------- *)
  VAR   ScrOfs: Word;
	Bitmask: Byte;
BEGIN
  ScrOfs := 80 * y + x DIV 8;                (* Offsetadresse *)
  Bitmask := $80 SHR (x AND 7);              (* Bitmaske *)
  IF Color = 0 THEN                    (* Farbnummer 0, Bit löschen *)
    Mem[sega000:ScrOfs] := Mem[sega000:ScrOfs] AND NOT Bitmask
  ELSE                                 (* Farbnummer 1, Bit setzen *)
    Mem[sega000:ScrOfs] := Mem[sega000:ScrOfs] OR Bitmask;
END;

PROCEDURE PlotF(x,y: Word; Color: Byte);
(* --------------------------------------------- *)
(* Setzt im Monochrom-Grafikmodus Fh einen Punkt *)
(* mit dem Attribut Color an die Position x,y    *)
(* --------------------------------------------- *)
  VAR ScrOfs: Word;
      Bitmask: Byte;
BEGIN
  ScrOfs := 80 * y + x DIV 8;    (* Offsetadresse berechnen *)
  Bitmask := $80 SHR (x AND 7);  (* Bitmaske berechnen *)
  Port[$3C4] := 2;               (* Index für Map Mask Reg. *)
  Port[$3C5] := 1;               (* Schreiben in Ebene 0 *)
  Port[$3CE] := 4;               (* Index für Read Map Select Reg. *)
  Port[$3CF] := 0;               (* Lesen aus Ebene 0 *)
  IF (Color AND 1) = 0 THEN      (* Attributbit 0 = 0, Bit löschen *)
    Mem[sega000:ScrOfs] := Mem[sega000:ScrOfs] AND NOT Bitmask
  ELSE                           (* Attributbit 0 = 1, Bit setzen *)
    Mem[sega000:ScrOfs] := Mem[sega000:ScrOfs] OR Bitmask;
  Port[$3C5] := 4;               (* Schreiben in Ebene 2 *)
  Port[$3CF] := 2;               (* Lesen aus Ebene 2 *)
  IF (Color AND 2) = 0 THEN      (* Attributbit 1 = 0, Bit löschen *)
    Mem[sega000:ScrOfs] := Mem[sega000:ScrOfs] AND NOT Bitmask
  ELSE                           (* Attributbit 1 = 1, Bit setzen *)
    Mem[sega000:ScrOfs] := Mem[sega000:ScrOfs] OR Bitmask;
END;

PROCEDURE Rectangle13(x1,y1,x2,y2: Word; Color: Byte);
(* -------------------------------------------------- *)
(* Erzeugt im 256-Farben-Modus 13h ein gefülltes      *)
(* Rechteck in der Farbe Color. Der Punkt x1,y1 liegt *)
(* links oben und der Punkt x2,y2 rechts unten.       *)
(* -------------------------------------------------- *)
   VAR y: Word;
BEGIN
  FOR y := y1 TO y2 DO FillChar(mem[sega000:y*320+x1], x2-x1+1, Color );
END;

PROCEDURE WriteChar13(c: Char; x,y: Word; ForeColor, BackColor: Byte);
(* ----------------------------------------------------- *)
(* Schreibt im 256-Farben-Modus das Zeichen c an die     *)
(* Position x,y (Grafikkoordinaten) mit der Vordergrund- *)
(* farbe ForeColor und der Hintergrundfarbe BackColor    *)
(* x,y markiert die linke obere Ecke des Zeichens.       *)
(* ----------------------------------------------------- *)
   VAR  CharSize: Word ABSOLUTE $0000:$0485;  (* BIOS: Zeichenhöhe *)
        FPtr: Pointer ABSOLUTE  $0000:$010C;  (* INT 43h-Vektor *)
        CharRow: Byte;
        FontSeg, FontOfs, ScrOfs,i,j: Word;
BEGIN
  ScrOfs := 320 * y + x;       (* Bildspeicher-Offsetadresse *)
  FontSeg := Seg(FPtr^);       (* Segmentadresse des Zeichensatzes *)
  FontOfs := Ofs(FPtr^) + CharSize * Byte(c);
                               (* Offsetadresse der Zeichenmatrix *)
  FOR i := 0 TO CharSize-1 DO BEGIN
    CharRow := Mem[FontSeg:FontOfs];       (* Pixelreihe holen *)
    FOR j := 0 TO 7 DO BEGIN
      IF (CharRow  AND $80) <> 0 THEN      (* Falls Bit 7 gesetzt *)
	Mem[sega000:ScrOfs+j] := ForeColor     (* Vordergrundfarbe *)
      ELSE                                 (* andernfalls *)
	Mem[sega000:ScrOfs+j] := BackColor;    (* Hintergrundfarbe *)
      CharRow := CharRow SHL 1;        (* Pixelreihe links schieben *)
    END;
    ScrOfs := ScrOfs + 320;     (* Adresse der nächste Rasterzeile *)
    FontOfs := FontOfs + 1;     (* Adresse der nächsten Punktreihe *)
  END;
END;

PROCEDURE SaveScreen(x1,y1,x2,y2: Word; Filename: String);
(* ---------------------------------------------------------- *)
(* Speichert einen Bildausschnitt in den 16-Farben-Modi unter *)
(* dem Dateinamen Filename ab. x1,y1 markiert die linke obere *)
(* und x2,y2 die rechte untere Ecke in Grafikkoordinaten      *)
(* ---------------------------------------------------------- *)
   VAR f: File;
       ScrOfs, y, NrOfBytes, NrOfLines: Word;
       Plane: Byte;
BEGIN
  Assign(f,Filename);            (* Dateinamen festlegen *)
  Rewrite(f,1);                  (* Binärdatei zum Schreiben öffnen *)
  ScrOfs := mem[seg0040:$4a] * y1 + x1 DIV 8;    (* Offsetadresse links oben *)
  NrOfBytes := x2 DIV 8 - x1 DIV 8 + 1;  (* Breite des Ausschnitts  *)
  NrOfLines := y2 - y1 + 1;              (* Höhe des Ausschnitts *)
  BlockWrite(f,NrOfBytes,2);             (* Dateikopf erzeugen *)
  BlockWrite(f,NrOfLines,2);
  Port[$3CE] := 4;               (* Index für Read Map Select Reg. *)
  FOR y := y1 TO y2 DO BEGIN       (* Alle Rasterzeilen abgrasen: *)
    FOR Plane := 0 TO 3 DO BEGIN     (* Alle Ebenen abgrasen: *)
      Port[$3CF] := Plane;             (* Read Map Register laden *)
      (* Zeile aus der Speicherebene auf Diskette schreiben *)
      BlockWrite(f,Mem[sega000:ScrOfs],NrOfBytes);
    END;
    ScrOfs := ScrOfs + mem[seg0040:$4a];  (* Offsetadresse der nächsten Zeile *)
  END;
  Port[$3CF] := 0;       (* Read Map Register mit Default laden *)
  Close(f);              (* Datei schließen *)
END;

PROCEDURE LoadScreen(x1,y1: Word; FileName: String);
(* --------------------------------------------------------- *)
(* Lädt einen Bildauschnitt mit dem Dateinamen Filename      *)
(* von Diskette in den Bildspeicher, so daß die linke        *)
(* obere Ecke am Punkt x1,y1 liegt. x1 wird auf die nächste  *)
(* Bytegrenze (d.h. einen durch 8 teilbaren Wert) abgerundet *)
(* --------------------------------------------------------- *)
   VAR f: File;
       ScrOfs, y, y2, NrOfBytes, NrOfLines: Word;
       Plane: Byte;
BEGIN
  Assign(f,FileName);              (* Dateinamen festlegen *)
  Reset(f,1);                      (* Binärdatei zum Lesen öffnen *)
  BlockRead(f,NrOfBytes,2);        (* Dateikopf lesen *)
  BlockRead(f,NrOfLines,2);
  ScrOfs := mem[seg0040:$4a] * y1 + x1 DIV 8; (* Offsetadresse links oben *)
  y2 := y1 + NrOfLines - 1;        (* y2 = letzte Rasterzeile *)
  Port[$3C4] := 2;                 (* Index für Map Mask Register  *)
  FOR y := y1 TO y2 DO BEGIN       (* Alle Rasterzeilen abgrasen: *)
    FOR Plane := 0 TO 3 DO BEGIN     (* Alle Ebenen abgrasen *)
      Port[$3C5] := 1 SHL Plane;      (* Bitmaske für Map Mask Reg. *)
      (* Zeile von Diskette in die Speicherebene laden: *)
      BlockRead(f,Mem[sega000:ScrOfs],NrOfBytes);
    END;
    ScrOfs := ScrOfs + mem[seg0040:$4a];   (* Offsetadr. der nächsten Zeile *)
  END;
  Port[$3C5] := $F;       (* Map Mask Register mit Default laden *)
  Close(f);               (* Datei schließen *)
END;
{$endif}
(* ----------------- Die Prozeduren aus Kapitel 13 ---------------- *)

{$ifndef unix}
PROCEDURE ClearScreen(Color: Byte);
(* -------------------------------------------------- *)
(* Löscht den gesamten Bildschirm mit der Farbe Color *)
(* Verbesserte Set/Reset-Version                      *)
(* -------------------------------------------------- *)
BEGIN
  FilledRectangle(0,0,639,479,0);
  { Funzt nicht unter xdosemu:
  Port[$3CE] := 0;               (* Index für Set/Reset Register *)
  Port[$3CF] := Color;           (* Farbnummer laden *)
  Port[$3CE] := 1;               (* Index für Enable Set/Reset Reg. *)
  Port[$3CF] := $0F;             (* Set/Reset als Datenquelle *)
  FillChar(Mem[sega000:0],memw[seg0040:$4c],0); (* Schreibvorgang auslösen *)
  Port[$3CF] := 0;               (* Default: CPU als Datenquelle *)
  }
END;

PROCEDURE Plot(x,y: Word; Color: Byte);
(* --------------------------------------- *)
(* Setzt in den 16-Farben-Modi einen Punkt *)
(* mit der Farbe Color an der Position x,y *)
(* --------------------------------------- *)
   VAR ScrOfs: Word;
       BitMask: Byte;
BEGIN
  ScrOfs := y * mem[seg0040:$4a] + x DIV 8; (* Bildspeicher-Offsetadresse *)
  BitMask := $80 SHR (x AND 7);  (* Bitmaske berechnen *)
  Port[$3CE] := 0;               (* Index für Set/Reset Register *)
  Port[$3CF] := Color;           (* Farbnummer laden *)
  Port[$3CE] := 1;               (* Index für Enable Set/Reset Reg. *)
  Port[$3CF] := $0F;             (* Set/Reset als Datenquelle *)
  Port[$3CE] := 8;               (* Index für Bit Mask Register *)
  Port[$3CF] := BitMask;         (* Bitmaske laden *)
  Inc( Mem[sega000:ScrOfs] );     (* Lese/Schreibzyklus erzeugen! *)
  Port[$3CF] := $FF;             (* Bit Mask Reg. mit Default laden *)
  Port[$3CE] := 1;               (* Index für Enable Set/Reset Reg. *)
  Port[$3CF] := 0;               (* mit Default laden *)
END;
{$endif}


PROCEDURE Plot2(x,y: Word; Color,logic: Byte);
{$ifndef unix}
VAR
  ScrOfs: Word;
  BitMask: Byte;
BEGIN
  ScrOfs := y * mem[seg0040:$4a] + x DIV 8; (* Bildspeicher-Offsetadresse *)
  BitMask := $80 SHR (x AND 7);  (* Bitmaske berechnen *)
  Port[$3CE] := 0;               (* Index für Set/Reset Register *)
  Port[$3CF] := Color;           (* Farbnummer laden *)
  Port[$3CE] := 1;               (* Index für Enable Set/Reset Reg. *)
  Port[$3CF] := $0F;             (* Set/Reset als Datenquelle *)
  Port[$3CE] := 3;                (* Index für Data Rotate Reg. *)
  Port[$3CF] := Logic SHL 3;      (* Data Rotate-Bits 3 und 4 laden *)
  Port[$3CE] := 8;               (* Index für Bit Mask Register *)
  Port[$3CF] := BitMask;         (* Bitmaske laden *)
  Inc( Mem[sega000:ScrOfs] );     (* Lese/Schreibzyklus erzeugen! *)
  Port[$3CF] := $FF;             (* Bit Mask Reg. mit Default laden *)
  Port[$3CE] := 1;               (* Index für Enable Set/Reset Reg. *)
  Port[$3CF] := 0;               (* mit Default laden *)
  Port[$3CE] := 3;                (* Index für Data Rotate Reg. *)
  Port[$3CF] := 0;      (* Data Rotate-Bits 3 und 4 laden *)
{$else}
begin
  if logic=0 then plot(x,y,color) else nimp;
{$endif}
END;

{$ifndef unix}
PROCEDURE HLine(x1,x2,y: Word; Color: Byte);
(* ----------------------------------- *)
(* Zeichnet eine horizontale Linie von *)
(* x1,y nach x2,y in der Farbe Color.  *)
(* ----------------------------------- *)
   VAR ScrOfs, HLength, x: Word;
       LMask, RMask: Byte;
BEGIN
(* --- Vorbereitung --- *)
  IF x1 > x2 THEN begin
   x:=x1;
   x1:=x2;
   x2:=x;
  end;
  ScrOfs := y * mem[seg0040:$4a] + x1 DIV 8;  (* Bildspeicher-Offsetadresse *)
  HLength := x2 DIV 8 - x1 DIV 8;  (* Länge der Linie in Bytes - 1 *)
  LMask := $FF SHR (x1 AND 7);     (* linke Randmaske berechnen *)
  RMask := $FF SHL (7-(x2 AND 7)); (* rechte Randmaske berechnen *)
  IF HLength = 0 THEN              (* wenn nur ein Byte dann linke *)
    LMask := LMask AND RMask;      (* und rechte Maske verknüpfen *)
  Port[$3CE] := 0;                 (* Index für Set/Reset Register *)
  Port[$3CF] := Color;             (* Farbnummer laden *)
  Port[$3CE] := 1;                 (* Index Enable Set/Reset Reg. *)
  Port[$3CF] := $0F;               (* Set/Reset als Datenquelle *)
(* --- Linie zeichnen --- *)
  Port[$3CE] := 8;                 (* Index für Bit Mask Register *)
  Port[$3CF] := LMask;             (* Randmaske für erstes Byte *)
  Inc( Mem[sega000:ScrOfs] );       (* Lese/Schreibzyklus erzeugen *)
  IF HLength > 0 THEN BEGIN        (* Falls Länge - 1 > 0: *)
    Dec(HLength);                    (* verbleibende Länge *)
    Inc(ScrOfs);                     (* nächste Bildspeicheradresse *)
    IF HLength > 0 THEN BEGIN        (* Falls Länge - 1 > 0: *)
      Port[$3CF] := $FF;               (* Bitmaske FFh laden *)
      FillChar(Mem[sega000:ScrOfs],     (* Mittlerer Teil der Linie *)
	       HLength, $FF);
      ScrOfs := ScrOfs + HLength;      (* Offsetadresse erhöhen *)
    END;
    Port[$3CF] := RMask;             (* Randmaske für letztes Byte *)
    Inc( Mem[sega000:ScrOfs] );       (* Lese/Schreibzyklus erzeugen *)
  END;
(* --- Register aufräumen --- *)
  Port[$3CF] := $FF;               (* Default-Bitmaske *)
  Port[$3CE] := 1;                 (* Index für Enable Set/Reset *)
  Port[$3CF] := 0;                 (* Enable Set/Reset-Default *)
END;
{$endif}

PROCEDURE HLine2(x1,x2,y: Word; Color,logic: Byte);
{$ifndef unix}
VAR
  ScrOfs,
  HLength,
  x: Word;
  LMask,
  RMask: Byte;
BEGIN
(* --- Vorbereitung --- *)
  IF x1 > x2 THEN begin
   x:=x1;
   x1:=x2;
   x2:=x;
  end;
  ScrOfs := y * mem[seg0040:$4a] + x1 DIV 8;  (* Bildspeicher-Offsetadresse *)
  HLength := x2 DIV 8 - x1 DIV 8;  (* Länge der Linie in Bytes - 1 *)
  LMask := $FF SHR (x1 AND 7);     (* linke Randmaske berechnen *)
  RMask := $FF SHL (7-(x2 AND 7)); (* rechte Randmaske berechnen *)
  IF HLength = 0 THEN              (* wenn nur ein Byte dann linke *)
    LMask := LMask AND RMask;      (* und rechte Maske verknüpfen *)
  Port[$3CE] := 0;                 (* Index für Set/Reset Register *)
  Port[$3CF] := Color;             (* Farbnummer laden *)
  Port[$3CE] := 1;                 (* Index Enable Set/Reset Reg. *)
  Port[$3CF] := $0F;               (* Set/Reset als Datenquelle *)
  Port[$3CE] := 3;                (* Index für Data Rotate Reg. *)
  Port[$3CF] := Logic SHL 3;      (* Data Rotate-Bits 3 und 4 laden *)
(* --- Linie zeichnen --- *)
  Port[$3CE] := 8;                 (* Index für Bit Mask Register *)
  Port[$3CF] := LMask;             (* Randmaske für erstes Byte *)
  Inc( Mem[sega000:ScrOfs] );       (* Lese/Schreibzyklus erzeugen *)
  IF HLength > 0 THEN BEGIN        (* Falls Länge - 1 > 0: *)
    Dec(HLength);                    (* verbleibende Länge *)
    Inc(ScrOfs);                     (* nächste Bildspeicheradresse *)
    IF HLength > 0 THEN BEGIN        (* Falls Länge - 1 > 0: *)
      Port[$3CF] := $FF;               (* Bitmaske FFh laden *)
      move(Mem[sega000:ScrOfs],     (* Mittlerer Teil der Linie *)
	   Mem[sega000:ScrOfs],HLength);
      ScrOfs := ScrOfs + HLength;      (* Offsetadresse erhöhen *)
    END;
    Port[$3CF] := RMask;             (* Randmaske für letztes Byte *)
    Inc( Mem[sega000:ScrOfs] );       (* Lese/Schreibzyklus erzeugen *)
  END;
(* --- Register aufräumen --- *)
  Port[$3CF] := $FF;               (* Default-Bitmaske *)
  Port[$3CE] := 1;                 (* Index für Enable Set/Reset *)
  Port[$3CF] := 0;                 (* Enable Set/Reset-Default *)
  Port[$3CE] := 3;                (* Index für Data Rotate Reg. *)
  Port[$3CF] := 0;      (* Data Rotate-Bits 3 und 4 laden *)
{$else}
begin
  if logic=0 then hline(x1,x2,y,color) else nimp;
{$endif}
END;

{$ifndef unix}
PROCEDURE FilledRectangle(x1,y1,x2,y2: Word; Color: Byte);
(* --------------------------------------------------- *)
(* Erzeugt ein gefülltes Rechteck in der Farbe Color   *)
(* Die Ecke x1,y1 liegt links oben, x2,y2 rechts unten *)
(* --------------------------------------------------- *)
   VAR y: Word;
BEGIN
  FOR y := y1 TO y2 DO HLine(x1,x2,y,Color);
END;
{$endif}

PROCEDURE FilledRectangle2(x1,y1,x2,y2: Word; Color,logic: Byte);
(* --------------------------------------------------- *)
(* Erzeugt ein gefülltes Rechteck in der Farbe Color   *)
(* Die Ecke x1,y1 liegt links oben, x2,y2 rechts unten *)
(* --------------------------------------------------- *)
   VAR y: Word;
BEGIN
  FOR y := y1 TO y2 DO HLine2(x1,x2,y,Color,logic);
END;

{$ifndef unix}
PROCEDURE VLine(x,y1,y2: Word; Color,Logic: Byte);
(* -------------------------------------------- *)
(* Zeichnet eine vertikale Linie von x,y1 nach  *)
(* x,y2 mit der Farbe Color.Der Parameter Logic *)
(* bestimmt die Verknüpfung mit der bereits im  *)
(* Bildspeicher vorhandenen Punktfarbe:         *)
(*   0 = Überschreiben    1 = AND-Verknüpfung   *)
(*   2 = OR-Verknüpfung   3 = XOR-Verknüpfung   *)
(* -------------------------------------------- *)
   VAR ScrOfs,y: Word;
       BitMask: Byte;
BEGIN
  IF y1 > y2 THEN begin
   y:=y1;
   y1:=y2;
   y2:=y;
  end;
  ScrOfs := y1 * mem[seg0040:$4a] + x DIV 8; (* Bildspeicher-Offsetadresse *)
  BitMask := $80 SHR (x AND 7);   (* Bitmaske berechnen *)
  Port[$3CE] := 0;                (* Index für Set/Reset Register *)
  Port[$3CF] := Color;            (* Farbnummer laden *)
  Port[$3CE] := 1;                (* Index für Enable Set/Reset *)
  Port[$3CF] := $0F;              (* Set/Reset als Datenquelle *)
  Port[$3CE] := 8;                (* Index für Bit Mask Register *)
  Port[$3CF] := BitMask;          (* Bitmaske laden *)
  Port[$3CE] := 3;                (* Index für Data Rotate Reg. *)
  Port[$3CF] := Logic SHL 3;      (* Data Rotate-Bits 3 und 4 laden *)
  FOR y := y1 TO y2 DO BEGIN
    Inc( Mem[sega000:ScrOfs] );    (* Lese/Schreibzyklus erzeugen *)
    ScrOfs := ScrOfs + mem[seg0040:$4a];  (* Offsetadr. eine Zeile weiter *)
  END;
  Port[$3CF] := 0;                (* Data Rotate mit Default laden *)
  Port[$3CE] := 8;                (* Index für Bit Mask Register *)
  Port[$3CF] := $FF;              (* Default-Bitmaske *)
  Port[$3CE] := 1;                (* Index für Enable Set/Reset *)
  Port[$3CF] := 0;                (* Enable Set/Reset-Default *)
  Port[$3CE] := 3;                (* Index für Data Rotate Reg. *)
  Port[$3CF] := 0;      (* Data Rotate-Bits 3 und 4 laden *)
END;
{$endif}

PROCEDURE Rectangle(x1,y1,x2,y2: Word; Color: Byte);
(* --------------------------------------------------- *)
(* Erzeugt ein gefülltes Rechteck in der Farbe Color   *)
(* Die Ecke x1,y1 liegt links oben, x2,y2 rechts unten *)
(* --------------------------------------------------- *)
BEGIN
  HLine(x1,x2,y1,Color);
  HLine(x1,x2,y2,Color);
  VLine(x1,y1,y2,Color,0);
  VLine(x2,y1,y2,Color,0);
END;

PROCEDURE Rectangle2(x1,y1,x2,y2: Word; Color,logic: Byte);
(* --------------------------------------------------- *)
(* Erzeugt ein gefülltes Rechteck in der Farbe Color   *)
(* Die Ecke x1,y1 liegt links oben, x2,y2 rechts unten *)
(* --------------------------------------------------- *)
BEGIN
  HLine2(x1,x2,y1,Color,logic);
  HLine2(x1,x2,y2,Color,logic);
  VLine(x1,y1,y2,Color,logic);
  VLine(x2,y1,y2,Color,logic);
END;

PROCEDURE rRectangle(x1,y1,x2,y2: Word; Color,logic: Byte);
(* --------------------------------------------------- *)
(* Erzeugt ein gefülltes Rechteck in der Farbe Color   *)
(* Die Ecke x1,y1 liegt links oben, x2,y2 rechts unten *)
(* --------------------------------------------------- *)
BEGIN
 HLine2(x1+1,x2-1,y1,Color,logic);
 HLine2(x1+1,x2-1,y2,Color,logic);
 VLine(x1,y1+1,y2-1,Color,logic);
 VLine(x2,y1+1,y2-1,Color,logic);
END;

Procedure Line(x1,y1,x2,y2:word;color,logic:byte);

 function sign(x:integer):integer;
 {$ifndef unix}
 assembler;
 asm
  xor ax,ax
  mov cx,x
  jcxz @end
  inc ax
  and cx,$8000
  jcxz @end
  neg ax
 @end:
 {$else}
 begin
 	if x=0 then return 0;
 	if x>0 then return 1;
 	return -1;
 {$endif} 
 end; 

var
 dx,
 dy,
 mx1,my1,
 mx2,my2,
 n,
 m,
 s,
 i:integer;
begin
 dx:=x2-x1;
 dy:=y2-y1;
 if dy=0 then hline2(x1,x2,y1,color,logic)
 else if dx=0 then vline(x1,y1,y2,color,logic)
 else begin
  mx1:=sign(dx);
  mx2:=mx1;
  my1:=sign(dy);
  my2:=my1;
  dx:=abs(dx);
  dy:=abs(dy);
  if dx>dy then begin
   n:=dx;
   m:=dy;
   s:=n div 2;
   my2:=0;
  end else begin
   n:=dy;
   m:=dx;
   s:=n div 2;
   mx2:=0;
  end;
  plot2(x1,y1,color,logic);
  for i:=1 to n do begin
   inc(s,m);
   if s>=n then begin
    inc(x1,mx1);
    inc(y1,my1);
    dec(s,n);
   end else begin
    inc(x1,mx2);
    inc(y1,my2);
   end;
   plot2(x1,y1,color,logic);
  end;
 end;
end;

{$ifndef unix}
PROCEDURE SetRWMode(RMode,WMode: Byte);
(* ------------------------------------------ *)
(* Setzt den Lesemodus RMode (0..1) und den   *)
(* Schreibmodus WMode (0..3) im Mode Register *)
(* ------------------------------------------ *)
BEGIN
  RMode := RMode AND 1;              (* auf 0..1 beschränken *)
  WMode := WMode AND 3;              (* auf 0..3 beschränken *)
  Port[$3CE] := 5;                   (* Index für Mode Register *)
  Port[$3CF] := RMode SHL 3 + WMode;
END;
{$endif}

{$ifndef unix}
PROCEDURE CopyPage(SPage,DPage: Word);
(* --------------------------------------------- *)
(* Kopiert in den 16-Farben-Grafikmodi Bildseite *)
(* SPage (Source) nach Seite DPage (Destination) *)
(* --------------------------------------------- *)
   VAR PageSize: Word ABSOLUTE $0000:$044C; (* BIOS: Bildseitengröße *)
BEGIN
  Port[$3CE] := 5;                  (* Index für Mode Register *)
  Port[$3CF] := 1;                  (* Schreibmodus 1 einstellen *)
  Move( Mem[sega000:SPage*PageSize], (* Bildseite kopieren *)
	Mem[sega000:DPage*PageSize],
        PageSize );
  Port[$3CF] := 0;                  (* Defaultmodus 0 einstellen *)
END;
{$endif}

{$ifndef unix}
PROCEDURE  WriteChar2(c: Char; x,y: Word; ForeColor, BackColor: Byte);
(* ------------------------------------------------------ *)
(* Schreibt in den 16-Farben-Modi das Zeichen c an die    *)
(* Position x,y (Grafikkoordinaten) mit der Vordergrund-  *)
(* farbe ForeColor und der Hintergrundfarbe BackColor.    *)
(* x,y markiert die linke obere Ecke des Zeichens.        *)
(* ------------------------------------------------------ *)
   TYPE CharMatrix = ARRAY[0..31] OF Byte;   (* Zeichenmatrix-Array *)
   VAR  CharSize: Word ABSOLUTE $0000:$0485; (* BIOS-Zeichenhöhe *)
	FPtr: Pointer ABSOLUTE  $0000:$010C; (* INT 43h-Vektor *)
        CharRow, BitPos, Dummy: Byte;
        FontSeg, FontOfs, ScrOfs, i: Word;
BEGIN
  ScrOfs := y * mem[seg0040:$4a] + x DIV 8;  (* Bildspeicher-Offsetadresse *)
  BitPos := x AND 7;                 (* Bitposition berechnen *)
  FontSeg := Seg(FPtr^);             (* Font-Segmentadresse *)
  FontOfs := Ofs(FPtr^) + CharSize * Byte(c); (* Font-Offsetadr. *)
  Port[$3CE] := 5;                   (* Index für Mode Register *)
  Port[$3CF] := 2;                   (* Schreibmodus 2 einstellen *)
  Port[$3CE] := 8;                   (* Index für Bit Mask Reg. *)
  FOR i := 0 TO CharSize-1 DO BEGIN
    CharRow := Mem[FontSeg:FontOfs];        (* Pixelreihe holen *)
    (* --- linke Seite ausgeben --- *)
    Port[$3CF] := CharRow SHR BitPos;       (* Bitmaske links *)
    Dummy := Mem[sega000:ScrOfs];            (* Lesezyklus erzeugen *)
    Mem[sega000:ScrOfs] := ForeColor;        (* Vordergrundfarbe *)
    Port[$3CF] := (NOT CharRow) SHR BitPos; (* inverse Maske links *)
    Dummy := Mem[sega000:ScrOfs];            (* Lesezyklus erzeugen *)
    Mem[sega000:ScrOfs] := BackColor;        (* Hintergrundfarbe *)
    IF BitPos > 0 THEN BEGIN
      (* --- rechte Seite ausgeben --- *)
      Inc(ScrOfs);                          (* Offsetadresse + 1 *)
      Port[$3CF] := CharRow SHL (8-BitPos); (* Bitmaske rechts *)
      Dummy := Mem[sega000:ScrOfs];          (* Lesezyklus erzeugen *)
      Mem[sega000:ScrOfs] := ForeColor;      (* Vordergrundfarbe *)
      Port[$3CF] := (NOT CharRow) SHL (8-BitPos); (* inverse Maske *)
      Dummy := Mem[sega000:ScrOfs];          (* Lesezyklus erzeugen *)
      Mem[sega000:ScrOfs] := BackColor;      (* Hintergrundfarbe *)
      Dec(ScrOfs);                          (* Offsetadresse - 1 *)
    END;
    ScrOfs := ScrOfs + mem[seg0040:$4a];        (* Offsetadr. nächste Zeile *)
    Inc(FontOfs);                       (* nächste Pixelreihe *)
  END;
  Port[$3CF] := $FF;                (* Default-Bitmaske *)
  Port[$3CE] := 5;                  (* Index für Mode Register  *)
  Port[$3CF] := 0;                  (* Mode Reg. mit Default laden *)
END;

PROCEDURE  WriteChar(c: Char; x,y: Word; ForeColor, BackColor: Byte);assembler;
(* ------------------------------------------------------ *)
(* Schreibt in den 16-Farben-Modi das Zeichen c an die    *)
(* Position x,y (Grafikkoordinaten) mit der Vordergrund-  *)
(* farbe ForeColor und der Hintergrundfarbe BackColor.    *)
(* x,y markiert die linke obere Ecke des Zeichens.        *)
(* ------------------------------------------------------ *)
VAR
 sw,
 sa,
 s4:word;

asm

 mov ax,sega000
 mov sa,ax
 mov ax,seg0040
 mov s4,ax
 push ds

 push ds
 mov ds,s4
 mov cx,[$4a]
 mov sw,cx
 mov ax,y
 mul cx       {AX=y*screenwidth}
 dec sw       {sw=ScreenWidth-1}
 pop ds
 mov dx,x
 mov bx,dx
 shr dx,3
 add ax,dx    {ax=ax+x/8}
 and bx,7     {bx=Bit-Position}
 mov di,ax    {di=Zielofset}

 mov es,sa    {es=Bildschirmsegment}
{$ifdef raceedit}
 mov cx,8    {cx=Zeichenhöhe}
{$else}
 mov cx,16    {cx=Zeichenhöhe}
{$endif}
 mov si, seg _fontdata
 mov ds,si
 mov si, offset _fontdata {ds:si=Zeichensatz}

 mov bh,8
 sub bh,bl    {bh=8-Bit_Position}
 xor ax,ax
 mov al,c
 mul cl
 add si,ax

 mov dx,$3ce
 mov al,5
 out dx,al
 inc dx
 mov al,2
 out dx,al

 dec dx
 mov al,8
 out dx,al
 inc dx

@writeloop:
 lodsb
 mov ah,al
 not ah
 push ax
  push cx
   mov cx,bx
   shr al,cl
   shr ah,cl
  pop cx

  out dx,al
  mov al,[es:di]
  mov al,forecolor
  mov [es:di],al

  mov al,ah
  out dx,al
  mov al,[es:di]
  mov al,backcolor
  stosb
 pop ax

 or bl,bl
 jz @loop

 push cx
  mov cl,bh
  shl al,cl
  shl ah,cl
 pop cx

 out dx,al
 mov al,[es:di]
 mov al,forecolor
 mov [es:di],al

 mov al,ah
 out dx,al
 mov al,[es:di]
 mov al,backcolor
 mov [es:di],al

@loop:
 add di,sw
 loop @writeloop
 mov al,$ff
 out dx,al
 dec dx

 mov al,5
 out dx,al
 inc dx
 xor ax,ax
 out dx,al

 pop ds
end;
{$endif}


{$ifndef unix}
FUNCTION DotColor(x,y: Word): Byte;
(* -------------------------------------------- *)
(* Gibt die Punktfarbe an der Stelle x,y zurück *)
(* -------------------------------------------- *)
   VAR ScrOfs: Word;
       BitMask, Color: Byte;
BEGIN
  ScrOfs := y * mem[seg0040:$4a] + x DIV 8; (* Bildspeicher-Offsetadresse *)
  BitMask := $80 SHR (x AND 7);    (* Bitmaske berechnen *)
  Color := 0;                      (* Farbe mit 0 initialisieren *)
  Port[$3CE] := 4;                 (* Index Read Map Select Register *)
  Port[$3CF] := 3;                 (* Lesen aus Ebene 3 *)
  IF (Mem[sega000:ScrOfs] AND BitMask) > 0 THEN
    Color := Color + 8;
  Port[$3CF] := 2;                 (* Lesen aus Ebene 2 *)
  IF (Mem[sega000:ScrOfs] AND BitMask) > 0 THEN
    Color := Color + 4;
  Port[$3CF] := 1;                 (* Lesen aus Ebene 1 *)
  IF (Mem[sega000:ScrOfs] AND BitMask) > 0 THEN
    Color := Color + 2;
  Port[$3CF] := 0;                 (* Lesen aus Ebene 0 *)
  IF (Mem[sega000:ScrOfs] AND BitMask) > 0 THEN
    Color := Color + 1;
  DotColor := Color;
END;
{$endif}

{$ifndef unix}
PROCEDURE HLineXColor(x1,x2,y: Word; Color1,Color2: Byte);
(* ------------------------------------------------ *)
(* Tauscht entlang der horizontalen Linie von       *)
(* x1,y nach x2,y die Farbe Color1 gegen Color2 aus *)
(* ------------------------------------------------ *)
   VAR ScrOfs, HLength: Word;
       LMask, RMask: Byte;
BEGIN
(* --- Vorbereitung --- *)
  IF x1 > x2 THEN Exit;            (* Wenn x1 > x2, sofort beenden *)
  ScrOfs := y * mem[seg0040:$4a] + x1 DIV 8;  (* Offsetadr. berechnen *)
  HLength := x2 DIV 8 - x1 DIV 8;  (* Länge - 1 in Bytes *)
  LMask := $FF SHR (x1 AND 7);     (* linke Randmaske *)
  RMask := $FF SHL (7-(x2 AND 7)); (* rechte Randmaske *)
  IF HLength = 0 THEN              (* wenn nur ein Byte dann linke *)
    LMask := LMask AND RMask;      (* und rechte Maske verknüpfen *)
  Port[$3CE] := 5;                 (* Index für Mode Register *)
  Port[$3CF] := 1 SHL 3 + 2;       (* Lesemodus 1 / Schreibmodus 2 *)
  Port[$3CE] := 2;                 (* Index für Color Compare Reg. *)
  Port[$3CF] := Color1;            (* Gesuchte Farbe laden *)
(* --- Farbe suchen und austauschen --- *)
  Port[$3CE] := 8;                      (* Index für Bit Mask Reg. *)
  Port[$3CF] := Mem[sega000:ScrOfs] AND LMask; (* Maske links *)
  Mem[sega000:ScrOfs] := Color2;         (* Neue Farbe setzen *)
  IF HLength > 0 THEN BEGIN             (* Weiter, falls Länge > 1 *)
    Dec(HLength);
    Inc(ScrOfs);
    WHILE HLength > 0 DO BEGIN          (* mittlerer Linienteil: *)
      Port[$3CF] := Mem[sega000:ScrOfs];    (* Vergleichsmaske laden *)
      Mem[sega000:ScrOfs] := Color2;        (* neue Farbe setzen *)
      Dec(HLength);                        (* Länge - 1 *)
      Inc(ScrOfs);                         (* nächste Adresse *)
    END;
    Port[$3CF] := Mem[sega000:ScrOfs] AND RMask; (* Maske rechts *)
    Mem[sega000:ScrOfs] := Color2;               (* neue Farbe setzen *)
  END;
(* --- Register aufräumen --- *)
  Port[$3CF] := $FF;               (* Default-Bitmaske *)
  Port[$3CE] := 5;                 (* Index für Mode Register  *)
  Port[$3CF] := 0;                 (* Mode Reg. mit Default laden *)
END;
{$endif}

(* ================================================================ *)
END.

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