PACKET basis plot DEFINES                     (* Autor: Heiko Indenbirken*)
                                              (* Stand: 12.04.85         *)
                                              (*Änderung: 06.08.86/10:03 *)
(*  ******************  Hardwareunabhängiger Teil  ********************* *)
(*                                                                       *)
(*                                                                       *)
(*      Im Harwareunabhängigen Paket 'basis plot' werden folgende        *)
(*      Prozeduren definiert:                                            *)
(*      Procedure       :  Bedeutung                                     *)
(*      ---------------------------------------------------------------- *)
(*       move           :  Positioniert auf (x, y,[z]) in Weltkoordinaten*)
(*       draw           :  Zeichnet eine Linie bis zum Punkt (x, y, [z]).*)
(*       move r         :  Positioniert (x, y, [z]) weiter               *)
(*       draw r         :  Zeichnet (x, y, [z]) weiter                   *)
(*                                                                       *)
(*       draw           :  Zeichnet einen Text                           *)
(*                                                                       *)
(*       mark           :  Marker mit (no, size)                         *)
(*       bar            :  Balken mit (width, height, pattern)           *)
(*       bar            :  Balken mit (from, to, width, pattern)         *)
(*       circle         :  Kreis(segment) mit (radius, from, to, pattern)*)
(*                                                                       *)
(*       where          :  Gibt die aktuelle Stiftposition (x, y, [z])   *)
(*                                                                       *)
(*************************************************************************)

       move, draw,
       move r, draw r,
       mark, bar, circle,
       where:

LET POS = STRUCT (REAL x, y, z);

POS VAR pos :: POS : (0.0, 0.0, 0.0);
INT VAR h :: 0, v :: 0;

PROC move (REAL CONST x, y) :
  transform (x, y, 0.0, h, v);
  move (h, v);
  pos := POS : (x, y, 0.0)
END PROC move;

PROC move (REAL CONST x, y, z) :
  transform (x, y, z, h, v);
  move (h, v);
  pos := POS : (x, y, z)
END PROC move;

PROC draw (REAL CONST x, y) :
  transform (x, y, 0.0, h, v);
  draw (h, v);
  pos := POS : (x, y, 0.0)
END PROC draw;

PROC draw (REAL CONST x, y, z) :
  transform (x, y, z, h, v);
  draw (h, v);
  pos := POS : (x, y, z) 
END PROC draw;

PROC move r (REAL CONST x, y) :
  transform (pos.x+x, pos.y+y, pos.z, h, v);
  move (h, v);
  pos := POS : (pos.x+x, pos.y+y, pos.z)
END PROC move r;

PROC move r (REAL CONST x, y, z) :
  transform (pos.x+x, pos.y+y, pos.z+z, h, v);
  move (h, v);
  pos := POS : (pos.x+x, pos.y+y, pos.z+z)
END PROC move r;

PROC draw r (REAL CONST x, y) :
  transform (pos.x+x, pos.y+y, pos.z, h, v); 
  draw (h, v);
  pos := POS : (pos.x+x, pos.y+y, pos.z)
END PROC draw r;

PROC draw r (REAL CONST x, y, z) :
  transform (pos.x+x, pos.y+y, pos.z+z, h, v);
  draw (h, v);
  pos := POS : (pos.x+x, pos.y+y, pos.z+z)
END PROC draw r;

PROC where (REAL VAR x, y) :
  x := pos.x;  y := pos.y
END PROC where;

PROC where (REAL VAR x, y, z) :
  x := pos.x;  y := pos.y;  z := pos.z
END PROC where;

PROC draw (TEXT CONST msg, REAL CONST angle, height percent, width percent):
  draw (msg, angle, height (height percent), width (width percent))  .
END PROC draw;

PROC mark (REAL CONST size, INT CONST no):
  marker (h, v, no, diagonal (size))
END PROC mark;

PROC bar (REAL CONST width, height, INT CONST pattern):
  INT VAR diff, up, zero x, zero y;
  transform (0.0, 0.0, 0.0, zero x, zero y);
  transform (width*0.5, height, 0.0, diff, up);
  bar (h-(diff-zero x), v, h+(diff-zero x), v+(up-zero y), pattern);
  move (h, v) 

END PROC bar;

PROC bar (REAL CONST from, to, height, INT CONST pattern):
  INT VAR from h, to h, up;
  transform (from, height, 0.0, from h, up);
  transform (to,   height, 0.0, to h, up);
  bar (from h, v, to h, up, pattern);
  move (h, v) 

END PROC bar;

PROC circle (REAL CONST rad, from, to, INT CONST pattern):
  circle (h, v, diagonal (rad), from, to, pattern)  .

END PROC circle;

ENDPACKET basis plot;

PACKET plot DEFINES plot:                     (*Autor: Heiko Indenbirken *)
                                              (*Stand:    13.10.89/22:31 *)

