From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 11 Feb 2019 11:49:19 +0100
Subject: Add source files from Michael

---
 app/mpg/1987/src/PLOTSPOL.ELA | 129 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 129 insertions(+)
 create mode 100644 app/mpg/1987/src/PLOTSPOL.ELA

(limited to 'app/mpg/1987/src/PLOTSPOL.ELA')

diff --git a/app/mpg/1987/src/PLOTSPOL.ELA b/app/mpg/1987/src/PLOTSPOL.ELA
new file mode 100644
index 0000000..f15b13c
--- /dev/null
+++ b/app/mpg/1987/src/PLOTSPOL.ELA
@@ -0,0 +1,129 @@
+PACKET plotten spool DEFINES plot:                  #Autor: H.Indenbirken #
+                                                    #Stand: 10.02.1985    #
+LET draw key      = 1,
+    move key      = 2,
+    text key      = 3,
+    move r key    = 4,
+    draw r key    = 5,
+    move cm key   = 6, 
+    draw cm key   = 7,
+    move cm r key = 8,
+    draw cm r key = 9,
+    bar key       = 10,
+    circle key    = 11,
+    max length    = 32000;
+
+
+TYPE PICTURE = STRUCT (INT dim, pen, TEXT points);
+
+
+INT VAR i, read pos, key;
+REAL VAR x, y, z;
+TEXT VAR t;
+
+
+PROC plot (PICTURE CONST p) :
+  INT CONST pic length := length (p.points);
+  read pos := 0;
+  IF p.dim = 2
+  THEN plot two dim pic
+  ELSE plot three dim pic FI  .
+
+plot two dim pic:
+  WHILE read pos < pic length
+  REP plot two dim position PER  .
+
+plot two dim position :
+  read pos INCR 1;
+  SELECT code (p.points SUB read pos) 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 move cm key : move cm (next real, next real)
+  CASE draw cm key : draw cm (next real, next real)
+  CASE move cm r key : move cm r (next real, next real)
+  CASE draw cm r key : draw cm r (next real, next real)
+  CASE text key : draw (next text, next real, next real, next real)
+  CASE bar key : bar (next real, next real, next int) 
+  CASE circle key : circle (next real, next real, next real, next int) 
+  OTHERWISE errorstop ("wrong key code") 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 code (p.points SUB read pos) 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 move cm key : move cm (next real, next real)
+  CASE draw cm key : draw cm (next real, next real)
+  CASE move cm r key : move cm r (next real, next real)
+  CASE draw cm r key : draw cm r (next real, next real)
+  CASE text key : draw (next text, next real, next real, next real)
+  CASE bar key : bar (next real, next real, next int) 
+  CASE circle key : circle (next real, next real, next real, next int) 
+  OTHERWISE errorstop ("wrong key code") END SELECT  . 
+
+next real :
+  read pos INCR 8;
+  subtext (p.points, read pos-7, read pos) RSUB 1  .
+
+next int :
+  read pos INCR 2;
+  subtext (p.points, read pos-1, read pos) ISUB 1  .
+
+next text :
+  INT CONST text length :: next int;
+  read pos INCR text length;
+  subtext (p.points, read pos-text length+1, read pos)  .
+ 
+END PROC plot;
+
+LET max pics = 1024,
+    pic dataspace = 1102;
+
+
+TYPE PICFILE = BOUND STRUCT (INT size, pos, background,
+                             ROW 16 ROW 3 INT pens,
+                             ROW 16 BOOL hidden,
+                             ROW 3 ROW 2 REAL sizes,
+                             ROW 2 ROW 2 REAL limits,
+                             ROW 4 REAL angles,
+                             ROW 2 REAL obliques,
+                             ROW 3 REAL perspectives
+                             ROW max pics PICTURE pic);
+
+PICFILE VAR p;
+
+PROC plot (DATASPACE VAR ds):
+  IF type (ds) = pic dataspace
+  THEN CONCR (p) :: old (ds);
+       plot (p)
+  ELSE errorstop ("Dataspace is no PICFILE") FI;
+END PROC plot;
+
+PROC plot (PICFILE VAR p) :
+  set values (p.sizes, p.limits, p.angles, p.obliques,
+              p.perspectives);
+  begin plot;
+  clear;
+  FOR i FROM 1 UPTO p.size
+  REP IF pen (p.pic [i]) <> 0
+      THEN plot pic FI
+  PER;
+  end plot  .
+
+plot pic:
+  pen (p.background, p.pens (pen (p.pic (i)))(1),
+       p.pens (pen (p.pic (i)))(2), p.pens (pen (p.pic (i)))(3));
+  hidden lines (p.hidden [pen (p.pic [i])]);
+  plot (p.pic (i))  .
+
+END PROC plot;
+
+END PACKET plotten spool 
-- 
cgit v1.2.3