{   graphics.inc      ***   Routinen fuer Drucker-Grafik   ***   }

{.pl72}
CONST xmax         = 639;
      ymax         = 199;
      linespace    = #27'3'#20;   { Drucker-Steuer-Sequenzen }
      onedirection = #27'U'#1;
      bitimage     = #27'K';
      carriageret  = #13;

TYPE vbr   = ARRAY [0..xmax] OF byte;
     zeile = STRING[80];

VAR   gbs  : ARRAY [0..24] OF vbr;         { Grafik-Bildschirm }
      tbs  : ARRAY [1..25, 1..79] OF char; { Text-Bildschirm   }

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

PROCEDURE clrgbs;

BEGIN { cltgbs }
  fillchar (gbs, sizeof (gbs), #0)
END;  { clrgbs }

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

PROCEDURE clrtbs;

BEGIN { clrtbs }
  fillchar (tbs, sizeof (tbs), #32)
END;  { clrtbs }

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

PROCEDURE printat (x, y : integer; w : zeile);

VAR i : integer;

BEGIN { printat }
  FOR i := 0 TO length (w)-1 DO
    IF i+x IN [1..79]
      THEN
        tbs [y, i+x] := w [i+1]
END;  { printat }

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

PROCEDURE plot (x, y : integer);

BEGIN { plot }
  y := ymax - y;
  IF (0 <= x) AND (x <= xmax) AND (0 <= y) AND (y <= ymax)
    THEN
      gbs [y SHR 3, x] := gbs [y SHR 3, x] OR (128 SHR (y MOD 8))
END;  { plot }

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

PROCEDURE line (ax, ay, bx, by : integer);

VAR g, i            : integer;
    dx, dy, l, s, c : real;

BEGIN { line }
  dx := bx-ax;
  dy := by-ay;
  l := sqrt (sqr (dx)+sqr (dy));
  IF l = 0
    THEN
      plot (ax, ay)
    ELSE
      BEGIN
        s := dy/l;
        c := dx/l;
        g := round (l);
        FOR i := 0 TO g DO
          plot (round (i*c)+ax, round (i*s)+ay)
      END
END;  { line }

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

PROCEDURE quad (x, y, z, v : integer);

BEGIN { quad }
  line (x, y, z, y);
  line (z, y, z, v);
  line (z, v, x, v);
  line (x, v, x, y)
END;  { quad }

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

PROCEDURE schraffiere (x1, y1, x2, y2, y3, abstand : integer);

VAR i, n : integer;

BEGIN { schraffiere }
  n := (y3-y1) DIV abstand;
  FOR i := 1 TO n DO
    line (x1, y1+i*abstand, x2, y2+i*abstand)
END;  { schraffiere }

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

PROCEDURE kasten (x, y, b, h : integer);

VAR z, v, a, c, d : integer;

BEGIN { kasten }
  IF h < 0
    THEN
      BEGIN
        y := y+h;
        h := -h;
        schraffiere (x, y, x+b, y, y+h, 1)
      END;
  d := b DIV 2;  z := x+b;  v := y+h;     quad (x, y, z, v);
  z := x+d;  v := y+h+b DIV 2;            line (x, y+h, z, v);
  a := z;  c := v;  z := a+b;  v := c;    line (a, c, z, v);
  a := z;  c := v;  z := x+b;  v := y+h;  line (a, c, z, v);
  z := x+b+d;  v := y+b DIV 2;            line (a, c, z, v);
  a := z;  c := v;  z := x+b;  v := y;    line (a, c, z, v);
  schraffiere (x+b, y, x+b+d, y+d, y+h, 3)
END;  { kasten }

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

VAR turtle : RECORD
               xposition : integer;
               yposition : integer;
               richtung  : integer;
               pen       : (up, down)
             END;

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

PROCEDURE initturtle;

BEGIN { initturtle }
  WITH turtle DO
    BEGIN
      xposition := 0;
      yposition := 0;
      richtung  := 0;
      pen       := down
    END
END;  { initturtle }

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

PROCEDURE moveto (x, y : integer);

BEGIN { moveto }
  WITH turtle DO
    BEGIN
      IF pen = down
        THEN
          line (xposition, yposition, x, y);
      xposition := x;
      yposition := y
    END
END;  { moveto }

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

PROCEDURE move (l : integer);

VAR xneu, yneu : integer;

BEGIN { move }
  WITH turtle DO
    BEGIN
      xneu := xposition+round (l*sin (richtung/180*pi));
      yneu := yposition+round (l*cos (richtung/180*pi));
      IF pen = down
        THEN
          line (xposition, yposition, xneu, yneu);
      xposition := xneu;
      yposition := yneu
    END
END;  { move }

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

PROCEDURE turnleft (w : integer);

BEGIN { turnleft }
  turtle.richtung := (turtle.richtung+w) MOD 360
END;  { turnleft }

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

PROCEDURE turnright (w : integer);

BEGIN { turnright }
  IF turtle.richtung-w < 0
    THEN
      turtle.richtung := 360+turtle.richtung-w
    ELSE
      turtle.richtung := turtle.richtung-w
END;  { turnright }

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

PROCEDURE turnto (w : integer);

BEGIN { turnto }
  turtle.richtung := w MOD 360
END;  { turnto }

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

PROCEDURE penup;

BEGIN { penup }
  turtle.pen := up
END;  { penup }

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

PROCEDURE pendown;

BEGIN { pendown }
  turtle.pen := down
END;  { pendown }

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

PROCEDURE circle (wa, we, mx, my, rx, ry : integer);

VAR i : integer;
    c : real;

BEGIN { circle }
  penup;
  FOR i := wa TO we DO
    BEGIN
      c := i*pi/180;
      moveto (mx+round (rx*cos (c)), my+round (ry*sin (c)));
      pendown
    END;
  penup
END;  { circle }

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

PROCEDURE sektor (wa, we, mx, my, rx, ry : integer);

VAR i : integer;
    c : real;

BEGIN { sektor }
  penup;
  moveto (mx, my);
  pendown;
  FOR i := wa TO we DO
    BEGIN
      c := i*pi/180;
      moveto (mx+round (rx*cos (c)), my+round (ry*sin (c)))
    END;
  moveto (mx, my);
  penup
END;  { sektor }

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

PROCEDURE hardcopy1;

VAR i, j : integer;

BEGIN { hardcopy1 }
  FOR i := 0 TO 24 DO
    BEGIN
      write (LST, linespace);             { Zeilenabstand ganz dicht }
      write (LST, onedirection);          { unidirectionaler Druck   }
      write (LST, bitimage, chr ((xmax+1) MOD 256),
                            chr ((xmax+1) DIV 256));
      { Grafikmodus 640 Punkte und Anzahl der Zeichen }
      FOR j := 0 TO xmax DO
        write (LST, chr (gbs [i, j]));
      write (LST, carriageret);
      FOR j := 1 TO 79 DO
        write (LST, tbs [i+1, j]);
      writeln (LST)
    END
END;  { hardcopy1 }

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

PROCEDURE hardcopy2;

VAR i, j : integer;

CONST doppelt : ARRAY [0..15] OF byte =
      (0,3,12,15,48,51,60,63,192,195,204,207,240,243,252,255);

BEGIN { hardcopy2 }
  FOR i := 0 TO 24 DO
    BEGIN
      write (LST, linespace);       { Zeilenabstand ganz dicht }
      write (LST, onedirection);    { unidirectionaler Druck   }
      write (LST, bitimage, chr ((xmax+1) MOD 256),
                            chr ((xmax+1) DIV 256));
      { Grafikmodus 640 Punkte und Anzahl der Zeichen }
      FOR j := 0 TO xmax DO
        write (LST, chr (doppelt [gbs [i,j] SHR 4]));
      writeln (LST);
      write (LST, bitimage, chr ((xmax+1) MOD 256),
                            chr ((xmax+1) DIV 256));
      FOR j := 0 TO xmax DO
        write (LST, chr (doppelt [gbs [i,j] AND 15]));
      write (LST, carriageret);
      FOR j := 1 TO 79 DO
        write (LST, tbs [i+1, j]);
      writeln (LST)
    END
END;  { hardcopy2 }

