Initial import

1 files changed, 324 insertions, 0 deletions

diff --git a/system/std.graphik/1.8.7/src/graphik editor b/system/std.graphik/1.8.7/src/graphik editor
new file mode 100644
index 0000000..7aa6e33
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/graphik editor
@@ -0,0 +1,324 @@
+PACKET graphic editor DEFINES  graphic,           (*Autor: H.Indenbirken *)
+                               picfile, picture,  (*Stand: 26.02.1985    *)
+
+                               neu zeichnen,
+ 
+                               UP, DOWN, T,
+
+                               pen, select pen, selected pen, background,
+                               extrema pic, extrema picfile:
+ 
+
+ 
+LET norm cmd = ""1""27""3""10""9"epb"16"",
+    hop cmd = ""2""10""12""1"",
+    bell    = ""7"",
+    esc     = ""27"";
+
+PICFILE VAR p;
+PICTURE VAR pic;
+TEXT VAR command :: "", old command :: "", char, headline :: "";
+BOOL VAR within edit :: FALSE, new plot :: FALSE;
+ROW 3 ROW 2 REAL VAR size;
+ROW 2 ROW 2 REAL VAR limits;
+ROW 4 REAL VAR angles;
+ROW 2 REAL VAR oblique;
+ROW 3 REAL VAR perspective;
+
+PROC open graphic (TEXT CONST name, DATASPACE CONST ds):
+  p := ds; 
+  get values (p, size, limits, angles, oblique, perspective); 
+  head line := ""1""15"LEN       ................................ DIM    PEN    .."14" Picture      "15""14"";
+  replace (head line, 32-LENGTH name DIV 2, name);
+  new plot := TRUE;
+  within edit := TRUE
+END PROC open graphic;
+
+PROC graphic:
+  graphic (last param)
+END PROC graphic;
+
+PROC graphic (TEXT CONST name) :
+  IF NOT exists (name) 
+  THEN IF yes ("Soll ein neuer Picfile eingerichtet werden")
+       THEN graphic (new (name), name) FI
+  ELSE graphic (old (name), name) FI
+
+END PROC graphic;
+
+PROC graphic (DATASPACE CONST f, TEXT CONST name) :
+  open graphic (name, f);
+  reset;
+  kommandos bearbeiten;
+  within edit := FALSE  .
+
+kommandos bearbeiten :
+  REP IF new plot
+      THEN plot (p);
+           new plot := FALSE
+      FI;
+      read picture (p, pic);
+      out head line;
+      inchar (command);
+      do command
+  PER  .
+ 
+out head line:
+  replace (headline,  7, text (length (pic), 5));
+  replace (headline, 50, text (dim (pic), 1));
+  replace (headline, 57, text (pen (pic), 2));
+  replace (headline, 72, text (picture no (p), 4));
+  out (head line)  .
+
+do command:
+  SELECT pos (norm cmd, command) OF 
+  CASE  1: hop commands
+  CASE  2: escape commands
+  CASE  3: position up
+  CASE  4: position down
+  CASE  5: position direct
+  CASE  6: extrema pic
+  CASE  7: selected pen (pen (pic));
+  CASE  8: out (1, 2, ""15""5"Hintergrundfarbe: " +
+           colour of (background (p)) + " "14"")
+  CASE  9: identify (pic);
+  OTHERWISE out (bell) ENDSELECT .
+
+position up :
+  IF is first picture (p)
+  THEN out (bell);
+  ELSE up (p) FI  .
+
+position down :
+  IF eof (p)
+  THEN out (bell)
+  ELSE down (p) FI  .
+ 
+position direct:
+   out (1, 68, "");
+   edit get (command, 4, 4);
+   to pic (p, int (command))  .
+
+hop commands :
+  inchar (command);
+  SELECT pos (hop cmd, command) OF 
+  CASE 1: to first pic (p)
+  CASE 2: to eof (p)
+  CASE 3: delete picture (p);
+          IF NOT new plot
+          THEN erase (pic) FI
+  CASE 4: new plot := TRUE
+  OTHERWISE out (bell) ENDSELECT  .
+
+escape commands :
+  inchar (command);
+  IF command = "q"
+  THEN LEAVE kommandos bearbeiten
+  ELIF command = "f"
+  THEN do (old command)
+  ELIF command = esc
+  THEN kommandomodus
+  ELSE do (kommando auf taste (command)) FI  .
+
+END PROC graphic;
+
+PROC kommandomodus:
+  command := "";
+  disable stop;
+  REP get command;
+      do (command)
+  UNTIL command executed PER;
+
+  IF new values
+  THEN get values (size, limits, angles, oblique, perspective); 
+       set values (p, size, limits, angles, oblique, perspective); 
+       new plot := new plot OR new values
+  FI  .
+
+get command:
+  REP out (1, 2, ""15"Gib Graphikkommando: ");
+      edit get (command, 0, 54, "", "k", char);
+      out (""14"");
+      out (1, 2, ""5"");
+
+      IF char = ""13""
+      THEN LEAVE get command
+      ELIF char = ""27"k"
+      THEN command := old command FI
+  PER  .
+
+command executed:
+  IF is error
+  THEN out (1, 1, error message);
+       clear error;
+       FALSE
+  ELSE old command := command;
+       TRUE
+  FI  .
+
+END PROC kommandomodus;
+
+PROC out (INT CONST x, y, TEXT CONST t):
+  cursor (x, y);
+  out (t)
+END PROC out;
+
+TEXT PROC colour of (INT CONST colour):
+  SELECT colour OF
+  CASE 0: "löschen"
+  CASE 1: "std"
+  CASE 2: "rot"
+  CASE 3: "blau"
+  CASE 4: "grün"
+  CASE 5: "schwarz"
+  CASE 6: "weiß"
+  OTHERWISE text (colour) ENDSELECT  .
+END PROC colour of;
+
+TEXT PROC linetype of (INT CONST linetype):
+  SELECT linetype OF
+  CASE 0: "unsichtbar"
+  CASE 1: "durchgehend"
+  CASE 2: "gepunktet"
+  CASE 3: "kurz gestrichelt"
+  CASE 4: "lang gestrichelt"
+  CASE 5: "strichpunkt"
+  OTHERWISE text (linetype) ENDSELECT  .
+END PROC linetype of;
+
+PICFILE PROC picfile :
+  IF NOT within edit
+  THEN errorstop ("Not within editmode") FI;
+  p
+END PROC picfile;
+
+PICTURE PROC picture :
+  IF NOT within edit
+  THEN errorstop ("Not within editmode") FI;
+  pic
+END PROC picture;
+
+PROC neu zeichnen:
+  new plot := TRUE
+END PROC neu zeichnen;
+
+OP UP (INT CONST distance):
+  up (p, distance);
+  read picture (p, pic) 
+END OP UP;
+
+OP DOWN (INT CONST distance):
+  down (p, distance);
+  read picture (p, pic) 
+END OP DOWN;
+
+OP T (INT CONST n):
+  to pic (p, n);
+  read picture (p, pic) 
+END OP T;
+ 
+PROC pen (INT CONST n):
+  IF NOT new plot
+  THEN erase (pic) FI;
+
+  pen (pic, n);
+  write picture (p, pic);
+
+  IF NOT new plot
+  THEN show (pic) FI
+END PROC pen;
+
+PROC select pen (INT CONST n, colour, thickness, linetype, BOOL CONST hidden):
+  select pen (p, n, colour, thickness, linetype, hidden);
+  new plot := TRUE
+END PROC select pen;
+
+PROC select pen (INT CONST n, colour, thickness, linetype):
+  select pen (p, n, colour, thickness, linetype, FALSE);
+  new plot := TRUE
+END PROC select pen;
+
+PROC selected pen (INT CONST n, INT VAR colour, thickness, linetype,
+                   BOOL VAR hidden):
+  selected pen (p, n, colour, thickness, linetype, hidden);
+END PROC selected pen;
+
+PROC selected pen (INT CONST n):
+  INT VAR colour, thickness, linetype;
+  BOOL VAR hidden;
+  selected pen (p, n, colour, thickness, linetype, hidden);
+  out (1, 2, ""5""15"PEN #" + text (n) + ":  Farbe: " + colour of (colour) +
+             ", Dicke " + text (thickness) + ", Linientyp " + linetype of (linetype) +
+             hidden text + " "14"")  .
+
+hidden text:
+  IF hidden
+  THEN ". "
+  ELSE ", nicht sichtbare Linien werden unterdrückt." FI  .
+
+END PROC selected pen;
+
+INT PROC background:
+  background (p)
+END PROC background;
+
+PROC background (INT CONST n):
+  new plot := n <> background (p);
+  background (p, n)
+END PROC background;
+
+PROC extrema pic:
+  REAL VAR x min, x max, y min, y max, z min, z max;
+  IF dim (pic) = 2
+  THEN extrema (pic, x min, x max, y min, y max);
+       out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + 
+                  "]  [" + text (y min) + "," + text (y max) + "] "14"")
+  ELSE extrema (pic, x min, x max, y min, y max, z min, z max);
+       out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + 
+                  "]  [" + text (y min) + "," + text (y max) + 
+                  "]  [" + text (z min) + "," + text (z max) +"] "14"") 
+  FI
+END PROC extrema pic;
+
+PROC extrema picfile:
+  REAL VAR x min, x max, y min, y max, z min, z max;
+  extrema (p, x min, x max, y min, y max, z min, z max);
+  out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + 
+             "]  [" + text (y min) + "," + text (y max) + 
+             "]  [" + text (z min) + "," + text (z max) +"] "14"") 
+END PROC extrema picfile;
+
+PROC identify (PICTURE CONST pic):
+  begin plot;
+  hidden lines (TRUE);
+  pen (background (p), 1, 1, 2);
+  plot (pic);
+  end plot
+END PROC identify;
+
+PROC erase (PICTURE CONST pic):
+  INT VAR colour, thickness, linetype;
+  BOOL VAR hidden;
+
+  selected pen (p, pen (pic), colour, thickness, linetype, hidden); 
+  begin plot;
+  hidden lines (TRUE);
+  pen (background (p), 0, thickness, linetype);
+  plot (pic);
+  end plot
+END PROC erase;
+
+PROC show (PICTURE CONST pic):
+  INT VAR colour, thickness, linetype;
+  BOOL VAR hidden;
+
+  selected pen (p, pen (pic), colour, thickness, linetype, hidden); 
+  begin plot;
+  hidden lines (TRUE);
+  pen (background (p), colour, thickness, linetype);
+  plot (pic);
+  end plot
+END PROC show;
+
+END PACKET graphic editor;
+