LET draw key      = 1,
    move key      = 2,
    text key      = 3,
    move r key    = 4,
    draw r key    = 5,
    bar 2 key     = 6,
    bar 3 key     = 7,
    circle key    = 8,
    mark key      = 9;

LET dim error = "PICTURE not initialized",
    key error = "wrong key code: ";

TEXT VAR points;
INT VAR pic length, pic pen, pic dim, read pos;
PICTURE VAR pic;

PROC plot (PICTURE CONST pic):
  init plot;
  IF pic dim = 2
  THEN plot two dim pic
  ELIF pic dim = 3
  THEN plot three dim pic
  ELIF NOT (pic dim = 0 AND pic length = 0)
  THEN errorstop (dim error) FI;
  points := ""  .

init plot:
  picture (pic, points, pic dim, pic pen);
  pic length := length (points);
  read pos := 0  .

plot two dim pic:
  WHILE read pos < pic length
  REP plot two dim position PER  .

plot two dim position :
  read pos INCR 1;
  SELECT key OF
  CASE draw key:   draw (next real, next real)
  CASE move key:   move (next real, next real)
  CASE move r key: move r (next real, next real)
  CASE draw r key: draw r (next real, next real)
  CASE text key:   draw (next text, next real, next real, next real)
  CASE bar 2 key:  bar (next real, next real, next int) 
  CASE bar 3 key:  bar (next real, next real, next real, next int) 
  CASE circle key: circle (next real, next real, next real, next int) 
  CASE mark key:   mark (next real, next int) 
  OTHERWISE errorstop (key error + text (key)) END SELECT  . 

plot three dim pic:
  WHILE read pos < pic length
  REP plot three dim position  PER  .

plot three dim position :
  read pos INCR 1;
  SELECT key OF
  CASE draw key:   draw (next real, next real, next real)
  CASE move key:   move (next real, next real, next real)
  CASE move r key: move r (next real, next real, next real)
  CASE draw r key: draw r (next real, next real, next real)
  CASE text key:   draw (next text, next real, next real, next real)
  CASE bar 2 key:  bar (next real, next real, next int) 
  CASE bar 3 key:  bar (next real, next real, next real, next int)
  CASE circle key: circle (next real, next real, next real, next int) 
  CASE mark key:   mark (next real, next int) 
  OTHERWISE errorstop (key error + text (key)) END SELECT  . 

key:
  code (points SUB read pos)  .

END PROC plot;

REAL PROC next real:
  read pos INCR 8;
  subtext (points, read pos-7, read pos) RSUB 1  .
END PROC next real;

INT PROC next int:
  read pos INCR 2;
  subtext (points, read pos-1, read pos) ISUB 1  .
END PROC next int;

TEXT PROC next text:
  INT CONST text length :: next int;
  read pos INCR text length;
  subtext (points, read pos-text length+1, read pos)  .
END PROC next text;

PROC plot (TEXT CONST name) :
  PICFILE VAR p :: old (name);
  plot (p);
END PROC plot;

PROC plot (PICFILE VAR p) :
  set projektion;
  disable stop;
  begin plot;
  clear screen;
  plot pictures (p);
  errorcheck;
  end plot  .

set projektion:
  ROW 3 ROW 2 REAL VAR size;
  ROW 2 ROW 2 REAL VAR limit;
  ROW 4 REAL VAR angles;
  ROW 2 REAL VAR oblique;
  ROW 3 REAL VAR perspective;

  get values (p, size, limit, angles, oblique, perspective);
  set values (size, limit, angles, oblique, perspective)  .

clear screen:
  INT VAR x0, y0, x1, y1, h max, v max;
  REAL VAR x cm, y cm;

  IF background (p) > -1
  THEN clear
  ELSE drawing area (x cm, y cm, h max, v max);
       new values (x cm, y cm, h max, v max, x0, x1 , y0, y1);
       set range (max (0, x0), max (0, y0), min (h max, x1), min (v max, y1))
  FI  .

errorcheck:
  IF is error
  THEN line;
       put line ("Erorr at PICTURE No " + text (picture no (p)));
  FI  .

END PROC plot;

PROC plot pictures (PICFILE VAR p):
  INT VAR back :: abs (background (p)), no;
  enable stop;
  FOR no FROM 1 UPTO pictures (p)
  REP to pic (p, no);
      read picture (p, pic);

      IF this picture is ok
      THEN set pen of pic;
           plot (pic)
      FI
  PER  .

this picture is ok:
  pen (pic) <> 0 AND length (pic) > 0  .

set pen of pic:
  INT VAR colour, thick, type;
  selected pen (p, pen (pic), colour, thick, type);
  set pen (back, colour, thick, type)  .

END PROC plot pictures;

END PACKET plot