summaryrefslogtreecommitdiff
path: root/system/std.graphik/1.8.7/src/GRAPHIK.Plotter
diff options
context:
space:
mode:
authorLars-Dominik Braun <lars@6xq.net>2019-02-04 13:09:03 +0100
committerLars-Dominik Braun <lars@6xq.net>2019-02-04 13:09:03 +0100
commit04e68443040c7abad84d66477e98f93bed701760 (patch)
tree2b6202afae659e773bf6916157d23e83edfa44e3 /system/std.graphik/1.8.7/src/GRAPHIK.Plotter
downloadeumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.gz
eumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.bz2
eumel-src-04e68443040c7abad84d66477e98f93bed701760.zip
Initial import
Diffstat (limited to 'system/std.graphik/1.8.7/src/GRAPHIK.Plotter')
-rw-r--r--system/std.graphik/1.8.7/src/GRAPHIK.Plotter247
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
+
+