Initial import

1 files changed, 247 insertions, 0 deletions

diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Plotter b/system/std.graphik/1.8.7/src/GRAPHIK.Plotter
new file mode 100644
index 0000000..a55e515
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Plotter
@@ -0,0 +1,247 @@
+PACKET plotter DEFINES plotter:               (*Autor: Heiko Indenbirken *)
+                                              (*Stand:    13.10.89/22:31 *)
+                                              (*Änderung: 08.09.86/15:47 *)
+
+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 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;
+
+
+(*                                                                       *)
+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 plotter (TEXT CONST name) :
+  PICFILE VAR p :: old (name);
+  plotter (p);
+END PROC plotter;
+
+PROC plotter (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 plotter;
+
+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 plotter
+
+