PACKET pic plot DEFINES drawing area,               {Autor: H. Indenbirken}
                        begin plot,                 {Stand: 13.02.85      }
                        end plot, 
                        clear, 
                        pen,
                        move, 
                        draw, 
                        get cursor,

                        get screen, put screen: 
 
LET hor faktor   = 22.21739,                   {***** x pixel / x cm *****}
    vert faktor  = 18.61314,                   {***** y pixel / y cm *****}

    h max  = 639,
    v max  = 287,

    delete = 0,                                {Farbcodes}
    std    = 1,
    black  = 5,
    white  = 6,
 
    nothing          = 0,                      {Linientypen}
    durchgehend      = 1, 
    gepunktet        = 2,
    kurz gestrichelt = 3,
    lang gestrichelt = 4,
    strichpunkt      = 5;

INT CONST move code :: -255,                   {Controlcodes}
          draw code :: -254,
          plot code :: -253,
          norm code :: -252,
          del  code :: -251,
          xor  code :: -250,
          line code :: -249;

LET POS = STRUCT (INT x, y);

INT VAR pen thick :: 0, pen code :: draw code, ack;
POS VAR pos :: POS : (0, 0);

PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 
   x cm    := 23.0;      y cm    := 13.7; 
   x pixel := h max;     y pixel := v max
END PROC drawing area;

PROC begin plot : 
  control (plot code, 0, 0, ack);
  out (""15"")
ENDPROC begin plot ;
 
PROC end plot : 
  out (""14"");
  control (norm code, 0, 0, ack)
ENDPROC end plot ;

PROC clear :
  pos := POS : (0, 0);
  pen (0, 1, 0, 1);
  page
END PROC clear;

PROC pen (INT CONST background, foreground, thickness, linetype):
  pen code := foreground colour;
  pen thick := thickness;
  control (line code, 0, 0, ack)  .

foreground colour:
  IF linetype = nothing
  THEN move code
  ELIF foreground = delete OR foreground = black
  THEN del code
  ELIF foreground < 0
  THEN xor code
  ELSE draw code FI  .
 
END PROC pen;

PROC move (INT CONST x, y) :
  control (move code, x, y);
  pos := POS  : (x, y)
END PROC move;
 
PROC draw (INT CONST x, y) :
  control (pen code, x, y);
  IF thick line
  THEN IF horizontal line
       THEN thick y
       ELSE thick x FI;
       control (move code, x, y)
  FI;
  pos := POS : (x, y)   .

thick line:
  pen thick > 0 AND pen code <> move code  .

horizontal line:
  abs (pos.x-x) > abs (pos.y-y)  .

thick y:
  INT VAR dy;
  FOR dy FROM 1 UPTO pen thick
  REP control (move code, pos.x, pos.y+dy);
      control (pen code,      x,     y+dy); 
      control (move code, pos.x, pos.y-dy);
      control (pen code,      x,     y-dy)
  PER  . 

thick x:
  INT VAR dx;
  FOR dx FROM 1 UPTO pen thick
  REP control (move code, pos.x+dx, pos.y);
      control (pen code,      x+dx,     y); 
      control (move code, pos.x-dx, pos.y);
      control (pen code,      x-dx,     y)
  PER  . 

END PROC draw;
 
PROC draw (TEXT CONST record) :
  draw (record, 0.0, 0.0, 0.0)
END PROC draw;

PROC draw (TEXT CONST record, REAL CONST angle, height, width):
  IF pen code = draw code
  THEN cursor (x position, y position);
       out (record)
  FI  .

x position:
  (pos.x-1) DIV 8 + 1  .

y position:
  (pos.y-1) DIV 12 + 1  .

END PROC draw;

PROC control (INT CONST code, x, y):
  control (code, x check, y check, ack)  .

x check:
  IF x < 0
  THEN 0
  ELIF x > h max
  THEN h max
  ELSE x FI  . 

y check:
  IF y =< 0
  THEN v max
  ELIF y >= v max
  THEN 0
  ELSE v max-y FI  .

END PROC control;
 
PROC get cursor (TEXT VAR t, INT VAR x, y) :
  get cursor (t, x, y, -1, -1, -1, -1)
END PROC get cursor;

PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1):
  check;
  init cursor;
  REP set cursor;
      get step;
      set cursor;
      move cursor
  PER  .

init cursor:
  INT VAR delta := 1;
  x := pos.x;
  y := pos.y  .

set cursor:
  IF x0 > 0 AND y0 > 0
  THEN control (move code, x0, v max-y0, ack);
       control (xor  code, x, v max-y, ack)
  FI;
  IF x1 > 0 AND y1 > 0
  THEN control (move code, x1, v max-y1, ack);
       control (xor  code, x, v max-y, ack)
  FI;
  control (move code, x-4, v max-y, ack);
  control (xor  code, x+5, v max-y, ack);
  control (move code, x, v max-y-4, ack);
  control (xor  code, x, v max-y-4, ack)  .

get step:
  t := incharety (1);
  IF t <> ""
  THEN IF delta < 10
       THEN delta INCR delta
       ELSE delta INCR 1 FI
  ELSE delta := 1;
       inchar (t)
  FI  .

move cursor:
  SELECT code (t) OF
  CASE 2 : x INCR delta
  CASE 3 : y INCR delta
  CASE 8 : x DECR delta
  CASE 10: y DECR delta
  OTHERWISE leave get cursor ENDSELECT;
  check  .

leave get cursor:
  control (move code, pos.x, pos.y);
  LEAVE get cursor  .

check :
  IF x < 0
  THEN x := 0; out (""7"")
  ELIF x > h max
  THEN x := h max; out (""7"") FI; 

  IF y < 0
  THEN y := 0; out (""7"")
  ELIF y > v max
  THEN y := v max; out (""7"") FI  .

END PROC get cursor;

(* Bildwiederholspeicheraufbau des Pic 400:                              *)
(* 45 Blöcke (0...44) enthalten den Bildwiederholspeicher.               *)

PROC get screen (DATASPACE VAR ds, INT CONST page):
  INT VAR i, n, begin :: 45*page;
  FOR i FROM 0 UPTO 44
  REP block in (ds, begin+i, -1, i, n) PER
END PROC get screen;

PROC put screen (DATASPACE CONST ds, INT CONST page):
  INT VAR i, n, begin :: 45*page;
  FOR i FROM 0 UPTO 44
  REP block out (ds, begin+i, -1, i, n) PER
END PROC put screen;

END PACKET pic plot;