(*********************************************************************)
(*    GRAPHIC.LIB - Graphik-Routinen ohne GSX fuer Schneider JOYCE   *)
(*                       v. 22.08.1987                               *)
(*********************************************************************)

Type  LineBuffer = Array[1..720] Of Byte;  {entspricht einer Textzeile}
      Str15      = String[15];             {fuer Dateinamen}

Var   proc       : Array[1..2,1..128] Of Byte Absolute $F000;
                                                {Puffer fuer PIXEL.EXT}
      puffer     : LineBuffer Absolute $C000;
                               {Puffer fuer eine Zeile des Bildschirms}
      bilddatei  : File Of LineBuffer;
      name       : Str15;

(*********************************************************************)
{Liest externe Funktion PIXEL.EXT in den Speicher}

Procedure GraphInit;

Const bell  = #7;
      name  = 'PIXEL.EXT';

var   datei : File;

  {-------------------------------------------------------------------}
  Procedure OpenFile;
    Var ok     : Boolean;

    Begin
      Assign(datei,name);
      {$I-} Reset(datei) {$I+};
      ok := (IOresult=0);
      IF NOT ok THEN
        Begin
          Writeln(bell,bell,bell,'* File: PIXEL.EXT nicht gefunden *');
          Halt;
        End;
    End;

  {-------------------------------------------------------------------}

Begin {GraphInit}
  OpenFile;
  BlockRead(datei,proc,2); {Externe Funktion in Puffer lesen}
  Close(datei);
End;

(*********************************************************************)

Procedure OpenFile(name : str15);

Var  ok : BOOLEAN;

Begin
  Assign(bilddatei,name);
  {$I-} Reset(bilddatei) {$I+};
  ok := (IOresult=0);
  IF NOT ok THEN
    Begin
      Rewrite(bilddatei);
      Reset(bilddatei);
    End;
End;

(*********************************************************************)
{Externe Prozedur zum laden einer Zeile}

Procedure LoadLine(zeile : Integer); External $F099;

(*********************************************************************)
{Externe Prozedur zum speichern einer Zeile}

Procedure SaveLine(Zeile : Integer); External $F077;

(*********************************************************************)

Procedure LoadPic(name : Str15);

Var zeile : Integer;

Begin
  OpenFile(name);
  For zeile:=0 To 31 Do     {jede Zeile einzeln aus Datei lesen}
                            {und ab, auf den Bildschirm}
    Begin
      Read(bilddatei,puffer);
      LoadLine(zeile);
    End;
  Close(bilddatei);
End;

(*********************************************************************)

Procedure SavePic(name : Str15);

Var Zeile : Integer;

Begin
  OpenFile(name);
  For zeile:=0 To 31 Do
    Begin
      SaveLine(zeile);
      Write(bilddatei,puffer);
    End;
  Close(bilddatei);
End;

(*********************************************************************)
{Externer Kern zum Punkt setzen, loeschen und testen}

Function Pixel(x,y : Integer; Var modus) : Boolean; External $F000;

(*********************************************************************)
{Punkt an x/y setzen}

Procedure Plot(x,y : Integer);

Var modus : Byte;
    dummy : Boolean;

Begin
  modus := 1; {Punkt setzen}
  dummy := Pixel(x,y,modus); {zurueckgegebener Wert interesiert nicht}
End;

(*********************************************************************)
{Punkt an x/y loeschen}

Procedure ResetPixel(x,y : Integer);

Var modus : Byte;
    dummy : Boolean;

Begin
  modus := 0; {Punkt loeschen}
  dummy := Pixel(x,y,modus);
End;

(*********************************************************************)
{Punkt an x/y gesetzt?}

Function PixelSet(x,y : Integer) : Boolean;

Var modus : Byte;

Begin
  modus := 2; {Punkt testen}
  PixelSet := Pixel(x,y,modus); {TRUE => Pixel ist gesetzt}
End;

(*********************************************************************)
{Linie von x1/y1 nach x2/y2 ziehen}

Procedure Draw(x1,y1,x2,y2 : Integer);

Var xl,yl,x,y,
    dx,dy,
    a,b,e,
    help,ende        : Integer;
    wh               : Boolean;

Begin
  xl := 1; yl := 1;
  x := x1; y := y1;
  ende := x2;
  dx := x2-x1;
  dy := y2-y1;
  wh := False;
  If dx < 0 Then
    Begin
       dx :=-dx;
       xl := -1;
    End;
  If dy < 0 Then
    Begin
      dy := -dy;
      yl := -1;
    End;
  If dx < dy Then
    Begin
      help := x; x := y; y := help;
      help := dx; dx := dy; dy := help;
      help := xl; xl := yl; yl:=help;
      ende := y2;
    wh := True;
  End;
  a := 2 * dy;
  b := 2 * dx - a;
  e := a - dx;
  If wh Then
    Begin
      Plot(y,x);
      While NOT (x=ende) Do
        Begin
          x := x + xl;
          If e > 0 Then
            Begin
              y := y +yl;
              e := e - b;
            End
          Else e := e + a;
          Plot(y,x);
        End;
      End
    Else
      Begin
        Plot(x,y);
        While NOT (x=ende) Do
        Begin
          x := x + xl;
          If e > 0 Then
            Begin
              y := y + yl;
              e := e - b;
            End
          Else e := e + a;
          Plot(x,y);
        End;
    End;
End;

(*********************************************************************)
{Zeichnet Viereck}

Procedure Box(x1,y1,x2,y2 : Integer);
              {x1,y1 = Ecke links oben; x2,y2 = Ecke rechts unten}

Begin
  Draw(x1,y1,x2,y1);
  Draw(x2,y1,x2,y2);
  Draw(x2,y2,x1,y2);
  Draw(x1,y2,x1,y1);
End;