summaryrefslogtreecommitdiff
path: root/system/std.graphik/1.8.7
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
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')
-rw-r--r--system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik831
-rw-r--r--system/std.graphik/1.8.7/doc/GRAPHIK.book897
-rw-r--r--system/std.graphik/1.8.7/doc/graphik beschreibung661
-rw-r--r--system/std.graphik/1.8.7/source-disk1
-rw-r--r--system/std.graphik/1.8.7/src/Beispiel.Kreuz41
-rw-r--r--system/std.graphik/1.8.7/src/Beispiel.Sinus45
-rw-r--r--system/std.graphik/1.8.7/src/GRAPHIK.Picfile738
-rw-r--r--system/std.graphik/1.8.7/src/GRAPHIK.Plot285
-rw-r--r--system/std.graphik/1.8.7/src/GRAPHIK.Plotter247
-rw-r--r--system/std.graphik/1.8.7/src/GRAPHIK.Server97
-rw-r--r--system/std.graphik/1.8.7/src/GRAPHIK.Transform366
-rw-r--r--system/std.graphik/1.8.7/src/GRAPHIK.vektor plot506
-rw-r--r--system/std.graphik/1.8.7/src/HP7475.plot254
-rw-r--r--system/std.graphik/1.8.7/src/PC.plot758
-rw-r--r--system/std.graphik/1.8.7/src/ZEICHENSATZbin0 -> 11776 bytes
-rw-r--r--system/std.graphik/1.8.7/src/gen Graphik16
-rw-r--r--system/std.graphik/1.8.7/src/gen Plotter16
-rw-r--r--system/std.graphik/1.8.7/src/graphik editor324
18 files changed, 6083 insertions, 0 deletions
diff --git a/system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik b/system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik
new file mode 100644
index 0000000..36fa31e
--- /dev/null
+++ b/system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik
@@ -0,0 +1,831 @@
+#type ("trium10")##limit (13.5)#
+#block##start(2.5,2.5)##pagelength(21.0)##pagenr("%",418)##setcount(22)#
+#headeven#
+% EUMEL-Benutzerhandbuch
+
+
+
+#end#
+#headodd#
+ TEIL 10: Graphik %
+
+
+
+#end#
+#type("triumb14")#
+#ib(9)##center#TEIL 10: Graphik#ie(9)#
+#type("trium10")#
+#free(2.0)#
+#on("bold")##ib(9)##type("triumb14")#1. Übersicht#ie(9)#
+#type("trium10")#
+
+ #limit(12.0)##on("italics")#Dieser Teil des Benutzer-Handbuchs beschreibt die Graphik-
+ Möglichkeiten des EUMEL-Systems. Die Graphik-Pakete ge­
+ hören nicht zum EUMEL-Standard, sondern sind Anwender­
+ pakete, die im Quellcode ausgeliefert und von jeder Installation
+ in das System aufgenommen werden können. Unter Umständen
+ müssen Programme erstellt werden, die die Anpassungen für
+ spezielle graphische Geräte einer Installation vornehmen.
+#limit(13.5)##off("italics")#
+
+Das Graphik-System ermöglicht es, durch ELAN-Programme geräteunab­
+hängige Informationen für Zeichnungen ("#ib#Graphiken#ie#") zu erstellen. Die Graphik
+erzeugenden Programme brauchen dabei keine gerätespezifischen Größen sowie
+gerätespezifischen Unterprogramme zu enthalten. Sie befassen sich somit
+ausschließlich mit der Erzeugung der problemorientierten Information für die
+Konstruktion einer Zeichnung. Nach der geräteunabhängigen Erzeugung einer
+Graphik kann diese auf unterschiedlichen Geräten ausgegeben werden (z.B. erst
+auf einem Terminal zur Kontrolle und dann auf einem Plotter).
+
+Die EUMEL-Graphik umfaßt zwei- und dreidimensionale Graphik. Dabei
+entspricht die Y-Achse bei der zweidimensionalen Graphik der Z-Achse (Höhe)
+bei der dreidimensionalen Graphik. Im dreidimensionalen Fall sind perspektivi­
+sche, orthografische und schiefwinklige Projektionen mit beliebigen Betrach­
+tungswinkeln möglich.
+
+Bei der EUMEL-Graphik wird streng zwischen Erzeugung und Manipulation von
+Graphiken (Bildern) auf der einen und Darstellung der erzeugten Bilder auf der
+anderen Seite unterschieden. Für die Erzeugung und Manipulation der Graphi­
+ken existiert der Typ PICTURE, für die Darstellung der Bilder gibt es den Typ
+PICFILE. Dabei müssen Ausschnitt, Maßstab, Betrachtungswinkel und Pro­
+jektionsart erst bei der Darstellung festgelegt werden. Diese Konstruktion des
+Graphik-Systems hat folgende Vorteile:
+
+a) Programme, die Graphik-Informationen erzeugen, sind geräteunabhängig.
+ Das bedeutet, daß Programmierer sich ausschließlich mit einem logischen
+ Problem zu befassen brauchen und nicht mit gerätespezifischen Besonder­
+ heiten.
+
+b) Graphiken können auf mehreren unterschiedlich gearteten Geräten mehrmals
+ dargestellt werden, ohne daß das erzeugende Programm geändert oder neu
+ gestartet werden muß. Z.B. kann ein Programmierer eine Graphik erst auf
+ dem Terminal auf Richtigkeit und Größenverhältnisse überprüfen, bevor er die
+ Zeichnung auf einem Plotter zeichnen läßt.
+
+c) Graphiken können leicht geändert (z.B. vergrößert oder in eine Richtung
+ gestreckt) werden, ohne daß das erzeugende Programm erneut durchlaufen
+ werden muß. Zudem können Graphiken aneinander oder übereinander gelegt
+ werden.
+
+d) Graphiken mit unterschiedlichen Farben, Strichen usw. können leicht erzeugt
+ werden.
+
+e) Der Anschluß von neuen Graphik-Geräten durch Benutzer ist leicht möglich,
+ ohne daß die Graphik erzeugenden Programme modifiziert werden müssen.
+
+f) Plotter können wie Drucker an einen SPOOLER gehängt werden.
+
+g) Bilder können als PICFILEs gespeichert und versandt werden.
+#free(2.0)#
+#ib(9)##type("triumb14")#Erzeugung von Bildern#ie(9)#
+#type("trium10")#
+
+Bilder entstehen in Objekten vom Datentyp
+
+#type("modern12")#
+ PICTURE
+#type("trium10")#
+
+Diese müssen mit der Prozedur
+
+#type("modern12")#
+ nilpicture
+#type("trium10")#
+
+initialisiert werden. Sie enthalten dann ein leeres Bild, dessen Dimension noch
+nicht festgelegt ist. Die Dimension eines PICTUREs wird mit dem ersten
+Schreibzugriff ('move' oder 'draw') festgelegt. Ein PICTURE kann immer nur
+entweder zwei- oder dreidimensional sein. Außerdem kann einem PICTURE mit
+der Prozedur
+
+#type("modern12")#
+ pen
+#type("trium10")#
+
+genau ein virtueller Stift zugeordnet oder der aktuelle Stift erfragt werden.
+
+Die Erzeugung eines Bildes basiert auf dem Modell eines Plotters. Der (virtuelle)
+Zeichenstift kann mit
+
+#type("modern12")#
+ move
+#type("trium10")#
+
+ohne zu zeichnen an beliebige Stellen gefahren werden (reine Positionierung).
+Mit
+
+#type("modern12")#
+ draw
+#type("trium10")#
+
+wird der Stift veranlaßt, eine Linie von der aktuellen zur angegebenen Zielposi­
+tion zu zeichnen. 'move' löst also Bewegungen mit gehobenem, 'draw' solche mit
+gesenktem Stift aus. Um auch 'relatives' Zeichnen zu ermöglichen, existiert die
+Prozedur
+
+#type("modern12")#
+ where
+#type("trium10")#
+
+die die aktuelle Stiftposition liefert.
+#free(2.0)#
+#ib(9)##type("triumb14")#Manipulation von Bildern#ie(9)#
+#type("trium10")#
+
+Erstellte Bilder können als Ganzes manipuliert werden. Die Prozeduren
+
+#type("modern12")#
+ translate (* verschieben *)
+ stretch (* strecken bzw. stauchen *)
+ rotate (* drehen *)
+ reflect (* spiegeln *)
+#type("trium10")#
+
+verändern jeweils das ganze Bild. Es ist aber auch möglich, mehrere Bilder
+zusammenzufügen. Mit
+
+#type("modern12")#
+ CAT
+#type("trium10")#
+
+kann ein weiteres Bild angefügt werden. Dabei müssen allerdings beide
+PICTURE die gleiche Dimension haben. In solchen als ganzes manipulierten
+Bildern kann man ohne Einschränkung mit 'draw' und 'move' weiterzeichnen.
+#free(2.0)#
+#ib(9)##type("triumb14")#Darstellung#ie(9)#
+#type("trium10")#
+
+Für die Darstellung der erzeugten Bilder existiert der Typ
+
+#type("modern12")#
+ PICFILE
+#type("trium10")#
+
+Dieser besteht aus max. 128 PICTUREs, die mit den Prozeduren
+
+#type("modern12")#
+ put
+ get
+#type("trium10")#
+
+eingegeben bzw. ausgegeben werden können. PICFILE wird durch Datenräume
+realisiert, deshalb erfolgt die Assoziation an einen benannten Datenraum ähnlich
+wie beim FILE. Dafür wird die Prozedur
+
+#type("modern12")#
+ picture file
+#type("trium10")#
+
+verwandt. Ein neuer PICFILE enthält genau ein leeres PICTURE. Die Darstellung
+der PICFILEs auf Zeichengeräten erfolgt mit der Prozedur
+
+#type("modern12")#
+ plot
+#type("trium10")#
+
+Da die Graphiken aber in "Weltkoordinaten" erzeugt werden und die spätere
+Darstellung vollkommen unbeachtet bleibt, müssen gewisse Darstellungspara­
+meter für die Zeichnung gesetzt werden. Diese Parameter werden im PICFILE
+abgelegt und gelten jeweils für den gesamten PICFILE. Dadurch ist es möglich,
+einen PICFILE mit spezifizierter Darstellungsart über einen SPOOLER an einen
+Plotter zu senden oder die bei der letzten Betrachtung gewählte Darstellung mit
+in dem PICFILE gespeichert zu halten. Für die Darstellung können den virtuellen
+Stiften mit der Prozedur
+
+#type("modern12")#
+ select pen
+#type("trium10")#
+
+reale Stifte zugeordnet werden. Voreingestellt ist für alle virtuellen Stifte:
+Standardfarbe, Standardstärke, durchgängige Linie.
+
+Indem man einigen virtuellen Stiften den leeren Stift als realen Stift zuordnet,
+kann man einzelne PICTUREs ausblenden. Sowohl bei der Darstellung von
+zwei- als auch dreidimensionaler Graphik kann die gewählte Zeichenfläche auf
+dem Endgerät mit der Prozedur
+
+#type("modern12")#
+ viewport
+#type("trium10")#
+
+festgelegt werden. Voreingestellt ist das Quadrat mit der größtmöglichen Seiten­
+länge, d.h. der kürzeren Seite der hardwaremäßigen Zeichenfläche.
+#free(2.0)#
+#ib(9)##type("triumb14")#Darstellung zweidimensionaler Graphik#ie(9)#
+#type("trium10")#
+
+Bei der Darstellung zweidimensionaler Bilder muß der zu zeichnende Ausschnitt
+(das 'Fenster') angegeben werden. Mit der Prozedur
+
+#type("modern12")#
+ window
+#type("trium10")#
+
+wird durch Angabe der minimalen und maximalen X- bzw. Y-Koordinaten ein
+Fenster definiert. Da das so definierte Fenster auf die ganze (mit 'viewport'
+definierbare) Zeichenfläche abgebildet wird, ist der Abbildungsmaßstab durch das
+Zusammenspiel von 'viewport' und 'window' bestimmt. Da bei 'viewport' stan­
+dardmäßig das maximale Zeichenquadrat voreingestellt ist, wird in diesem Fall
+durch gleiche X- und Y-Fenstergröße eine winkeltreue Darstellung erreicht.
+#free(2.0)#
+#ib(9)##type("triumb14")#Darstellung dreidimensionaler Graphik#ie(9)#
+#type("trium10")#
+
+Im dreidimensionalen Fall wird das Fenster ebenfalls mit
+
+#type("modern12")#
+ window
+#type("trium10")#
+
+definiert, wobei dann allerdings auch der Bereich der dritten Dimension
+(Z-Koordinaten) zu berücksichtigen ist. Da die dreidimensionale Graphik auf
+eine zweidimensionale Fläche projiziert wird, können aber noch weitere Darstel­
+lungsparameter angegeben werden. Der Betrachtungswinkel wird mit Hilfe der
+Prozedur
+
+#type("modern12")#
+ view
+#type("trium10")#
+
+angegeben. Zur Spezifikation der gewünschten Projektionsart gibt es
+
+#type("modern12")#
+ orthographic (* orthographische Projektion *)
+ perspective (* perspektivische Projektion,
+ der Fluchtpunkt ist frei wählbar *)
+ oblique (* schiefwinklige Projektion *)
+#type("trium10")#
+#free(2.0)#
+#ib(9)##type("triumb14")#Beispiel (Sinuskurve)#ie(9)#
+#type("modern12")#
+
+ funktion zeichnen;
+ bild darstellen .
+
+funktion zeichen :
+ PICTURE VAR pic :: nilpicture;
+ REAL VAR x := -pi;
+ move (pic, x, sin (x));
+ REP x INCR 0.1;
+ draw (pic, x, sin (x))
+ UNTIL x >= pi PER .
+
+bild darstellen :
+ PICFILE VAR p :: picture file ("sinus");
+ window (p, -pi, pi, -1.0, 1.0);
+ put (p, pic);
+ plot (p) .
+#type("trium10")#
+#free(2.0)#
+#ib(9)##type("triumb14")#Beispiel (Würfel)#ie(9)#
+#type("modern12")#
+
+ wuerfel zeichen;
+ wuerfel darstellen.
+
+wuerfel zeichnen :
+ zeichne vorderseite;
+ zeichne rueckseite;
+ zeichne verbindungskanten.
+
+zeichne vorderseite :
+ PICTURE VAR vorderseite :: nilpicture;
+ move (vorderseite, 0.0, 0.0, 0.0);
+ draw (vorderseite, 1.0, 0.0, 0.0);
+ draw (vorderseite, 1.0, 0.0, 1.0);
+ draw (vorderseite, 0.0, 0.0, 1.0);
+ draw (vorderseite, 0.0, 0.0, 0.0).
+
+zeichne rueckseite :
+ PICTURE VAR rueckseite :: translate
+ (vorderseite, 0.0, 1.0, 0.0).
+
+zeichne verbindungskanten :
+ PICTURE VAR verbindungskanten :: nilpicture;
+ move (verbindungskanten, 0.0, 0.0, 0.0);
+ draw (verbindungskanten, 0.0, 1.0, 0.0);
+
+ move (verbindungskanten, 1.0, 0.0, 0.0);
+ draw (verbindungskanten, 1.0, 1.0, 0.0);
+
+ move (verbindungskanten, 1.0, 0.0, 1.0);
+ draw (verbindungskanten, 1.0, 1.0, 1.0);
+
+ move (verbindungskanten, 0.0, 0.0, 1.0);
+ draw (verbindungskanten, 0.0, 1.0, 1.0).
+
+wuerfel darstellen :
+ PICFILE VAR p := picture file ("wuerfel");
+ put (p, vorderseite);
+ put (p, rueckseite);
+ put (p, verbindungskanten);
+ window (p, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0);
+ view (p, 0.0, 40.0, 20.0);
+ orthographic (p);
+ plot (p).
+#type("trium10")#
+#free(2.0)#
+#ib(9)##type("triumb14")#Beschreibung der Graphik-Prozeduren#ie(9)#
+#type("trium10")#
+
+ #limit(12.0)##on("italics")#Zweidimensionale PICTUREs brauchen weniger Speicherplatz
+ als dreidimensionale. Daher werden in einigen Fehlermeldun­
+ gen unterschiedliche Größen angegeben.
+#limit(13.5)##off("italics")#
+
+:=
+ OP := (PICTURE VAR dest, PICTURE CONST source)
+ Zweck: Zuweisung
+
+ OP := (PICFILE VAR dest, DATASPACE CONST source)
+ Zweck: Assoziiert die PICFILE Variable 'dest' mit der DATASPACE CONST
+ 'source' und initialisiert die PICFILE Variable sofern nötig.
+ Fehlerfall:
+ * dataspace is no PICFILE
+ Der anzukoppelnde Datenraum hat einen falschen Typ.
+
+#ib#CAT#ie#
+ OP CAT (PICTURE VAR dest, PICTURE CONST source)
+ Zweck: Aneinanderfügen von zwei PICTURE's.
+ Fehlerfälle:
+ * OP CAT: left dimension <> right dimension
+ Es können nur PICTUREs mit gleicher Dimension angefügt werden.
+ * OP CAT: Picture overflow
+ Die beiden PICTURE überschreiten die maximale Größe eines
+ Pictures.
+
+#ib#act picture#ie#
+ PICTURE PROC act picture (PICFILE VAR p)
+ Zweck: Liefert das PICTURE des PICFILEs 'p', auf das mit 'backward' o.ä.
+ positioniert wurde.
+
+#ib#backward#ie#
+ PROC backward (PICFILE VAR p)
+ Zweck: Positioniert den PICFILE 'p' um ein PICTURE zurück.
+ Fehlerfall:
+ * backward at begin of file
+ Es wurde versucht vor den Anfang des PICFILEs zu positionieren.
+
+#ib#draw#ie#
+ PROC draw (PICTURE VAR pic, REAL CONST x, y)
+ Zweck: Die Prozedur zeichnet in dem (zweidimensionalen) Bild 'pic' eine
+ Linie von der aktuellen Position zur Position (x, y).
+ Fehlerfälle:
+ * picture overflow
+ Zu viele Befehle in einem PICTURE (z. Zeit max. 1927)
+ * picture is three dimensional
+ Ein PICTURE kann nur entweder zwei- oder dreidimensional sein.
+
+ PROC draw (PICTURE VAR pic, REAL CONST x, y, z)
+ Zweck: Die Prozedur zeichnet in dem (dreidimensionalen) Bild 'pic' eine
+ gerade Linie von der aktuellen Position zur Position (x, y, z).
+ Fehlerfälle:
+ * picture overflow
+ Zu viele Befehle in einem PICTURE (z. Zeit max. 1310)
+ * picture is only two dimensional
+ Ein PICTURE kann nur entweder zwei- oder dreidimensional sein.
+
+ PROC draw (PICTURE VAR pic, TEXT CONST text)
+ Zweck: Der angegebene Text wird in das Bild 'pic' eingetragen. Der Anfang
+ ist dabei die aktuelle Stiftposition. Diese wird nicht verändert.
+ Fehlerfall:
+ * picture overflow
+ Der Text paßt nicht mehr in das PICTURE.
+
+ PROC draw (PICTURE VAR pic, TEXT CONST text,
+ REAL CONST angle, height)
+ Zweck: Der angegebene Text wird unter dem Winkel 'angle' gegenüber der
+ Waagerechten und in der Größe 'height' in das PICTURE 'pic'
+ eingetragen. Der Anfang ist dabei die aktuelle Stiftposition. Diese
+ wird nicht verändert.
+ Fehlerfall:
+ * picture overflow
+ Der Text paßt nicht mehr in das PICTURE.
+
+ PROC draw (PICFILE VAR pic, REAL CONST x, y)
+ Zweck: Die Prozedur zeichnet in dem aktuellen (zweidimensionalen)
+ PICTURE des PICFILEs 'p' eine gerade Linie. Der (virtuelle) Stift wird
+ von der aktuellen Position zur Position (x, y) gefahren. Falls das
+ aktuelle PICTURE zu voll ist, wird automatisch auf das nächste
+ umgeschaltet.
+ Fehlerfälle:
+ * picfile overflow
+ Das letzte PICTURE ist voll (z. Zeit max. 128 PICTURE)
+ * picture is threedimensional
+ Das aktuelle PICTURE ist dreidimensional.
+
+ PROC draw (PICTFILE VAR pic, REAL CONST x, y, z)
+ Zweck: s. o.
+ Fehlerfälle:
+ * picfile overflow
+ Das letzte PICTURE ist voll (z. Zeit max. 128)
+ * picfile is only twodimensional
+ Das aktuelle PICTURE ist zweidimensional.
+
+ PROC draw (PICTFILE VAR pic, TEXT CONST text)
+ Zweck: Der angegebene Text wird in das aktuelle PICTURE des PICFILEs 'p'
+ eingetragen. Falls das aktuelle PICTURE zu voll ist, wird automatisch
+ auf das nächste umgeschaltet. Der Anfang ist dabei die aktuelle
+ Stiftposition. Diese wird nicht verändert.
+ Fehlerfall:
+ * picfile overflow
+ Das letzte PICTURE ist voll (z. Zeit max. 128)
+
+ PROC draw (PICFILE VAR pic, TEXT CONST text,
+ REAL CONST angle, height)
+ Zweck: Der angegebene Text wird unter dem Winkel 'angle' gegenüber der
+ Waagerechten und in der Größe 'height' in das aktuelle PICTURE
+ des PICFILES 'p' eingetragen. Falls das aktuelle PICTURE zu voll ist,
+ wird automatisch auf das nächste umgeschaltet. Der Anfang ist
+ dabei die aktuelle Stiftposition. Diese wird nicht verändert.
+ Fehlerfall:
+ * picfile overflow
+ Das letzte PICTURE ist voll (z. Zeit max. 128)
+
+#ib#eof#ie#
+ BOOL PROC eof (PICFILE CONST p)
+ Zweck: Liefert 'TRUE' wenn hinter das Ende des PICFILEs positioniert
+ wurde.
+
+#ib#extrema#ie#
+ PROC extrema (PICTURE CONST p,
+ REAL VAR x min, x max, y min, y max)
+ Zweck: Die Prozedur liefert die größten und kleinsten X- und Y-Koordi­
+ naten des PICTUREs 'p'. Diese werden in die Parameter 'x min', 'x
+ max', 'y min' und 'y max' eingetragen.
+
+ PROC extrema (PICTURE CONST p,
+ REAL VAR x min, x max, y min, y max, z min, z max)
+ Zweck: s.o.
+
+ PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max)
+ Zweck: s.o.
+
+ PROC extrema (PICFILE VAR p,
+ REAL VAR x min, x max, y min, y max, z min, z max)
+ Zweck: s.o.
+
+#ib#forward#ie#
+ PROC forward (PICFILE VAR p)
+ Zweck: Positioniert den PICFILE um ein PICTURE weiter.
+ Fehlerfall:
+ * picfile overflow
+ Es sollte hinter das Ende des PICFILEs positioniert werden.
+
+#ib#get#ie#
+ PROC get (PICFILE VAR p, PICTURE VAR pic)
+ Zweck: Liest ein PICTURE aus einem PICFILE und positioniert auf das
+ Nächste.
+ Fehlerfall:
+ * input after end of picfile
+ Es sollte nach dem Ende des Picfiles gelesen werden.
+
+#ib#move#ie#
+ PROC move (PICTURE VAR pic, REAL CONST x, y)
+ Zweck: Der (virtuelle) Stift wird zur Position (x, y) gefahren.
+ Fehlerfälle:
+ * picture overflow
+ Zu viele Befehle in einem PICTURE (z. Zeit max. 1927 'moves')
+ * picture is three dimensional
+ Ein PICTURE kann nur entweder zwei- oder dreidimensional sein.
+
+ PROC move (PICTURE VAR pic, REAL CONST x, y, z)
+ Zweck: Der (virtuelle) Stift wird zur Position (x, y, z) gefahren.
+ Fehlerfälle:
+ * picture overflow
+ Zu viele Befehle in einem PICTURE (z. Zeit max. 1310)
+ * picture is only twodimensional
+ Ein PICTURE kann nur entweder zwei- oder dreidimensional sein.
+
+ PROC move (PICFILE VAR p, REAL CONST x, y)
+ Zweck: Der (virtuelle) Stift wird zur Position (x, y) gefahren. Falls das aktuelle
+ PICTURE des PICFILEs 'p' zu voll ist, wird automatisch auf das
+ nächste umgeschaltet.
+ Fehlerfall:
+ * picfile overflow
+ Das letzte PICTURE ist voll (z. Zeit max. 128 PICTUREs)
+
+ PROC move (PICFILE VAR p, REAL CONST x, y, z)
+ Zweck: Der (virtuelle) Stift wird zur Position (x, y, z) gefahren. Falls das
+ aktuelle PICTURE des PICFILEs 'p' zu voll ist, wird automatisch auf
+ das nächste umgeschaltet.
+ Fehlerfall:
+ * picfile overflow
+ Das letzte PICTURE ist voll (z. Zeit max. 128 PICTUREs)
+
+#ib#nilpicture#ie#
+ PICTURE PROC nilpicture
+ Zweck: Die Prozedure liefert ein leeres PICTURE zur Initialisierung.
+
+#ib#oblique#ie#
+ PROC oblique (PICFILE VAR p, REAL CONST a, b)
+ Zweck: Bei dem (dreidimensionalen!) Bild 'p' wird 'schiefwinklig' als
+ gewünschte Projektionsart eingestellt. Dabei ist (a, b) der Punkt in
+ der X-Y-Ebene, auf den der Einheitsvector in Z-Richtung
+ abgebildet werden soll.
+
+#ib#orthographic#ie#
+ PROC orthographic (PICFILE VAR p)
+ Zweck: Bei dem (dreidimensionalen!) Bild 'p' wird "orthografisch" als Pro­
+ jektionsart eingestellt. Bei der orthografischen Projektion wird ein
+ dreidimensionaler Körper mit parallelen Strahlen senkrecht auf die
+ Projektionsebene abgebildet.
+
+#ib#pen#ie#
+ INT PROC pen (PICTURE CONST pic)
+ Zweck: Liefert die Nummer des 'virtuellen Stifts'.
+
+ PICTURE PROC pen (PICTURE CONST pic, INT CONST pen)
+ Zweck: Liefert ein PICTURE mit dem Inhalt 'pic' und dem 'virtuellen Stift' mit
+ der Nummer 'pen'. Möglich sind die Nummern 1 - 16.
+ Fehlerfälle:
+ * PROC pen: pen [No] < 1
+ Der gewünschte Stift ist kleiner als 1.
+ * PROC pen: pen [No] > 16
+ Der gewünschte Stift ist größer als 16.
+
+#ib#perspective#ie#
+ PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz)
+ Zweck: Bei den dreidimensionalen PICTUREs des PICFILE's 'p' wird
+ "perspektivisch" als gewünschte Projektionsart eingestellt. Der Punkt
+ (cx, cy, cz) ist der Fluchtpunkt der Projektion, d.h. alle Parallelen zur
+ Blickrichtung schneiden sich in diesem Punkt.
+
+#ib#pic no#ie#
+ INT PROC pic no (PICFILE CONST p)
+ Zweck: Liefert die Nummer des aktuellen PICTUREs.
+
+#ib#picture file#ie#
+ DATASPACE PROC picture file (TEXT CONST name)
+ Zweck: Die Prozedur dient zur Assoziation eines benannten Datenraumes mit
+ einem PICFILE (s. Operator ':=').
+
+#ib#plot#ie#
+ PROC plot (TEXT CONST name)
+ Zweck: Der PICFILE mit dem Namen 'name' wird entspechend der angege­
+ benen Darstellungsart gezeichnet. Diese Parameter ('perspective',
+ 'orthographic', 'oblique', 'view', 'window' etc.) müssen vorher
+ eingestellt werden.
+ Fehlerfall:
+ * FILE does not exist
+ Es existiert kein PICFILE mit dem Namen 'name'
+
+ PROC plot (PICFILE VAR p)
+ Zweck: Der PICFILE 'p' wird entspechend der angegebenen Darstellungsart
+ gezeichnet. Diese Parameter müssen vorher eingestellt werden.
+
+ #on("bold")#Zweidimensional:
+#off("bold")#
+ obligat: 'window' (zweidimensional)
+ optional: 'view' (zweidimensional)
+ 'select pen'
+ 'viewport'
+
+ #on("bold")#Dreidimensional:
+#off("bold")#
+ obligat: 'window' (dreidimensional)
+ optional: 'view' (dreidimensional)
+ 'orthographic', 'perspective', 'oblique'
+ 'viewport'
+ 'select pen'
+
+#ib#put#ie#
+ PROC put (PICFILE VAR p, PICTURE CONST pic)
+ Zweck: Schreibt ein PICTURE in einen PICFILE und positioniert um eins
+ vor.
+ Fehlerfall:
+ * picfile overflow
+ Der PICFILE ist voll. (z. Z. max. 128 PICTURE)
+
+#ib#reset#ie#
+ PROC reset (PICFILE VAR p)
+ Zweck: Positioniert auf den Anfang eines Picfiles.
+
+#ib#rotate#ie#
+ PICTURE PROC rotate (PICTURE CONST pic, REAL CONST alpha)
+ Zweck: Das PICTURE 'pic' wird um den Punkt (0, 0) um den Winkel 'alpha'
+ (im Gradmaß) im mathematisch positiven Sinn gedreht.
+
+ PICTURE PROC rotate (PICTURE CONST pic,
+ REAL CONST alpha, beta, gamma)
+ Zweck: Das dreidimensionale PICTURE 'pic' wird um den Winkel 'alpha',
+ 'beta' oder 'gamma' im mathematisch positiven Sinn gedreht. Der
+ Winkel 'alpha' dreht um die X-Achse, der Winkel 'beta' um die
+ Y-Achse und 'gamma' um die Z-Achse. Es darf dabei nur jeweils
+ ein Winkel von 0.0 verschieden sein. Alle Winkel werden im
+ Gradmaß angegeben.
+
+#ib#select pen#ie#
+ PROC select pen (PICFILE VAR p,
+ INT CONST pen, colour, thickness, linetype)
+ Zweck: Für die Darstellung des Bildes 'p' soll dem "virtuellen Stift" 'pen' ein
+ realer Stift zugeordnet werden, der möglichst die Farbe 'colour' und
+ die Dicke 'thickness' hat und dabei Linien mit dem Typ 'line type'
+ zeichnet. Es wird die beste Annäherung für das Ausgabegerät für
+ diese Parameter genommen. Dabei gelten folgende Vereinbarun­
+ gen:
+
+ Farbe: negative Farben setzten den Hintergrund, positive Farben
+ zeichnen im Vordergrund.
+
+ 0 Löschstift (falls vorhanden)
+ 1 Standardfarbe des Endgeräts (schwarz oder weiß)
+ 2 rot
+ 3 blau
+ 4 grün
+ 5 schwarz
+ 6 weiß > 20 nicht normierte Sonderfarben
+
+ Dicke: 0
+ Standardstrichstärke des Endgerätes > 0
+ Strichstärke in 1/10 mm
+
+ Typ:
+ 0 keine sichtbare Linie
+ 1 durchgängige Linie
+ 2 gepunktete Linie
+ 3 kurz gestrichelte Linie
+ 4 lang gestrichelte Linie
+ 5 Strichpunktlinie
+
+ Die hier aufgeführten Möglichkeiten müssen nicht an allen grafischen
+ Endgeräten vorhanden sein. Der geräteabhängige Graphik-Treiber
+ wählt jeweils die für ihn bestmögliche Annäherung.
+
+ Fehlerfälle:
+ * pen < 1
+ * pen > 16
+
+#ib#size#ie#
+ INT PROC size (PICFILE CONST p)
+ Zweck: Liefert die aktuelle Größe eines PICFILEs in Bytes.
+
+#ib#stretch#ie#
+ PICTURE PROC stretch (PICTURE CONST pic, REAL CONST xc, yc)
+ Zweck: Das PICTURE 'pic' wird in X-Richtung um den Faktor 'xc', in
+ Y-Richtung um den Faktor 'yc' gestreckt (bzw. gestaucht). Dabei
+ bewirkt der Faktor
+ c > 1 eine Streckung
+ 0 < c < 1 eine Stauchung
+ c < 0 zusätzlich eine Achsenspiegelung
+
+ PICTURE PROC stretch (PICTURE CONST pic, REAL CONST xc, yc, zc)
+ Zweck: Das dreidimensionale PICTURE 'pic' wird entsprechend den
+ angegeben Faktoren 'xc', 'yc' und 'zc' gestreckt. Wirkung s.o.
+
+#ib#translate#ie#
+ PICTURE PROC translate (PICTURE CONST pic, REAL CONST dx, dy)
+ Zweck: Das PICTURE 'pic' wird um 'dx' und 'dy' verschoben.
+ Fehlerfall:
+ * picture is threedimensional
+ 'pic' ist dreidimensional.
+
+ PICTURE PROC translate (PICTURE CONST pic, REAL CONST dx, dy, dz)
+ Zweck: Das PICTURE 'pic' wird um 'dx', 'dy' und 'dz' verschoben.
+ Fehlerfall:
+ * picture is twodimensional
+ Das PICTURE 'pic' ist zweidimensional
+
+#ib#two dimensional#ie#
+ PROC two dimensional (PICFILE VAR p)
+ Zweck: Setzt als Projektionsart zweidimensional.
+
+#ib#view#ie#
+ PROC view (PICFILE VAR p, REAL CONST alpha, phi, theta)
+ Zweck: Dreidimensionale Bilder werden häufig nicht direkt von vorne
+ dargestellt, sondern für die Betrachtung gedreht. Mit der Prozedur
+ 'view' kann diese Betrachtungsrichtung durch die Polarwinkel 'phi'
+ und 'theta' angegeben werden. Mit dem Winkel 'alpha' kann dann
+ das Bild um den Mittelpunkt der Zeichenfläche gedreht werden.
+ Dadurch kann ein Bild auch auf einem Terminal hochkant gestellt
+ werden. Voreingestellt ist 'phi = 0, theta = 0 und alpha = 0', d.h.
+ direkt von oben.
+
+ Im Gegensatz zu 'rotate' hat 'view' keine Wirkung auf das eigentli­
+ che Bild (PICFILE), sondern nur auf die gewählte Darstellung. So
+ addieren sich zwar aufeinanderfolgende "Rotationen", 'view' aber
+ geht immer von der Nullstellung aus. Auch kann das Bild durch eine
+ "Rotation" ganz oder teilweise aus oder in das Darstellungsfenster
+ ('window') gedreht werden. Bei 'view' verändern sich die Koordina­
+ ten der Punkte nicht, d.h. das Fenster wird mitgedreht.
+
+#ib#viewport#ie#
+ PROC viewport (PICFILE VAR p,
+ REAL CONST hormin, hormax, vertmin, vertmax)
+ Zweck: Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt
+ werden soll, wird spezifiziert. Dabei wird sowohl die Größe als auch
+ die relative Lage der Zeichenfläche definiert. Der linke untere
+ Eckpunkt der physikalischen Zeichenfläche des Gerätes hat die
+ Koordinaten (0.0, 0.0). Die definierte Zeichenfläche erstreckt sich
+
+#type("modern12")#
+ 'hormin' - 'hormax' in der Horizontalen,
+ 'vertmin' - 'vertmax' in der Vertikalen.
+#type("trium10")#
+
+ So liegt der linke untere Eckpunkt dann bei (hormin, vertmin), der
+ rechte obere bei (hormax, vertmax).
+
+ Damit sowohl geräteunabhängige als auch maßstabsgerechte
+ Zeichnungen möglich sind, können die Koordinaten in zwei Arten
+ spezifiziert werden :
+
+ a) Gerätekoordinaten
+ Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei
+ hat die kürzere Seite der physikalischen Zeichenfläche defini­
+ tionsgemäß die Länge 1.0.
+
+ b) absolute Koordinaten
+ Die Werte werden in cm angegeben. Für die Maximalwerte sind
+ nur Werte größer als 2.0 möglich.
+
+ Voreingestellt ist
+
+#type("modern12")#
+ viewport (0.0, 1.0, 0.0, 1.0),
+#type("trium10")#
+
+ d.h. das größtmöglichste Quadrat, beginnend in der linken unteren
+ Ecke der physikalischen Zeichenfläche. In vielen Fällen wird diese
+ Einstellung ausreichen, so daß der Anwender kein eigenes 'viewport'
+ definieren muß.
+
+ Der Abbildungsmaßstab wird durch das Zusammenspiel von 'view­
+ port' und 'window' festgelegt (siehe dort). Dabei ist insbesondere
+ darauf zu achten, daß winkeltreue Darstellungen nur bei gleichem
+ X- und Y-Maßstab möglich sind. Da man oft quadratische Fenster
+ ('window') verwendet, wurde als Standardfall auch ein quadratisches
+ 'viewport' gewählt.
+
+#ib#where#ie#
+ PROC where (PICTURE CONST pic, REAL VAR x, y)
+ Zweck: Die aktuelle Stiftposition wird in 'x' und 'y' eingetragen.
+ Fehlerfall:
+ * picture is threedimensional
+ Das PICTURE 'pic' ist dreidimensional
+
+ PROC where (PICTURE CONST pic, REAL VAR x, y, z)
+ Zweck: Die aktuelle Stiftposition wird in 'x', 'y' und 'z' eingetragen.
+ Fehlerfall:
+ * picture is twodimensional
+ Das PICTURE 'pic' ist zweidimensional
+
+#ib#window#ie#
+ PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max)
+ Zweck: Für die Darstellung eines zweidimensionalen Bildes wird das
+ darzustellende Fenster definiert. Alle Bildpunkte, deren X-Koordi­
+ naten im Intervall [x min, x max] und deren Y-Koordinaten im
+ Intervall [y min, y max] liegen, gehören zum definierten Fenster.
+ Vektoren, die über dieses Fenster hinausgehen, werden abge­
+ schnitten. Dieses Fenster wird auf die spezifizierte Zeichenfläche
+ abgebildet. (Das ist standardmäßig das größtmögliche Quadrat auf
+ dem ausgewählten Gerät).
+
+ Der Darstellungsmaßstab ergibt sich als
+
+#type("modern12")#
+ x max - x min
+ -----------------------------------------
+ horizontale Seitenlänge der Zeichenfläche
+
+ y max - y min
+ -----------------------------------------
+ vertikale Seitenlänge der Zeichenfläche
+#type("trium10")#
+
+ Für eine winkeltreue Darstellung müssen X- und Y-Maßstab
+ gleich sein! Einfach können winkeltreue Darstellung erreicht
+ werden, wenn das Fenster eine quadratische Form hat. Die
+ Zeichenfläche ('viewport') ist dementsprechend als Quadrat vorein­
+ gestellt.
+
+ PROC window (PICFILE VAR p,
+ REAL CONST x min, x max, y min, y max, z min, z max)
+ Zweck: Für die Darstellung eines dreidimensionalen Bildes wird das darzu­
+ stellende Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im
+ Intervall [x min, x max] und deren Y-Koordinaten im Intervall [y min,
+ y max] und deren Z-Koordinaten im Intervall [z min, z max] liegen,
+ gehören zum definierten Fenster. Dieses dreidimensionale Fenster
+ (Quader) wird entsprechend der eingestellten Projektionsart (ortho­
+ grafisch, perspektivisch oder schiefwinklig) und den Betrachtungs­
+ winkeln (s. 'view') auf die spezifizierte Zeichenfläche abgebildet. (Das
+ ist standardmäßig das größtmögliche Quadrat auf dem ausgewählten
+ Gerät.) Linien, die außerhalb dieses Quadrates liegen, werden
+ abgeschnitten.
+
+ Anders als im zweidimensionalen Fall ist das Problem der Maßstäbe
+ nicht mehr nur durch das Zusammenspiel von 'window' und 'view­
+ port' zu beschreiben. Hier spielen auch Projektionsart und Dar­
+ stellungswinkel eine Rolle. Falls alle Darstellungswinkel den Wert 0.0
+ haben, gilt das für den zweidimensionalen Fall gesagte für die Ebene
+ (y = 0.0) entsprechend.
+
+#ib#write is possible#ie#
+ BOOL PROC write is possible (PICTURE CONST pic, INT CONST space)
+ Zweck: Liefert 'TRUE', falls 'space' Bytes Platz in 'pic' vorhanden ist.
+
+
+
+
+
+
diff --git a/system/std.graphik/1.8.7/doc/GRAPHIK.book b/system/std.graphik/1.8.7/doc/GRAPHIK.book
new file mode 100644
index 0000000..435d9e4
--- /dev/null
+++ b/system/std.graphik/1.8.7/doc/GRAPHIK.book
@@ -0,0 +1,897 @@
+#type ("times8")##limit (11.0)##start (2.2, 1.5)##pagelength (17.4)##block#
+
+#head#
+#type ("triumb14")#
+#center#EUMEL-Grafik-System
+
+#type ("times8")#
+#end#
+#type ("triumb14")# Teil 10: Graphik#type ("times8")#
+
+
+#type ("trium12")#
+#on("b")#1. Übersicht#off("b")#
+#type ("times8")#
+
+#limit (7.0)##type("times6")#
+ #on("i")#Dieser Teil des Benutzer-Handbuchs beschreibt die Graphik-
+ Fähigkeiten des EUMEL-Systems. Die Graphik-Pakete gehö­
+ ren nicht zum Eumel-Standard, sondern sind Anwenderpake­
+ te, die im Quellcode ausgeliefert und von jeder Installation in das
+ System aufgenommen werden können. #off("i")#
+#limit (11.0)#
+#foot#
+ Eventuell müssen Programme erstellt werden, die die Anpassungen für spezielle graphische Geräte einer Installation
+ vornehmen, soweit diese nicht von den EUMEL-Anbietern bezogen werden können.
+#end#
+
+#type("times8")#
+ Das #on("b")#Graphik-System#off("b")# ermöglicht es, durch ELAN-Programme geräteunabhängige Infor­
+ mationen für Zeichnungen (#on("i")#Graphiken#off("i")#) zu erstellen. Die Graphik erzeugenden Programme
+ brauchen dabei keine geräteabhängigen Größen oder Unterprogramme zu enthalten. Sie
+ befassen sich somit ausschließlich mit der Erzeugung der problemorientierten Information
+ für die Konstruktion einer Zeichnung. Nach der geräteunabhängigen Erzeugung einer
+ Graphik kann diese auf unterschiedlichen Geräten ausgegeben werden (z.B. erst auf einem
+ Terminal zur Kontrolle und dann auf einem Plotter).
+
+ Die EUMEL-Graphik umfaßt zwei- und dreidimensionale Graphik. Im dreidimensiona­
+ len Fall sind perspektivische, orthografische und schiefwinklige Projektionen mit beliebi­
+ gen Betrachtungswinkeln möglich.
+
+ Bei der EUMEL-Graphik wird streng zwischen Erzeugung und Manipulation von Gra­
+ phiken auf der einen und der Darstellung der erzeugten Bilder auf der anderen Seite
+ unterschieden. Für die Erzeugung und Manipulation der Graphiken wird von den Paketen
+ #on("i")#picture#off("i")# und #on("i")#picfile#off("i")# der Datentype #on("b")#PICTURE#off("b")# bzw. #on("b")#PICFILE#off("b")# zur Verfügung gestellt. Dabei
+ müssen Ausschnitt, Maßstab, Betrachtungswinkel und Projektionsart erst bei der Darstel­
+ lung festgelegt werden. Diese Konstruktion des Graphik-Systems hat folgende Vorteile:
+
+ a) Programme, die Graphik-Information erzeugen, sind geräteunabhängig. Das bedeu­
+ tet, das der Programmierer sich ausschließlich mit einem logischen Problem befassen
+ muß und nicht mit gerätespezifischen Besonderheiten.
+
+ b) Graphiken können auf mehreren unterschiedlich gearteten Geräten mehrmals darge­
+ stellt werden, ohne daß das erzeugende Programm geändert oder neu gestartet werden
+ muß. Z.B. kann ein Programmierer eine Graphik erst auf dem Terminal überprüfen,
+ bevor er die Graphik auf einem Plotter zeichnen läßt.
+
+ c) Graphiken können leicht geändert (z. B. vergrößert oder in eine Richtung gestreckt
+ o.ä.) werden, ohne daß sie erneut erzeugt werden müssen. Zudem können Graphiken
+ aneinander oder übereinander gelegt werden.
+
+ d) Graphiken mit unterschiedlichen Farben, Strichen usw. können leicht erzeugt werden.
+
+ e) Der Anschluß von neuen Graphik.Geräten durch Benutzer ist leicht möglich, ohe daß
+ die Graphik-Programme geändert werden müssen.
+
+ f) Plotter können wie Drucker an einen Spooler gehängt werden.
+
+ g) Bilder können als PICFILEs gespeichert und versandt werden.
+
+ h) Es können auch auf Systemen ohne graphische Ausgabegeräte Graphiken erzeugt
+ werden.
+
+ i) Es können mit einfachen Mitteln universelle Unterprogrammpakete erstellt werden,
+ um die Standardzeichnungen (Darstellen einer Funktion, Balken oder Liniendiagram­
+ me, Achsen etc.) zu erstellen.
+
+
+#type ("trium12")#
+#on("b")#2. Erzeugung von Bildern#off("b")#
+#type ("times8")#
+
+ Bilder entstehen in Objektion vom Datentyp #on("b")#PICTURE#off("b")#. Diese müssen mit der Prozedur
+ #on("i")#nilpicture#off("i")# initialisiert werden. Sie enthalten dann ein leeres Bild, dessen Dimension noch
+ nicht festgelegt ist. Die Dimension eines #on("i")#PICTURE#off("i")#s wird mit dem ersten Schreibzugriff
+ (#on("i")#move, draw#off("i")# o.ä.) festgelegt. Ein #on("i")#PICTURE#off("i")# kann immer nur entweder zwei- oder
+ dreidimensional sein.
+ Außerdem kann einem #on("i")#PICTURE#off("i")# mit der Prozedur #on("i")#pen#off("i")# genau ein virtueller Stift zugeord­
+ net oder der aktuelle Stift erfragt werden (Standardeinstellung: 1).
+
+ Für Erzeugung eines Bildes wird ein virtueller Zeichenstift benutzt, dem bei der Darstel­
+ lung jeweils genau ein realer Stift zugeordnet wird. Dieser Stift kann mit der Prozedur
+ #on("b")#move#off("b")# oder #on("b")#move r #off("b")#auf eine bestimmte Stelle positioniert werden ohne zu zeichnen. Mit
+ #on("b")#draw#off("b")# oder #on("b")#draw r#off("b")# wird eine Linie von der letzten Position zur angegebene Position
+ gezeichnet. Die aktuelle Stiftposition kann dabei mit #on("b")#where#off("b")# abgefragt werden.
+ Außerdem existiert noch die Prozedur #on("b")#draw#off("b")# die einen Text zur Beschriftung der Zeich­
+ nung darstellt, sowie #on("b")#bar#off("b")# zum Zeichnen eines Balkens für Balkendiagramme, #on("b")#circle#off("b")# zum
+ Zeichnen eines Kreisbogens für Kreisdiagramme und #on("b")#mark#off("b")# zum Markiern von Positionen.
+ Dabei wird die aktuelle Stiftposition aber nicht verändert.
+
+#type ("trium12")#
+#on("b")#3. Manipulation von PICTUREs#off("b")#
+#type ("times8")#
+
+ Erstellte PICTUREs können auch als Ganzes manipuliert werde. Dazu dienen die Prozedu­
+ ren #on("b")#translate, stretch#off("b")# und #on("b")#rotate#off("b")#. Es ist auch möglich mehrere PICTURE mit dem Opera­
+ tor #on("b")#CAT#off("b")# aneinanderzufügen, wenn beide PICTURE die gleiche Dimension haben. In
+ solcherart manipulierten Bildern kann ohne Einschränkung weitergezeichnet werden,
+ solange die maximale Größe nicht überschritten wird.
+
+#type ("trium12")#
+#on("b")#4. Darstellung und Speicherung #off("b")#
+#type ("times8")#
+
+ Für die Darstellung und Speicherung der erzeugten Bilder existiert der Typ #on("b")#PICFILE#off("b")#.
+ Dieser besteht aus eienm Datenraum mit max. 1024 PICTUREs, die mit den Prozeduren #on("b")#
+ delete picture, insert picture, read picture, write picture, get picture#off("b")# und #on("b")#put picture#off("b")# einge­
+ geben bzw. ausgegeben werden können.
+ Für die Positionierung innerhalb eines PICFILES stehen die Prozeduren #on("b")#to pic, up, down,
+ eof, picture no, pictures#off("b")# zur Verfügung.
+ Für die Assoziation mit einem benannten Datenraum existiert ähnlich wie beim Datentyp
+ FILE die Prozedur #on("b")#picture file#off("b")#; unbenannte Datenräume können mit dem Operator #on("b")#:=#off("b")#
+ assoziert werden.
+ Die Darstellung des PICFILES auf einem Zeichengerät erfolgt mit der Prozdur #on("b")#plot#off("b")#.
+ Da die Graphiken aber in #on("i")#Weltkoordinaten#off("i")# erzeugt werden und die spätere Darstellung
+ vollkommen unbeachtet bleibt, müssen gewisse Darstellungsparameter für die Zeichnung
+ gesetzt werden. Dies Parameter werden im PICFILE abgelegt und gelten jeweils für alle
+ darin enthaltenen PICTURE. Dadurch ist es möglich, einen PICFILE mit spezifierter
+ Darstellungsart über einen SPOOLER an einen Plotter zu senden oder die bei der letzten
+ Betrachtung gewählte Darstellung beizubehalten oder zu ändern.
+ Für die Darstellung können den virtuellen Stiften mit der Prozedur #on("b")#select pen#off("b")# reale Stifte
+ zugeordnet werden. Voreingestellt ist für alle virtuellen Stifte die Standardfarbe, Standard­
+ stärke und durchgängige Linie. Mit #on("b")#background#off("b")# kann eine bestimmte Hintergrundfarbe
+ gewählt werden.
+ Indem man einem PICTURE den Stift 0 zuordnet, kann man dieses auch Ausblenden
+ wenn es bei dieser Darstellung stört.
+ Die Größe der realen Zeichenfläche kann mit #on("b")#viewport#off("b")# eingestellt werden, wobei die
+ gesamte Zeichenfäche voreingestellt ist. Dadurch können auch mehrere PICFILE auf ein
+ Blatt oder einen Bildschirm gezeichnet werden, wenn man durch Angabe von #on("i")#background
+  (0)#off("i")# das Löschen der Zeichenfläche unterdrückt.
+
+
+#type ("trium12")#
+#on("b")#5. Darstellung zweidimensionaler Graphik#off("b")#
+#type ("times8")#
+
+ Bei der Darstellung zweidimensionaler Bilder muß der zu zeichnende Ausschnitt (das
+ #on("i")#Fenster#off("i")#) angegeben werden. Mit der Prozedur #on("b")#window#off("b")# wird durch Angabe der minimalen
+ und maximalen X- bzw. Y-Koordinaten ein Fenster definiert. Linien, die über dieses
+ Fenster hinausgehen, werden abgeschnitten. Dadurch kann man einen beliebigen Detailaus­
+ schnitt eines Bildes ausgeben, ohne das Bild neu generieren zu müssen.
+ Da das so definierte Fenster auf die mit #on("i")#viewport#off("i")# definierte Zeichenfläche abgebildet wird,
+ ist der Abbildungsmaßstab durch das Zusammenspiel von #on("i")#viewport#off("i")# und #on("i")#window#off("i")# bestimmt.
+ Wenn eine Winkeltreue Darstellung erreicht werdenn soll, muß das Verhältnis der durch
+ #on("i")#viewport#off("i")# eingestellten Breite und Höhe und das Verhältnis des durch #on("i")#window#off("i")# eingestellten
+ Ausschnitts gleich sein.
+
+#type ("trium12")#
+#on("b")#6. Darstellung dreidimensionaler Graphik#off("b")#
+#type ("times8")#
+
+ Bei dreidimensionalen Zeichnungen wird das Fenster ebenfalls mit #on("b")#window#off("b")# definiert,
+ wobei dann allerdings auch der Wertebereich der dritten Dimension (Z-Koordinaten) zu
+ berücksichtigen ist. Auch hierbei werden Linien, die über die spezifierte Darstellungs­
+ fläche hinausgehen abgeschnitten. Das Abschneiden erfolgt allerdings erst nach der Projek­
+ tion auf die Darstellungsfläche, so daß auch Vektoren zu sehen sind, die über das mit
+ #on("i")#window#off("i")# angegebene Quader hinausgehen, wenn ihre Projektion innerhalb der Zeichen­
+ fläche liegt.
+ Da die dreidimensionale Graphik auf eine zweidimensionale Fläche projeziert wird,
+ können aber noch weitere Darstellungsparameter angegeben werden. Der Betrachtungswin­
+ kel wird mit Hilfe der Prozedur #on("b")#view#off("b")# angegeben. Ebenfalls kann mit #on("b")#view#off("b")# der Winkel der
+ Y-Achse zur Horizontalen angegeben werden.
+ Zur Spezifikation der gewünschten Projektionsart existieren #on("b")#orthographic#off("b")# (orthographische
+ Projektion), #on("b")#perspective#off("b")# (perspektivische Projektion, der Fluchtpunkt ist frei wählbar) und
+ #on("b")#oblique#off("b")# (schiefwinklige Projektion).
+
+#page#
+#type ("trium12")#
+#on("b")#7. Beispiele#off("b")#
+#type ("times8")#
+
+ #on("u")#Sinuskurve#off("u")#
+
+#type("micro")#
+initialisiere picfile;
+zeichne überschrift;
+zeichne achsen;
+zeichne sinuskurve;
+wähle darstellung;
+plot (p) .
+
+initialisiere picfile:
+ PICFILE VAR p :: picture file ("SINUS") .
+
+zeichne überschrift:
+ PICTURE VAR überschrift :: nilpicture;
+ move (überschrift, -pi/2.0, 1.0);
+ draw (überschrift, "sinus (x) [-pi, +pi]", 0.0, 1.0, 0.6);
+ put picture (p, überschrift) .
+
+ zeichne achsen:
+ PICTURE VAR achsen :: nilpicture;
+ zeichne x achse;
+ zeichne y achse;
+ put picture (p, achsen) .
+
+ zeichne x achse:
+ move (achsen, -pi, 0.0);
+ draw (achsen, pi, 0.0) .
+
+ zeichne y achse:
+ move (achsen, 0.0, -1.0);
+ draw (achsen, 0.0, +1.0) .
+
+ zeichne sinuskurve:
+ PICTURE VAR sinus :: nilpicture;
+ REAL VAR x :: -pi;
+
+ move (sinus, x, sin (x));
+ REP x INCR 0.1;
+ draw (sinus, x, sin (x))
+ UNTIL x >= pi PER;
+
+ put picture (p, sinus) .
+
+ wähle darstellung:
+ window (p, -pi, pi, -1.0, 1.3);
+ viewport (p, 0.0, 0.0, 0.0, 0.0) .
+
+#page#
+#type ("times8")#
+ #on("u")#Achsenkreuz#off("u")#
+
+#type("micro")#
+initialisiere picfile;
+zeichne die x achse;
+zeichne die y achse;
+zeichne die z achse;
+stelle das achsenkreuz dar .
+
+initialisiere picfile:
+ PICFILE VAR p :: picture file ("KREUZ") .
+
+ zeichne die x achse:
+ PICTURE VAR x achse := nilpicture;
+ move (x achse, -1.0, 0.0, 0.0);
+ draw (x achse, "-X", 0.0, 0.0, 0.0);
+ draw (x achse, 1.0, 0.0, 0.0);
+ draw (x achse, "+X", 0.0, 0.0, 0.0);
+ put picture (p, x achse) .
+
+ zeichne die y achse:
+ PICTURE VAR y achse := nilpicture;
+ move (y achse, 0. 0, -1.0, 0.0);
+ draw (y achse, "-Y", 0.0, 0.0, 0.0);
+ draw (y achse, 0.0, 1.0, 0.0);
+ draw (y achse, "+Y", 0.0, 0.0, 0.0);
+ put picture (p, y achse) .
+
+ zeichne die z achse:
+ PICTURE VAR z achse := nilpicture;
+ move (z achse, 0. 0, 0.0, -1.0);
+ draw (z achse, "-Z", 0.0, 0.0, 0.0);
+ draw (z achse, 0.0, 0.0, 1.0);
+ draw (z achse, "+Z", 0.0, 0.0, 0.0);
+ put picture (p, z achse) .
+
+ stelle das achsenkreuz dar:
+ viewport (p, 0. 0, 1.0, 0.0, 1.0);
+ window (p, -1.1, 1.1, -1.1, 1.1);
+ oblique (p, 0.25, 0.15);
+ plot (p) .
+
+#foot#
+ #type("times6")#
+ Diese beiden Beispielprogramme befinden sich ebenfalls auf dem STD-Archive unter dem Namen #on("i")#Beispiel.Sinus#off("i")# und
+ #on("i")#Beispiel.Kreuz#off("i")#.
+#end#
+
+#page#
+#type ("triumb14")# Beschreibung der Graphik-Prozeduren
+#type ("times8")#
+
+
+#type ("trium12")#
+#on("b")#1. PICTURE-Prozeduren#off("b")#
+#type ("times8")#
+
+#limit (7.0)##type("times6")#
+ #on("i")#Zweidimensionale PICTURES brauchen weniger Speicherplatz
+ als dreidimensionale. Daher werden in einigen Fehlermeldungen
+ unterschiedliche Größen angegeben.
+
+#limit (11.0)##type("times8")#
+
+#type("times10")##on("b")#:=#off("b")##type("times8")#
+ OP := (PICTURE VAR l, PICTURE CONST r)
+ Zweck: Zuweisung
+
+#type("times10")##on("b")#CAT#off("b")##type("times8")#
+ OP CAT (PICTURE VAR l, PICTURE CONST r)
+ Zweck: Aneinanderfügen von zwei PICTURE.
+ Fehlerfälle:
+ * left dimension <> right dimension
+ Es können nur PICTURE mit gleicher Dimension angefügt werden.
+ * Picture overflow
+ Die beiden PICTURE überschreiten die maximale Größe eines PICTURE.
+
+#type("times10")##on("b")#nilpicture#off("b")##type("times8")#
+ PICTURE PROC nilpicture
+ Zweck: Die Prozedur liefert ein leeres PICTURE zur Initialisierung.
+
+ PICTURE PROC nilpicture (INT CONST pen)
+ Zweck: Die Prozedur liefert ein leeres PICTURE mit dem Stift #on("i")#pen#off("i")# zur Initialisierung.
+
+#type("times10")##on("b")#draw#off("b")##type("times8")#
+ PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, ­
+ width)
+ Zweck: Der angegebene Text wird unter dem Winkel #on("i")#angle#off("i")# gegenüber der Waagerech­
+ ten mit der Zeichenhöhe #on("i")#hight#off("i")# und der Breite #on("i")#width#off("i")# gezeichnet. #on("i")#angle#off("i")# wird in
+ Winkelgrad angegeben. #on("i")#height#off("i")# und #on("i")#width#off("i")# werden in #on("i")#Prozenten#off("i")# der Breite bzw.
+ Höhe der Zeichenfläche angegeben, bei 0 wird
+ die Standardhöhe- und breite angenommen.
+ Der Anfang ist dabei die aktuelle Stiftposition, die nicht verändert wird. Es könne
+ auch die Steuerzeichen ""1"", ""2"", ""3"", ""10"", ""13"" benutzt werden,
+ wobei sie immer in der Richtung #on("i")#angle#off("i")# wirken.
+ Fehlerfälle:
+ * Picture overflow
+ Der Text paßt nicht mehr in das PICTURE.
+
+#type("times10")##on("b")#draw#off("b")##type("times8")#
+ PROC draw (PICTURE VAR p, REAL CONST x, y, z)
+ Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y, z).
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is two dimensional
+
+ PROC draw (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y).
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+
+#type("times10")##on("b")#draw r#off("b")##type("times8")#
+ PROC draw r (PICTURE VAR p, REAL CONST x, y, z)
+ Zweck: Zeichnen einer Linie der Länge (x, y, z) relativ zur aktuellen Position.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is two dimensional
+
+ PROC draw r (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Zeichnen einer Linie der Länge (x, y) relativ zur aktuellen Position.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+
+#type("times10")##on("b")#move#off("b")##type("times8")#
+ PROC move (PICTURE VAR p, REAL CONST x, y, z)
+ Zweck: Die aktuelle Position wird auf (x, y, z) gesetzt.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is two dimensional
+
+ PROC move (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Die aktuelle Position wird auf (x, y) gesetzt.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+
+#type("times10")##on("b")#move r#off("b")##type("times8")#
+ PROC move r (PICTURE VAR p, REAL CONST x, y, z)
+ Zweck: Die aktuelle Position wird um (x, y, z) erhöht.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is two dimensional
+
+ PROC move r (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Die aktuelle Position wird um (x, y) erhöht.
+ Position.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+
+
+#type("times10")##on("b")#bar#off("b")##type("times8")#
+ PROC bar (PICTURE VAR p, REAL CONST width, hight, INT CONST pattern):
+ Zweck: Die Prozedur zeichnet an der aktuellen Position einen Balken mit dem Muster
+ #on("i")#pattern#off("i")#:
+ 0 = Leerer Balken
+ 1 = Gepunkteter Balken
+ 2 = Gefüllter Balken
+ 3 = Horizontale Linien
+ 4 = Vertikale Linien
+ 5 = Gekreuzte Linien
+ 6 = Diagonale Linien von Links nach Rechts
+ 7 = Diagonale Linien von Rechts nach Links
+ 8 = Gekreuzte diagonale Linien
+ > 8 = nicht normiertes Sondermuster
+ Die aktuelle Stiftposition wird dabei nicht verändert.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+
+ PROC bar (PICTURE VAR p, REAL CONST from, to, hight, INT CONST pattern):
+ Zweck: Die Prozedur zeichnet einen Balken von der Position #on("i")#from#off("i")# zur Position #on("i")#to#off("i")# und der
+ Höhe #on("i")#height#off("i")# mit dem Muster #on("i")#pattern#off("i")#.
+ s.o.
+
+#type("times10")##on("b")#circle#off("b")##type("times8")#
+ PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern)
+ Zweck: Die Prozedur zeichnet an der aktuellen Position ein Kreissegment vom Winkel
+ #on("i")#from#off("i")# bis #on("i")#to#off("i")# (im Gradmaß) mit dem Muster #on("i")#pattern#off("i")# (s.o.). Der #on("i")#radius#off("i")# wird in
+ Prozenten der Diagonalen der Zeichenfläche angegeben.
+ Die aktuelle Stiftposition wird dabei nicht verändert. Dieses Kreissegment ist in
+ jedem Fall 2-dimensional, so das es durch Drehungen nicht verändert wird.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+
+#type("times10")##on("b")#mark#off("b")##type("times8")#
+ PROC mark (PICTURE VAR p, REAL CONST size, INT CONST no)
+ Zweck: Es wird ein Marker mit der Größe #on("i")#size#off("i")# in Prozenten der Diagonalen der Zeichen­
+ fläche an der aktuellen Stiftposition ausgegeben, ohne diese zu verändern. Es
+ sollten dabei mindestens 10 verschiedene Marker gewählt werden können.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+
+#type("times10")##on("b")#dim#off("b")##type("times8")#
+ INT PROC dim (PICTURE CONST pic)
+ Zweck: Liefert die Dimension eines PICTURE.
+
+#type("times10")##on("b")#pen#off("b")##type("times8")#
+ INT PROC pen (PICTURE CONST p)
+ Zweck: Liefert den virtuellen Stift des PICTURE
+
+ PICTURE PROC pen (PICTURE CONST p, INT CONST pen)
+ Zweck: Setzen des (virtuellen) Stiftes eines PICTURE.
+ Bei #on("i")#pen#off("i")# = 0 wird das Picture nicht gezeichnet.
+ Fehlerfälle:
+ * pen out of range
+ Der gewünschte Stift ist kleiner als 0 oder größer als 16.
+
+#type("times10")##on("b")#extrema#off("b")##type("times8")#
+ PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max)
+ Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE.
+ Fehlerfälle:
+ * Picture is three dimensional
+
+ PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max,  
+ z min, z max)
+ Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE.
+ Fehlerfälle:
+ * Picture is two dimensional
+
+#type("times10")##on("b")#where#off("b")##type("times8")#
+ PROC where (PICTURE CONST p, REAL VAR x, y, z)
+ Zweck: Die Prozedur liefert die aktuelle Stiftposition.
+ Fehlerfälle:
+ * Picture is two dimensional
+
+ PROC where (PICTURE CONST p, REAL VAR x, y, z)
+ Zweck: Die Prozedur liefert die aktuelle Stiftposition. Fehlerfälle:
+ * Picture is three dimensional
+
+#type("times10")##on("b")#rotate#off("b")##type("times8")#
+ PROC rotate (PICTURE VAR p, REAL CONST angle)
+ Zweck: Das PICTURE wird um den Punkt (0, 0) um den Winkel #on("i")#angle#off("i")# (im Gradmaß) im
+ mathematisch positiven Sinn gedreht.
+
+ PROC rotate (PICTURE CONST p, REAL CONST phi, theta, lambda)
+ Zweck: Das PICTURE wird um den Winkel #on("i")#lambda#off("i")# um die Drehachse #on("i")#(phi, theta)#off("i")# ge­
+ dreht.
+
+#type("times10")##on("b")#stretch#off("b")##type("times8")#
+ PROC stretch (PICTURE VAR pic, REAL CONST sx, sy)
+ Zweck: Das PICTURE wird in X-Richtung um den Faktor #on("i")#sx#off("i")#, in Y-Richtung um den
+ Faktor #on("i")#sy#off("i")# gestreckt (bzw. gestaucht). Dabei bewirkt der Faktor
+ s > 1 eine Streckung
+ 0 < s < 1 eine Stauchung
+ s < 0 zusätzlich eine Achsenspiegelung.
+ Fehlerfälle:
+ * Picture is three dimensional
+
+ PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz)
+ Zweck: s. o.
+ Fehlerfälle:
+ * Picture is two dimensional
+
+#type("times10")##on("b")#translate#off("b")##type("times8")#
+ PROC translate (PICTURE VAR p, REAL CONST dx, dy)
+ Zweck: Das PICTURE wird um #on("i")#dx#off("i")# und #on("i")#dy#off("i")# verschoben. Fehlerfälle:
+ * Picture is three dimensional
+
+ PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz)
+ Zweck: Das PICTURE wird um #on("i")#dx, dy#off("i")# und #on("i")#dz#off("i")# verschoben. Fehlerfälle:
+ * Picture is two dimensional
+
+
+#type ("trium12")#
+#on("b")#2. PICFILE-Prozeduren#off("b")#
+#type ("times8")#
+
+#type("times10")##on("b")#plot#off("b")##type("times8")#
+ PROC plot (TEXT CONST name)
+ Zweck: Der PICFILE mit dem Namen #on("i")#name#off("i")# wird entsprechend der angegebenen Dar­
+ stellungsart gezeichnet. Diese Parameter (#on("i")#perspective, orthographic, oblique, view,
+ window etc.#off("i")#) müssen vorher eingestellt werden.
+ Fehlerfälle:
+ * PICFILE does not exist
+ Es existiert kein PICFILE mit dem Namen #on("i")#name#off("i")#
+
+ PROC plot (PICFILE VAR p)
+ Zweck: Der PICFILE #on("i")#p#off("i")# wird entsprechend der angegebenen Darstellungsart gezeichnet.
+ Diese Parameter müssen vorher eingestellt werden:
+
+ #on("b")#zweidimensional:#off("b")#
+ obligat: #on("i")#window#off("i")# (zweidimensional)
+ optional: #on("i")#view#off("i")# (zweidimensional)
+ #on("i")#viewport#off("i")#
+ #on("i")#select pen#off("i")#
+
+ #on("b")#dreidimensional:#off("b")#
+ obligat: #on("i")#window#off("i")# (dreidimensional)
+ optional: #on("i")#view#off("i")# (dreidimensional)
+ #on("i")#orthographic | perspective | oblique#off("i")#
+ #on("i")#viewport#off("i")#
+ #on("i")#select pen#off("i")#
+
+
+#type("times10")##on("b")#select pen#off("b")##type("times8")#
+ PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type)
+ Zweck: Für die Darstellung des Bildes #on("i")#p#off("i")# soll dem #on("i")#virtuellen#off("i")# Stift #on("i")#pen#off("i")# ein realer Stift
+ zugeordnet werden, der möglichst die Farbe #on("i")#colour#off("i")# und die Dicke #on("i")#thickness#off("i")# hat
+ und dabei Linien mit dem Typ #on("i")#line type#off("i")# zeichnet. Es wird die beste Annäherung
+ für das Ausgabegerät genommen.
+ Dabei gelten folgende Vereinbarungen:
+
+ #on("b")#Farbe:#off("b")# Negative Farben werden XOR gezeichnet (dunkel wird hell und hell wird
+ dunkel), Farbe 0 ist der Löschstift und positive Farben überschreiben
+ (ersetzen) den alten Punkt mit folgenden Werten:
+
+ 1 Standardfarbe des Endgerätes
+ 2 rot
+ 3 blau
+ 4 grün
+ 5 schwarz
+ 6 weiß
+ > 6 nicht normierte Sonderfarben
+
+
+ #on("b")#Dicke:#off("b")# 0 Standardstrichstärke des Endgerätes
+ > 0 Strichstärke in 1/10 mm.
+
+
+ #on("b")#Linientyp:#off("b")#
+ 0 keine sichtbare Linie
+ 1 durchgängige Linie
+ 2 gepunktete Linie
+ 3 kurz gestrichelte Linie
+ 4 lang gestrichelte Linie
+ 5 Strichpunktlinie
+ > 5 nicht normierte Linie
+
+
+ Die hier aufgeführten Möglichkeiten müssen nicht an allen graphischen Endge­
+ räten vorhanden sein. Der geräteabhängige Graphik-Treiber wählt jeweils die
+ bestmögliche Annäherung.
+
+ Fehlerfälle:
+ * pen out of range
+ #on("i")#pen#off("i")# muss im Bereich 1-16 sein.
+
+#type("times10")##on("b")#background#off("b")##type("times8")#
+ PROC background (PICFILE VAR p, INT CONST colour)
+ Zweck: Der Hintergrund wird auf die Farbe #on("i")#colour#off("i")# (s.o.) gesetzt wenn möglich.
+ Bei der Angabe #on("i")#background (p, 0)#off("i")# wird das Löschen des Bildschirms unterdrückt,
+ so daß das Zeichen mehrerer PICFILE auf einem Blatt möglich wird.
+
+ INT PROC background (PICFILE CONST p):
+ Zweck: Liefert die eingestellte Hintergrundfarbe.
+
+#type("times10")##on("b")#view#off("b")##type("times8")#
+ PROC view (PICFILE VAR p, REAL CONST alpha)
+ Zweck: Setzt den Winkel der Y-Achse zur Senkrechten auf #on("i")#alpha#off("i")# Grad, falls diese nicht
+ senkrecht auf der Betrachtungsebene steht.
+
+ PROC view (PICFILE VAR p, REAL CONST phi, theta)
+ Zweck: Dreidimensionale Bilder werden häufig nicht direkt von vorne dargestellt, son­
+ dern für die Betrachtung gedreht. Mit der Prozedur #on("i")#view#off("i")# kann die Betrachtungs­
+ richtung durch die Polarwinkel #on("i")#phi#off("i")# und #on("i")#theta#off("i")# (im Gradmass) angegeben werden.
+ Voreingestellt ist #on("i")#phi#off("i")# = 0 und #on("i")#theta#off("i")# = 0, d.h. senkrecht von oben (Die #on("i")#X-
+ Achse#off("i")# bildet die Horizontale und die #on("i")#Y-Achse#off("i")# bildet die Vertikale).
+ Im Gegensatz zu #on("i")#rotate#off("i")# hat #on("i")#view#off("i")# keine Wirkung auf das eigentliche Bild (die
+ PICTURE werden nicht verändert), sondern nur auf die gewählte Darstellung. So
+ addieren sich zwar aufeinanderfolgende #on("i")#Rotationen#off("i")#, #on("i")#view#off("i")# aber geht immer von der
+ Nullstellung aus. Auch kann das Bild durch eine #on("i")#Rotation#off("i")# ganz oder teilweise aus
+ oder in das Darstellungsfenster (#on("i")#window#off("i")# gedreht werden. Bei #on("i")#view#off("i")# verändern sich
+ die Koordinaten der Punkte nicht, d. h. das Fenster wird mitgedreht.
+
+ PROC view (PICFILE VAR p, REAL CONST x, y, z)
+ Zweck: Wie oben, nur werden die Winkel nicht in Polarkoordinaten angegeben, sondern
+ es wird die Blickrichtung als Vektor in Karthesischen Koordinaten angegeben.
+ (Der Betrachtungsvektor muß nicht normiert sein).
+
+#type("times10")##on("b")#viewport#off("b")##type("times8")#
+ PROC viewport (PICFILE VAR p, REAL CONST hormin, hormax, vertmin, vertmax)
+ Zweck: Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt werden soll,
+ wird spezifiziert. Dabei wird sowohl die Größe als auch die relative Lage der
+ Zeichenfläche definiert. Der linke untere Eckpunkt der physikalischen Zeichen­
+ fläche des Gerätes hat die Koordinaten (0, 0). Die definierte Zeichenfläche er­
+ streckt sich
+
+ #on("i")#hormin - hormax#off("i")# in der Horizontalen,
+ #on("i")#vertmin - vertmax#off("i")# in der Vertikalen.
+
+ So liegt der linke untere Eckpunkt dann bei (#on("i")#hormin, hormax#off("i")#), der rechte obere
+ Eckpunkt bei (#on("i")#hormax, vertmax#off("i")#).
+
+ Damit sowohl geräteunabhängige als auch maßstabgetreue Zeichnungen möglich
+ sind, können die Koordinaten in drei Arten spezifiziert werden:
+ a) #on("b")#Gerätekoordinaten#off("b")#
+ Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei hat die
+ kürzere Seite der physikalischen Zeichenfläche definitionsgemäß die Länge
+ 1.0.
+ b) #on("b")#Absolute Koordinaten#off("b")#
+ Die Werte werden in #on("i")#cm#off("i")# angegeben. Dabei müssen die Maximalwerte aber
+ größer als 2.0 sein, da sonst Fall a) angenommen wird.
+ c) #on("b")#Maximale Zeichenfläche#off("b")# Bei der Angabe (0.0, 0.0, 0.0, 0.0) wird die maxi­
+ male physikalische Zeichenfläche eingestellt.
+
+ Voreingestellt ist
+ viewport (0.0, 0.0, 0.0, 0.0)
+ d.h. die größtmögliche physikalische Zeichenfläche, beginnend mit der linken
+ unteren Ecke.
+ Der Abbildungsmaßstab wird durch das Zusammenspiel von #on("i")#viewport#off("i")# und
+ #on("i")#window#off("i")# festgelegt (s. dort). Dabei ist insbesondere darauf zu achten, daß winkel­
+ treue Darstellung nur bei gleichen Verhältnissen von X-Bereich und Breite bzw.
+ von Y-Bereich und Höhe möglich ist.
+
+
+#type("times10")##on("b")#window#off("b")##type("times8")#
+ PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max)
+ Zweck: Für die Darstellung eines zweidimensionalen Bildes wird das darzustellende
+ Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im Intervall [#on("i")#x min, x
+ max#off("i")#] und deren Y-Koordinaten im Bereich [#on("i")#y min, y max#off("i")#] liegen, gehören zum
+ definierten Fenster.Vektoren, die außerhalb dieses Fensters liegen, gehen über die
+ durch #on("i")#viewport#off("i")# Fläche hinaus und werden abgeschnitten.
+
+ Der Darstellungsmaßstab ergibt sich als
+
+ #ub#               x max - x min               #ue#
+ horizontale Seitenlänge der Zeichenfläche
+
+
+ #ub#               y max - y min               #ue#
+ vertikale Seitenlänge der Zeichenfläche
+
+ PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max,  
+ z min, z max)
+
+ Zweck: Für die darstellung eines dreidimensionalen Bildes wird das darzustellende Fenster
+ definiert. Alle Bildpunkte, deren X-Koordinaten im Intervall [#on("i")#x min, x max#off("i")#],
+ deren Y-Koordinaten im Bereich [#on("i")#y min, y max#off("i")#] und deren Z-Koordinaten im
+ Bereich [#on("i")#z min, z max#off("i")#] liegen, gehören zum definierten Fenster. Dieses dreidi­
+ mensionale Fenster (#on("i")#Quader#off("i")#) wird entsprechend der eingestellten Projektionsart
+ (orthographisch, perspektivisch oder schiefwinklig) und den Betrachtungswinkeln
+ (s. #on("i")#view#off("i")#) auf die spezifizierte Zeichenfläche abgebildet.
+ Anders als im zweidimensionalen Fall ist das Problem der Maßstaäbe nicht mehr
+ nur durch das Zusammenspiel von #on("i")#window#off("i")# und #on("i")#viewport#off("i")# zu beschreiben. Hier
+ spielen auch die Projektionsart und Darstellungswinkel herein.
+
+#type("times10")##on("b")#oblique#off("b")##type("times8")#
+ PROC oblique (PICFILE VAR p, REAL CONST a, b)
+ Zweck: Bei dem (dreidimensionalen) Bild #on("i")#p#off("i")# wird #on("u")#schiefwinklig#off("u")# als gewünschte Projek­
+ tionsart eingestellt. Dabei ist (#on("i")#a, b#off("i")#) der Punkt auf der X-Y-Ebene, auf den der
+ EinheitsVektor der Z-Richtung abgebildet werden soll.
+
+#type("times10")##on("b")#orthographic#off("b")##type("times8")#
+ PROC orthographic (PICFILE VAR p)
+ Zweck: Bei dem (dreidimensionalen) Bild #on("i")#p#off("i")# wird #on("u")#orthographisch#off("u")# als gewünschte Projek­
+ tionsart eingestellt. Bei der orthographischen Projektion wird ein dreidimensio­
+ naler Körper mit parallelen Strahlen senkrecht auf der Projektionsebene abge­
+ bildet.
+
+#type("times10")##on("b")#perpective#off("b")##type("times8")#
+ PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz)
+ Zweck: Bei dem (dreidimensionalen) Bild #on("i")#p#off("i")# wird #on("u")#perspektivisch#off("u")# als gewünschte Projek­
+ tionsart eingestellt. Der Punkt (#on("i")#cx, 1/cy, cz#off("i")#) ist der Fluchtpunkt der Projektion,
+ d. h. alle Parallen zur Z-Achse schneiden sich in diesem Punkt.
+
+#type("times10")##on("b")#extrema#off("b")##type("times8")#
+ PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max)
+ Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE.
+
+ PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max)
+ Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE.
+
+#type ("trium12")#
+#on("b")#3. Prozeduren zur Manipulation von PICFILE#off("b")#
+#type("times 8")#
+
+#type("times10")##on("b")#:=#off("b")##type("times8")#
+ OP := (PICFILE VAR l, PICFILE CONST r)
+ Zweck: Zuweisung des PIFILEs #on("i")#r#off("i")# an das PICFILE #on("i")#l#off("i")#
+
+ OP := (PICFILE VAR p, DATASPACE CONST d)
+ Zweck: Assoziert die PICFILE Variable #on("i")#p#off("i")# mit dem Datenraum #on("i")#d#off("i")# und initialisiert die
+ Variable, wenn nötig.
+ Fehlerfälle:
+ * dataspace is no PICFILE
+ Der anzukoppelnde Datenraum hat einen unzulässigen Typ
+
+#type("times10")##on("b")#picture file#off("b")##type("times8")#
+ DATASPACE PROC picture file (TEXT CONST name)
+ Zweck: Assoziaten eines benannten Datenraumes mit einem PICFILE (s.o.).
+
+#type("times10")##on("b")#to pic#off("b")##type("times8")#
+ PROC to pic (PICFILE VAR p, INT CONST pos)
+ Zweck: Positioniert auf das PICTURE Nummer #on("i")#pos#off("i")#.
+ Fehlerfälle:
+ * Position underflow
+ Es wurde eine Position kleiner Null angegeben.
+ * Position after eof
+ Es wurde versucht, hinter das Ende eines PICFILE zu positionieren. Die letzte
+ erlaubte Position ist #on("i")#pictures (p)+1#off("i")#.
+
+#type("times10")##on("b")#up#off("b")##type("times8")#
+ PROC up (PICFILE VAR p)
+ Zweck: Positioniert genau ein PICTURE zurück.
+ Fehlerfall:
+ * Position underflow
+ Es wurde versucht, vor das erste PICTURE zu positionieren
+
+ PROC up (PICFILE VAR p, INT CONST n)
+ Zweck: Positioniert genau #on("i")#n#off("i")# Picture zurück.
+ Fehlerfall:
+ * Position underflow
+ Es wurde versucht, vor das erste PICTURE zu positionieren
+
+#type("times10")##on("b")#down#off("b")##type("times8")#
+ PROC down (PICFILE VAR p)
+ Zweck: Positioniert genau ein PICTURE vorwärts.
+ Fehlerfall:
+ * Position after eof
+ Es wurde versucht, hinter das Ende eines PICFILE zu positionieren. Die letzte
+ erlaubte Position ist #on("i")#pictures (p)+1#off("i")#.
+
+ PROC down (PICFILE VAR p, INT CONST n)
+ Zweck: Positioniert genau #on("i")#n#off("i")# Picture vorwärts.
+ Fehlerfall:
+ * Position after eof
+ Es wurde versucht, hinter das Ende eines PICFILE zu positionieren Die letzte
+ erlaubte Position ist #on("i")#pictures (p)+1#off("i")#.
+
+#type("times10")##on("b")#delete picture#off("b")##type("times8")#
+ PROC delete picture (PICFILE VAR p)
+ Zweck: Löscht das aktuelle PICTURE
+
+#type("times10")##on("b")#insert picture#off("b")##type("times8")#
+ PROC insert picture (PICFILE VAR p)
+ Zweck: Fügt ein PICTURE #on("u")#vor#off("u")# der aktuellen Position ein.
+
+#type("times10")##on("b")#read picture#off("b")##type("times8")#
+ PROC read picture (PICFILE CONST p, PICTURE VAR pic)
+ Zweck: Liest das aktuelle PICTURE.
+
+#type("times10")##on("b")#write picture#off("b")##type("times8")#
+ PROC write picture (PICFILE VAR p, PICTURE CONST pic)
+ Zweck: Schreibt das PICTURE #on("i")#pic#off("i")# auf der aktuellen Position.
+
+#type("times10")##on("b")#put picture#off("b")##type("times8")#
+ PROC put picture (PICFILE VAR p, PICTURE CONST pic)
+ Zweck: Schreibt das PICTURE #on("i")#pic#off("i")# an die aktuelle Position und erhöht diese um 1.
+
+#type("times10")##on("b")#get picture#off("b")##type("times8")#
+ PROC get picture (PICFILE VAR p, PICTURE VAR pic)
+ Zweck: Liest das PICTURE #on("i")#pic#off("i")# an dir aktuellen Position und erhöht diese um 1.
+
+#type("times10")##on("b")#eof#off("b")##type("times8")#
+ BOOL PROC eof (PICFILE CONST p)
+ Zweck: Liefert genau dann #on("i")#TRUE#off("i")#, wenn das Ende eines PICFILE erreicht ist.
+
+#type("times10")##on("b")#picture no#off("b")##type("times8")#
+ INT PROC picture no (PICFILE CONST p)
+ Zweck: Liefert die Nummer des aktuellen PICTURE.
+
+#type("times10")##on("b")#pictures#off("b")##type("times8")#
+ INT PROC pictures (PICFILE CONST p)
+ Zweck: Liefert die Anzahl PICTURE eines PICFILE.
+
+
+#page#
+#type ("trium12")#
+#on("b")#4. Auslieferungsumfang#off("b")#
+#type ("times8")#
+
+ Die EUMEL-GRAPHIK wird auf einer Diskette mit folgendem Inhalt ausgeliefert.
+ Archive #on("i")#Graphik#off("i")#:
+
+ "gen Graphik"
+ "gen Plotter"
+ "GRAPHIK.book"
+ "GRAPHIK.Picfile"
+ "GRAPHIK.Transform"
+ "GRAPHIK.Plot"
+ "GRAPHIK.Plotter"
+ "GRAPHIK.Server"
+ "GRAPHIK.vektor plot"
+ "ZEICHENSATZ"
+ "PC.plot"
+ "HP7475.plot"
+ "Beispiel.Kreuz"
+ "Beispiel.Sinus"
+
+
+
+ #on("u")#Dateiinhalte#off("u")#
+
+ 1. "gen Graphik" Installationsprogramm für Terminals
+ 2. "gen Plotter" Installationsprogramm für Plotter
+ 3. "GRAPHIK.book" enthält diese Beschreibung.
+ 4. "GRAPHIK.Picfile" enthält die Pakete #on("i")#picture#off("i")# und #on("i")#picfile#off("i")#.
+ 5. "GRAPHIK.Transform" stellt das Paket #on("i")#transformation#off("i")# zur Verfügung, in dem
+ interne Prozeduren zur Projektion definiert werden.
+ 6. "GRAPHIK.Plot" definiert die Prozedur #on("i")#plot#off("i")# zur Darstellung eines
+ PICFILES auf dem Terminal
+ 7. "GRAPHIK.Plotter" definiert die Prozedur #on("i")#plotter#off("i")# zur Darstellung eines
+ PICFILES auf dem Plotter
+ 8. "GRAPHIK.Server" Server für einen Plotter-Spool
+ 9. "GRAPHIK.vektor plot" enthält Hilfsprogramme, die bei der Erstellung einer
+ eigenen Terminalanpassung benutzt werden können.
+ 10. "ZEICHENSATZ" enthält einen Zeichensatz für Terminals die im Graphik
+ Modus keinen Text ausgeben können.
+ 11. "PC.plot" Terminalanpassung für IBM-PC und ähnliche.
+ 12. "HP7475.plot" Terminalanpassung für HP7474-Plotter und Geräte mit
+ HP-GL.
+ 13. "Beispiel.Kreuz" Beispielprogramm
+ 14. "Beispiel.Sinus" Beispielprogramm
+
+#type ("trium12")#
+#on("b")#5. Installation#off("b")#
+#type ("times8")#
+
+
+ In der Datei #on("i")#gen Graphik#off("i")# ist ein Installationspragramm enthalten. Nach dem Starten des
+ Programms mit #on("i")#run ("gen Graphik")#off("i")# fragt es nach dem Dateinamen der Terminalanpas­
+ sung.
+ Steht keine Terminalanpassung für ein Endgerät zur Verfügung (und kann auch nicht
+ beschafft werden) so kann man durch Insertieren der Datei #on("i")#GRAPHIK.Picfile#off("i")# lediglich die
+ Leistungen der Pakete #on("i")#Picture#off("i")# und #on("i")#Picfile#off("i")# nutzen, ohne die erzeugten Graphiken darstellen
+ zu können.
+ Zur Benutzung eines #on("i")#Plotters#off("i")# über einen Spooler wird die Datei #on("i")#gen Plotter#off("i")# gestartet.
+
+
+ Beispiel:
+ 1. archive ("Graphik")
+ 2. fetch all (archive)
+ 3. release (archive)
+ 4. run ("gen Graphik")
+ <-- PC.Plot
+
+
+#type ("trium12")#
+#on("b")#6. Besonderheiten der PC.plot-Anpassung#off("b")#
+#type ("times8")#
+
+
+ Da der IBM-PC verschiedene Graphik- und Text-Modi kennt, wird durch das Pro­
+ gramm #on("i")#PC.plot#off("i")# die Prozedur #on("i")#graphik#off("i")# zusätzlich zur Verfügung gestellt. Sie erlaubt es den
+ PC in verschiedenen Graphik-Modi zu betreiben.
+
+ PROC graphik (INT CONST modus, pause)
+
+ Modus: 0 --- Keine Graphik (normaler Textmodus)
+ 1 --- hochauflösende Graphik, 50 Zeilen,
+ 640 * 400 Punkte, einfarbig
+ 2 --- hochauflösende Graphik, 25 Zeilen,
+ 640 * 400 Punkte, einfarbig
+ 3 --- mittlere Auflösung, 640 * 200 Punkte, 3 Farben
+ 4 --- IBM-PC Auflösung, 320 * 200 Punkte, 3 Farben.
+
+ Pause: Da der PC bei #on("i")#end plot#off("i")# wieder in den Normalmodus umschaltet und die Graphik
+ dann nicht mehr zu sehen ist, kann man eine #on("i")#pause#off("i")# angeben. Die hier eingestellte
+ Zeit ist aber nicht die Länge der Pause, sondern der Kehrwert der Blinkfrequenz
+ proportional.
+
+
diff --git a/system/std.graphik/1.8.7/doc/graphik beschreibung b/system/std.graphik/1.8.7/doc/graphik beschreibung
new file mode 100644
index 0000000..53ebe49
--- /dev/null
+++ b/system/std.graphik/1.8.7/doc/graphik beschreibung
@@ -0,0 +1,661 @@
+#type ("basker12")##limit (16.0)##block#
+
+#head#
+#type ("triumb18")#
+#center#EUMEL-Grafik-System
+#type ("basker12")#
+#end#
+ #on("italics")#gescheit, gescheiter,
+ gescheitert#off("italics")#
+
+#type ("basker14")#
+#on("bold")#Beschreibung der Graphik-Prozeduren#off("bold")#
+#type ("basker12")#
+
+ #on("italics")#Zweidimensionale PICTURE brauchen weniger Speicherplatz als dreidimen­
+ sionale. Daher werden in einigen Fehlermeldungen unterschiedliche Größen
+ angegeben.#off("italics")#
+
+#on("underline")#Picture-Prozeduren#off("underline")#
+PICTURE
+
+
+:=
+ OP := (PICTURE VAR l, PICTURE CONST r)
+ Zweck: Zuweisung
+
+CAT
+ OP CAT (PICTURE VAR l, PICTURE CONST r)
+ Zweck: Aneinanderfügen von zwei PICTURE.
+ Fehlerfälle:
+ * left dimension <> right dimension
+ Es können nur PICTURE mit gleicher Dimension angefügt werden.
+ * Picture overflow
+ Die beiden PICTURE überschreiten die maximale Größe eines
+ PICTURE.
+
+nilpicture
+ PICTURE PROC nilpicture
+ Zweck: Die Prozedur liefert ein leeres PICTURE zur Initialisierung.
+
+draw
+ PROC draw (PICTURE VAR p, TEXT CONST text)
+ Zweck: Der angegebene Text wird gezeichnet. Der Anfang ist dabei die aktuelle
+ Stiftposition, die nicht verändert wird.
+ Fehlerfälle:
+ * Picture overflow
+ Der Text paßt nicht mehr in das PICTURE.
+
+ PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle,
+ height, bright)
+ Zweck: Der angegebene Text wird unter dem Winkel #on("italics")#angle#off("italics")# gegenüber der
+ Waagerechten mit der Zeichenhöhe #on("italics")#hight#off("italics")# und der Breite #on("italics")#bright#off("italics")# gezeich­
+ net. Der Anfang ist dabei die aktuelle Stiftposition, die nicht verändert
+ wird.
+ Fehlerfälle:
+ * Picture overflow
+ Der Text paßt nicht mehr in das PICTURE.
+
+ PROC draw (PICTURE VAR p, REAL CONST x, y, z)
+ Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y, z).
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is two dimensional
+
+ PROC draw (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y).
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+
+draw r PROC draw r (PICTURE VAR p, REAL CONST x, y, z)
+ Zweck: Zeichnen einer Linie der Länge (x, y, z) relativ zur aktuellen Position.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is two dimensional
+
+ PROC draw r (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Zeichnen einer Linie der Länge (x, y) relativ zur aktuellen Position.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+
+draw cm
+ PROC draw cm (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y) cm.
+ Dabei werden die angegebenen Projektionsparameter nicht beachtet,
+ sondern die Angaben in #on("bold")#Zentimeter#off("bold")# berechnet.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+
+draw cm r
+ PROC draw cm r (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Zeichnen einer Linie der Länge (x, y) cm relativ zur aktuellen Position.
+ Dabei werden die angegebenen Projektionsparameter nicht beachtet,
+ sondern die Angaben in #on("bold")#Zentimeter#off("bold")# berechnet.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+
+move
+ PROC move (PICTURE VAR p, REAL CONST x, y, z)
+ Zweck: Die aktuelle Position wird auf (x, y, z) gesetzt.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is two dimensional
+
+ PROC move (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Die aktuelle Position wird auf (x, y) gesetzt.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+
+move r
+ PROC move r (PICTURE VAR p, REAL CONST x, y, z)
+ Zweck: Die aktuelle Position wird um (x, y, z) erhöht.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is two dimensional
+
+ PROC move r (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Die aktuelle Position wird um (x, y) erhöht.
+ Position.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+
+move cm
+ PROC move cm (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Die aktuelle Position wird auf (x, y) cm gesetzt. Dabei werden die an­
+ gegebenen Projektionsparameter nicht beachtet, sondern die Angaben in #on("bold")#
+ Zentimeter#off("bold")# berechnet.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+
+move cm r
+ PROC move cm r (PICTURE VAR p, REAL CONST x, y)
+ Zweck: Die aktuelle Position wird um (x, y) cm erhöht. Dabei werden die an­
+ gegebenen Projektionsparameter nicht beachtet, sondern die Angaben in #on("bold")#
+ Zentimeter#off("bold")# berechnet.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+
+bar
+ PROC bar (PICTURE VAR p, REAL CONST width, hight, INT CONST
+ pattern):
+ Zweck: Die Prozedur zeichnet an der aktuellen Position einen Balken mit dem
+ Muster #on("italics")#pattern#off("italics")#: 0 = Leerer Balken
+ 1 = Gepunkteter Balken
+ 2 = Gefüllter Balken
+ 3 = Horizontale Linien
+ 4 = Vertikale Linien
+ 5 = Gekreuzte Linien
+ 6 = Diagonale Linien von Links nach Rechts
+ 7 = Diagonale Linien von Rechts nach Links
+ 8 = Gekreuzte diagonale Linien.
+ Die aktuelle Stiftposition wird dabei nicht verändert.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+ * Unknown pattern
+ Das angegebene Muster liegt nicht im Bereich 0-8
+
+circle
+ PROC circle (PICTURE VAR p, REAL CONST from, to, INT CONST
+ pattern)
+ Zweck: Die Prozedur zeichnet an der aktuellen Position ein Kreissegment vom
+ Winkel #on("italics")#from#off("italics")# bis #on("italics")#to#off("italics")# (im Gradmaß) mit dem Muster #on("italics")#pattern#off("italics")# (s.o.). Die
+ aktuelle Stiftposition wird dabei nicht verändert.
+ Fehlerfälle:
+ * Picture overflow
+ Zu viele Befehle in einem PICTURE
+ * Picture is three dimensional
+ * Unknown pattern
+ Das angegebene Muster liegt nicht im Bereich 0-8
+
+dim
+ INT PROC dim (PICTURE CONST pic)
+ Zweck: Liefert die Dimension eines PICTURE.
+
+pen
+ INT PROC pen (PICTURE CONST p)
+ Zweck: Liefert den virtuellen Stift des PICTURE
+
+ PROC pen (PICTURE VAR p, INT CONST pen)
+ Zweck: Setzen des (virtuellen) Stiftes eines PICTURE. Bei pen=0 wird das
+ Picture nicht gezeichnet.
+ Fehlerfälle:
+ * pen out of range
+ Der gewünschte Stift ist kleiner als 0 oder größer als 16.
+
+extrema
+ PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y
+ max)
+ Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE.
+ Fehlerfälle:
+ * Picture is three dimensional
+
+ PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y
+ max, z min, z max)
+ Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE.
+ Fehlerfälle:
+ * Picture is two dimensional
+
+where
+ PROC where (PICTURE CONST p, REAL VAR x, y, z)
+ Zweck: Die Prozedur liefert die aktuelle Stiftposition (Angaben mit #on("italics")#cm#off("italics")# werden
+ dabei nicht berücksichtigt).
+ Fehlerfälle:
+ * Picture is two dimensional
+
+ PROC where (PICTURE CONST p, REAL VAR x, y, z)
+ Zweck: Die Prozedur liefert die aktuelle Stiftposition (Angaben mit #on("italics")#cm#off("italics")# werden
+ dabei nicht berücksichtigt).
+ Fehlerfälle:
+ * Picture is three dimensional
+
+rotate:
+ PROC rotate (PICTURE VAR p, REAL CONST angle)
+ Zweck: Das PICTURE wird um den Punkt (0, 0) um den Winkel #on("italics")#angle#off("italics")# (im
+ Gradmaß) im mathematisch positiven Sinn gedreht.
+ Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#
+ verändert.
+
+ PROC rotate (PICTURE CONST p, REAL CONST phi, theta, lambda ) :
+ PICTURE 1-397
+ Zweck: Das PICTURE wird um den Winkel #on("italics")#lambda#off("italics")# um die Drehachse #on("italics")#(phi,
+ theta)#off("italics")# gedreht.
+ Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#
+ verändert.
+
+stretch
+ PROC stretch (PICTURE VAR pic, REAL CONST sx, sy)
+ Zweck: Das PICTURE wird in X-Richtung um den Faktor #on("italics")#sx#off("italics")#, in Y-Rich­
+ tung um den Faktor #on("italics")#sy#off("italics")# gestreckt (bzw. gestaucht). Dabei bewirkt der
+ Faktor
+ s > 1 eine Streckung
+ 0 < s < 1 eine Stauchung
+ s < 0 zusätzlich eine Achsenspiegelung.
+ Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#
+ verändert.
+ Fehlerfälle:
+ * Picture is three dimensional
+
+ PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz)
+ Zweck: s. o.
+ Fehlerfälle:
+ * Picture is two dimensional
+
+translate
+ PROC translate (PICTURE VAR p, REAL CONST dx, dy)
+ Zweck: Das PICTURE wird um #on("italics")#dx#off("italics")# und #on("italics")#dy#off("italics")# verschoben.
+ Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#
+ verändert.
+ Fehlerfälle:
+ * Picture is three dimensional
+
+ PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz)
+ Zweck: s. o.
+ Fehlerfälle:
+ * Picture is two dimensional
+
+plot PROC plot (PICTURE CONST p)
+ Zweck: Das Picfile wird gezeichnet.
+ Achtung: Es wird kein #on("italics")#begin plot#off("italics")# oder #on("italics")#end plot#off("italics")# durchgeführt. Es wird
+ auch kein Stift gsetzt und die Projektionsparameter bleiben
+ unverändert.
+
+
+#on("underline")#Graphische PICFILE-Prozeduren#off("underline")#
+plot
+ PROC plot (TEXT CONST name)
+ Zweck: Der PICFILE mit dem Namen #on("italics")#name#off("italics")# wird entsprechend der angegebenen
+ Darstellungsart gezeichnet. Diese Parameter (#on("italics")#perspective, orthographic,
+ oblique, view, window etc.#off("italics")#) müssen vorher eingestellt werden.
+ Fehlerfälle:
+ * PICFILE does not exist
+ Es existiert kein PICFILE mit dem Namen #on("italics")#name#off("underline")#
+
+ PROC plot (PICFILE VAR p)
+ Zweck: Der PICFILE #on("italics")#p#off("italics")# wird entsprechend der angegebenen Darstellungsart ge­
+ zeichnet. Diese Parameter müssen vorher eingestellt werden:
+
+ #on("bold")#zweidimensional:#off("bold")#
+ obligat: #on("italics")#window#off("italics")# (zweidimensional)
+ optional: #on("italics")#view#off("italics")# (zweidimensional)
+ #on("italics")#viewport#off("italics")#
+ #on("italics")#select pen#off("italics")#
+
+ #on("bold")#dreidimensional:#off("bold")#
+ obligat: #on("italics")#window#off("italics")# (dreidimensional)
+ optional: #on("italics")#view#off("italics")# (dreidimensional)
+ #on("italics")#orthographic | perspective | oblique#off("italics")#
+ #on("italics")#viewport#off("italics")#
+ #on("italics")#select pen#off("italics")#
+
+
+select pen
+ PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line
+ type,
+ BOOL VAR hidden lines) Zweck: Für die
+ Darstellung des Bildes #on("italics")#p#off("italics")# soll dem #on("italics")#virtuellen#off("italics")# Stift #on("italics")#pen#off("italics")# ein realer Stift
+ zugeordnet werden, der möglichst die Farbe #on("italics")#colour#off("italics")# und die Dicke #on("italics")#thick­
+ ness#off("italics")# hat und dabei Linien mit dem Typ #on("italics")#line type#off("italics")# zeichnet. Es wird die
+ beste Annäherung für das Ausgabegerät genommen.
+ Wenn #on("italics")#hidden lines#off("italics")# auf TRUE gesetzt wird, werden bei dreidimensionalen
+ Zeichnungen die verdeckten Linien mitgezeichnet, ansonsten werden sie
+ unterdrückt. Um sicherzustellen, das der Algorithmus auch funktioniert,
+ müssen die Linien allerdings von vorn nach hinten gezeichnet werden. Es
+ ist also nicht möglich, das Bild so zu drehen, das die hinteren Linien
+ zuerst gezeichnet werden.
+ Dabei gelten folgende Vereinbarungen:
+
+ #on("bold")#Farbe:#off("bold")# Negative Farben werden XOR gezeichnet (dunkel wird hell und
+ hell wird dunkel), Farbe 0 ist der Löschstift und positive Farben
+ überschreiben (ersetzen) den alten Punkt mit folgenden Werten:
+
+ 1 Standardfarbe des Endgerätes
+ 2 rot
+ 3 blau
+ 4 grün
+ 5 schwarz
+ 6 weiß
+ > 6 nicht normierte Sonderfarben
+
+
+ #on("bold")#Dicke:#off("bold")# 0 Standardstrichstärke des Endgerätes, ansonsten Strichstärke in
+ 1/10 mm.
+
+
+ #on("bold")#Linientyp:#off("bold")#
+ 0 keine sichtbare Linie
+ 1 durchgängige Linie
+ 2 gepunktete Linie
+ 3 kurz gestrichelte Linie
+ 4 lang gestrichelte Linie
+ 5 Strichpunktlinie
+ > 5 nicht normierte Linie
+
+ #on("bold")#Verdeckte Linien:#off("bold")#
+ TRUE Verdeckte Linien werden mitgezeichnet
+ FALSE Verdeckte Linien werden unterdrückt (nur bei drei­
+ dimensionalen PICTURE)
+
+ Die hier aufgeführten Möglichkeiten müssen nicht an allen graphischen
+ Endgeräten vorhanden sein. Der geräteabhängige Graphik-Treiber wählt
+ jeweils die bestmögliche Annäherung.
+
+ Fehlerfälle:
+ * pen out of range
+ #on("italics")#pen#off("italics")# muss im Bereich 1-16 sein.
+
+background
+ PROC background (PICFILE VAR p, INT CONST colour)
+ Zweck: Der Hintergrund wird auf die Farbe #on("italics")#colour#off("italics")# (s.o.) gesetzt wenn möglich.
+
+ INT PROC background (PICFILE CONST p):
+ Zweck: Liefert die eingestellte Hintergrundfarbe.
+
+view
+ PROC view (PICFILE VAR p, REAL CONST alpha)
+ Zweck: Setzt den Winkel der Y-Achse zur Senkrechten auf #on("italics")#alpha#off("italics")# Grad, falls
+ diese nicht senkrecht zur Betrachtungsebene steht.
+
+ PROC view (PICFILE VAR p, REAL CONST phi, theta)
+ Zweck: Dreidimensionale Bilder werden häufig nicht direkt von vorne dargestellt,
+ sondern für die Betrachtung gedreht. Mit der Prozedur #on("italics")#view#off("italics")# kann die
+ Betrachtungsrichtung durch die Polarwinkel #on("italics")#phi#off("italics")# und #on("italics")#theta#off("italics")# (im Gradmass)
+ angegeben werden. Voreingestellt ist #on("italics")#phi#off("italics")# = 0 und #on("italics")#theta#off("bold")# = 0, d.h. senk­
+ recht von oben.
+
+ Im Gegensatz zu #on("italics")#rotate#off("italics")# hat #on("italics")#view#off("italics")# keine Wirkung auf das eigentliche Bild
+ (PICFILE), sondern nur auf die gewählte Darstellung. So addieren sich
+ zwar aufeinanderfolgende #on("italics")#Rotationen#off("italics")#, #on("italics")#view#off("italics")# aber geht immer von der
+ Nullstellung aus. Auch kann das Bild durch eine #on("italics")#Rotation#off("italics")# ganz oder
+ teilweise aus oder in das Darstellungsfenster (#on("italics")#window#off("italics")# gedreht werden. Bei
+ #on("italics")#view#off("italics")# verändern sich die Koordinaten der Punkte nicht, d. h. das Fenster
+ wird mitgedreht.
+
+ PROC view (PICFILE VAR p, REAL CONST x, y, z)
+ Zweck: Wie oben, nur werden die Winkel nicht in Polarkoordinaten angegeben,
+ sondern es wird die Blickrichtung als Vektor in Karthesischen Koordina­
+ ten angegeben. (Die Länge darf ungleich 1 sein).
+
+viewport
+ PROC viewport (PICFILE VAR p, REAL CONST hormin, hormax, vertmin,
+ vertmax) : 1-709
+ Zweck: Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt werden
+ soll, wird spezifiziert. Dabei wird sowohl die Größe als auch die relative
+ Lage der Zeichenfläche definiert. Der linke untere Eckpunkt der physi­
+ kalischen Zeichenfläche des Gerätes hat die Koordinaten (0, 0). Die
+ definierte Zeichenfläche erstreckt sich
+
+ #on("italics")#hormin - hormax#off("italics")# in der Horizontalen,
+ #on("italics")#vertmin - vertmax#off("italics")# in der Vertikalen.
+
+ So liegt der linke untere Eckpunkt dann bei (#on("italics")#hormin, hormax#off("italics")#), der rechte
+ obere Eckpunkt bei (#on("italics")#hormax, vertmax#off("italics")#).
+
+ Damit sowohl geräteunabhängige als auch maßstabgetreue Zeichnungen
+ möglich sind, können die Koordinaten in zwei Arten spezifiziert werden:
+ a) #on("bold")#Gerätekoordinaten#off("bold")#
+ Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei
+ hat die kürzere Seite der physikalischen Zeichenfläche definitionsge­
+ mäß die Länge 1.0.
+ b) #on("bold")#Absolute Koordinaten#off("bold")#
+ Die Werte werden in #on("italics")#cm#off("italics")# angegeben. Dabei müssen die Maximal­
+ werte aber größer als 2.0 sein, da sonst Fall a) angenommen wird.
+
+ Voreingestellt ist
+
+ viewport (0.0, 1.0, 0.0, 1.0)
+
+ d.h. das größtmögliche Quadrat, beginnend mit der linken unteren Ecke
+ der physikalischen Zeichenfläche. In vielen Fällen wird diese Einstellung
+ ausreichen, so daß der Anwender kein eigenes #on("italics")#viewport#off("italics")# definieren muss.
+
+ Der Abbildungsmaßstab wird durch das Zusammenspiel von #on("italics")#viewport#off("italics")# und
+ #on("italics")#window#off("italics")# festgelegt (s. dort). Dabei ist insbesondere darauf zu achten, daß
+ winkeltreue Darstellung nur bei gleichen X- und Y-Maßstab möglich
+ ist. Da man oft quadratische Fenster (#on("italics")#window#off("italics")#) verwendet, wurde als
+ Standardeinstellung auch ein quadratisches #on("italics")#viewport#off("italics")# gewählt.
+
+ Hinweis: Mit der Prozedur #on("italics")#check limit#off("italics")# aus dem PACKET #on("italics")#basis plot#off("italics")# kann die
+ Überprüfung der Grenzen des eingestellten #on("italics")#viewport#off("italics")#-Bereiches ein-
+ bzw. ausgeschaltet werden. Bei eingeschateter Überprüfung, werden
+ Linien, die den Bereich überschreiten, am Rand abgetrennt.
+
+
+window
+ PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max)
+ Zweck: Für die Darstellung eines zweidimensionalen Bildes wird das darzustel­
+ lende Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im In-
+ tervall [#on("italics")#x min, x max#off("italics")#] und deren Y-Koordinaten im Bereich [#on("italics")#y min, y
+ max#off("italics")#] liegen, gehören zum definierten Fenster.Vektoren, die außerhalb
+ dieses Fensters liegen, gehen über die durch #on("italics")#viewport#off("italics")# Fläche hinaus
+ (s.dort).
+
+ Der Darstellungsmaßstab ergibt sich als
+
+ #ub#               x max - x min               #ue#
+ horizontale Seitenlänge der Zeichenfläche
+
+
+ #ub#               y max - y min               #ue#
+ vertikale Seitenlänge der Zeichenfläche
+
+ PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max,
+ z min, z max)
+
+ Zweck: Für die darstellung eines dreidimensionalen Bildes wird das darzustellende
+ Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im Intervall [#on("italics")#x
+ min, x max#off("italics")#], deren Y-Koordinaten im Bereich [#on("italics")#y min, y max#off("italics")#] und
+ deren Z-Koordinaten im Bereich [#on("italics")#z min, z max#off("italics")#] liegen, gehören zum
+ definierten Fenster. Dieses dreidimensionale Fenster (#on("italics")#Quader#off("italics")#) wird ent­
+ sprechend der eingestellten Projektionsart (orthographisch, perspektivisch
+ oder schiefwinklig) und den Betrachtungswinkeln (s. #on("italics")#view#off("italics")#) auf die spezi­
+ fizierte Zeichenfläche abgebildet.
+ Anders als im zweidimensionalen Fall ist das Problem der Maßstaäbe
+ nicht mehr nur durch das Zusammenspiel von #on("italics")#window#off("italics")# und #on("italics")#viewport#off("italics")# zu
+ beschreiben. Hier spielen auch die Projektionsart und Darstellungswinkel
+ herein.
+
+oblique:
+ PROC oblique (PICFILE VAR p, REAL CONST a, b)
+ Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#schiefwinklig#off("underline")# als gewünschte
+ Projektionsart eingestellt. Dabei ist (#on("italics")#a, b#off("italics")#) der Punkt auf der X-Y-
+ Ebene, auf den der Einheitsvektor der Z-Richtung abgebildet werden
+ soll.
+
+orthographic
+ PROC orthographic (PICFILE VAR p)
+ Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#orthographisch#off("underline")# als gewünschte
+ Projektionsart eingestellt. Bei der orthographischen Projektion wird ein
+ dreidimensionaler Körper mit parallelen Strahlen senkrecht auf der Pro­
+ jektionsebene dabgebildet.
+
+perpective
+ PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz)
+ Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#perspectivisch#off("underline")# als gewünschte
+ Projektionsart eingestellt. Der Punkt (#on("italics")#cx, 1/cy, cz#off("underline")#) ist der Fluchtpunkt der
+ Projektion, d. h. alle Parallen zur Z-Achse schneiden sich in diesem
+ Punkt.
+
+extrema
+ PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max)
+ Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE.
+
+ PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z
+ min,z max) : 1-651
+ Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE.
+
+
+#on("underline")#Prozeduren zur Manipulation von PICFILE#off("underline")#
+:=
+ OP := (PICFILE VAR p, DATASPACE CONST d)
+ Zweck: Assoziert die PICFILE Variable #on("italics")#p#off("italics")# mit dem Datenraum #on("italics")#d#off("italics")# und initialisiert
+ die Variable, wenn nötig.
+ Fehlerfälle:
+ * dataspace is no PICFILE
+ Der anzukoppelnde Datenraum hat einen unzulässigen Typ
+
+picture file
+ DATASPACE PROC picture file (TEXT CONST name)
+ Zweck: Assoziaten eines benannten Datenraumes mit einem PICFILE (s.o.).
+
+put
+ PROC put (FILE VAR f, PICFILE VAR p)
+ Zweck: Schreibt den Inhalt eines PICFILE in ein FILE. Die Informationen
+ werden im internen Format abgelegt.
+
+get
+ PROC get (PICFILE VAR p, FILE VAR f)
+ Zweck: Liest den Inhalt eines PICFILE aus einem FILE. Die Informationen
+ müssen mit #on("italics")#put#off("italics")# geschrieben worden sein.
+ Fehlerfall:
+ * Picfile overflow
+ Es können nur maximal 1024 Picture (Sätze) in einem PICFILE abgelegt
+ werden.
+
+to first pic
+ PROC to first pic (PICFILE VAR p)
+ Zweck: Positioniert auf das erste PICTURE.
+
+to eof
+ PROC to last pic (PICFILE VAR p)
+ Zweck: Positioniert hinter das letzte PICTURE.
+
+to pic
+ PROC to pic (PICFILE VAR p, INT CONST pos)
+ Zweck: Positioniert auf das PICTURE Nummer #on("italics")#pos#off("italics")#.
+ Fehlerfälle:
+ * Position underflow
+ Es wurde eine Position kleiner Null angegeben. * Position after
+ eof Es wurde versucht, hinter das Ende eines PICFILE zu positionieren
+
+up
+ PROC up (PICFILE VAR p)
+ Zweck: Positioniert genau ein PICTURE zurück.
+ Fehlerfall:
+ * Position underflow
+ Es wurde versucht, vor das erste PICTURE zu positionieren
+
+ PROC up (PICFILE VAR p, INT CONST n)
+ Zweck: Positioniert genau #on("italics")#n#off("italics")# Picture zurück.
+ Fehlerfall:
+ * Position underflow
+ Es wurde versucht, vor das erste PICTURE zu positionieren
+
+down
+ PROC down (PICFILE VAR p)
+ Zweck: Positioniert genau ein PICTURE vorwärts.
+ Fehlerfall:
+ * Position after eof
+ Es wurde versucht, hinter das Ende eines PICFILE zu positionieren
+
+ PROC down (PICFILE VAR p, INT CONST n)
+ Zweck: Positioniert genau #on("italics")#n#off("italics")# Picture vorwärts.
+ Fehlerfall:
+ * Position after eof
+ Es wurde versucht, hinter das Ende eines PICFILE zu positionieren
+
+is first picture
+ BOOL PROC is first picture (PICFILE CONST p)
+ Zweck: Liefert genau dann #on("italics")#TRUE#off("italics")#, wenn das erste PICTURE erreicht ist.
+
+eof
+ BOOL PROC eof (PICFILE CONST p)
+ Zweck: Liefert genau dann #on("italics")#TRUE#off("italics")#, wenn das Ende eines PICFILE erreicht ist.
+
+picture no
+ INT PROC picture no (PICFILE CONST p)
+ Zweck: Liefert die Nummer des aktuellen PICTURE.
+
+pictures
+ INT PROC pictures (PICFILE CONST p)
+ Zweck: Liefert die Anzahl PICTURE eines PICFILE.
+
+delete picture
+ PROC delete picture (PICFILE VAR p)
+ Zweck: Löscht das aktuelle PICTURE
+
+insert picture
+ PROC insert picture (PICFILE VAR p)
+ Zweck: Fügt ein PICTURE #on("underline")#vor#off("underline")# der aktuellen Position ein.
+
+read picture
+ PROC read picture (PICFILE CONST p, PICTURE VAR pic)
+ Zweck: Liest das aktuelle PICTURE.
+
+write picture
+ PROC write picture (PICFILE VAR p, PICTURE CONST pic)
+ Zweck: Schreibt das PICTURE #on("italics")#pic#off("italics")# auf der aktuellen Position.
+
+put picture
+ PROC write picture (PICFILE VAR p, PICTURE CONST pic)
+ Zweck: Schreibt das PICTURE #on("italics")#pic#off("italics")# hinter das letzte PICTURE des PICFILE.
+ Die aktuelle Position wird nicht verändert.
+
+#page#
+ #on("italics")#Wo wir sind, da klappt nichts,
+ aber wir können nicht überall sein !#off("italics")#
+
+#type ("basker14")#
+#on("bold")#Kurzbeschreibung des Graphik-Editors#off("bold")#
+#type ("basker12")#
+
+In der Kommondozeile werden folgende Informationen angezeigt:
+
+#on("revers")#LEN nnnnn <...Name...> DIM n PEN nn Picture nnnn
+#off("revers")#
+
+
+Folgende Kommandos stehen zur Verfügung:
+
+ PICTURE PROC pic neu
+ PICFILE PROC picfile neu
+ PROC neu zeichnen
+
+ OP UP n (n PICTURE up)
+ OP DOWN n (n PICTURE down)
+ OP T n (to PICTURE n)
+
+ PROC oblique (REAL CONST a, b)
+ PROC orthographic
+ PROC perspective (REAL CONST cx, cy, cz)
+ PROC window (BOOL CONST dev)
+ PROC window (REAL CONST x min, x max, y min, y max)
+ PROC window (REAL CONST x min, x max, y min, y max, z min, z max)
+ PROC viewport (REAL CONST h min, h max, v min, v max)
+ PROC view (REAL CONST alpha)
+ PROC view (REAL CONST phi, theta)
+ PROC view (REAL CONST x, y, z)
+
+ PROC pen (INT CONST n)
+ PROC select pen (INT CONST pen, colour, thickness, line type, BOOL CONST
+ hidden)
+ PROC background (INT CONST colour)
+
+ PROC extrema pic
+ PROC extrema picfile
+ PROC selected pen
+
+ PROC rotate (REAL CONST angle)
+ PROC rotate (REAL CONST phi, theta, lambda )
+ PROC stretch (REAL CONST sx, sy)
+ PROC stretch (REAL CONST sx, sy, sz)
+ PROC translate (REAL CONST dx, dy)
+ PROC translate (REAL CONST dx, dy, dz)
+
diff --git a/system/std.graphik/1.8.7/source-disk b/system/std.graphik/1.8.7/source-disk
new file mode 100644
index 0000000..8e7ff34
--- /dev/null
+++ b/system/std.graphik/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/05_std.graphik.img
diff --git a/system/std.graphik/1.8.7/src/Beispiel.Kreuz b/system/std.graphik/1.8.7/src/Beispiel.Kreuz
new file mode 100644
index 0000000..e29f24a
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/Beispiel.Kreuz
@@ -0,0 +1,41 @@
+initialisiere picfile;
+zeichne die x achse;
+zeichne die y achse;
+zeichne die z achse;
+stelle das achsenkreuz dar .
+
+initialisiere picfile:
+ PICFILE VAR p :: picture file ("KREUZ") .
+
+zeichne die x achse:
+ PICTURE VAR x achse := nilpicture;
+ move (x achse, -1.0, 0.0, 0.0);
+ draw (x achse, "-X", 0.0, 0.0, 0.0);
+ draw (x achse, 1.0, 0.0, 0.0);
+ draw (x achse, "+X", 0.0, 0.0, 0.0);
+ put picture (p, x achse) .
+
+zeichne die y achse:
+ PICTURE VAR y achse := nilpicture;
+ move (y achse, 0.0, -1.0, 0.0);
+ draw (y achse, "-Y", 0.0, 0.0, 0.0);
+ draw (y achse, 0.0, 1.0, 0.0);
+ draw (y achse, "+Y", 0.0, 0.0, 0.0);
+ put picture (p, y achse) .
+
+zeichne die z achse:
+ PICTURE VAR z achse := nilpicture;
+ move (z achse, 0.0, 0.0, -1.0);
+ draw (z achse, "-Z", 0.0, 0.0, 0.0);
+ draw (z achse, 0.0, 0.0, 1.0);
+ draw (z achse, "+Z", 0.0, 0.0, 0.0);
+ put picture (p, z achse) .
+
+stelle das achsenkreuz dar:
+ viewport (p, 0.0, 1.0, 0.0, 1.0);
+ window (p, -1.1, 1.1, -1.1, 1.1);
+ oblique (p, 0.25, 0.15);
+ plot (p) .
+
+
+
diff --git a/system/std.graphik/1.8.7/src/Beispiel.Sinus b/system/std.graphik/1.8.7/src/Beispiel.Sinus
new file mode 100644
index 0000000..beac7cd
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/Beispiel.Sinus
@@ -0,0 +1,45 @@
+initialisiere picfile;
+zeichne überschrift;
+zeichne achsen;
+zeichne sinuskurve;
+wähle darstellung;
+plot (p) .
+
+initialisiere picfile:
+ PICFILE VAR p :: picture file ("SINUS") .
+
+zeichne überschrift:
+ PICTURE VAR überschrift :: nilpicture;
+ move (überschrift, -pi/2.0, 1.0);
+ draw (überschrift, "sinus (x) [-pi, +pi]", 0.0, 1.0, 0.6);
+ put picture (p, überschrift) .
+
+zeichne achsen:
+ PICTURE VAR achsen :: nilpicture;
+ zeichne x achse;
+ zeichne y achse;
+ put picture (p, achsen) .
+
+zeichne x achse:
+ move (achsen, -pi, 0.0);
+ draw (achsen, pi, 0.0) .
+
+zeichne y achse:
+ move (achsen, 0.0, -1.0);
+ draw (achsen, 0.0, +1.0) .
+
+zeichne sinuskurve:
+ PICTURE VAR sinus :: nilpicture;
+ REAL VAR x :: -pi;
+
+ move (sinus, x, sin (x));
+ REP x INCR 0.1;
+ draw (sinus, x, sin (x))
+ UNTIL x >= pi PER;
+
+ put picture (p, sinus) .
+
+wähle darstellung:
+ window (p, -pi, pi, -1.0, 1.3);
+ viewport (p, 0.0, 0.0, 0.0, 0.0) .
+
diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Picfile b/system/std.graphik/1.8.7/src/GRAPHIK.Picfile
new file mode 100644
index 0000000..3accf52
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Picfile
@@ -0,0 +1,738 @@
+PACKET picture DEFINES (*Autor: Heiko.Indenbirken *)
+ PICTURE, (*Stand: 12.03.1985 *)
+ :=, CAT, nilpicture, (*Änderung: 20.08.85/10:38 *)
+ draw, draw r, (*Änderung: 05.08.86/12:21 *)
+ move, move r,
+ mark, bar, circle,
+ length, dim, pen, where,
+ extrema, rotate, stretch, translate,
+ picture:
+
+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,
+ max length = 31974;
+
+LET overflow = "Picture overflow",
+ pen range = "pen out of range [0-16]",
+ dim 3 = "Picture is 3 dimensional",
+ dim 2 = "Picture is 2 dimensional",
+ dim init = "Picture isn't initialized",
+ wrong key = "wrong key code",
+ nil = "",
+ zero = ""0"";
+
+TYPE PICTURE = STRUCT (INT dim, pen, TEXT points);
+
+
+INT VAR read pos;
+REAL VAR x, y, z;
+TEXT VAR r1 :: 8*zero, r2 :: 16*zero, r3 :: 24*zero, i1 :: 2*zero;
+
+OP := (PICTURE VAR l, PICTURE CONST r) :
+ CONCR (l) := CONCR (r)
+END OP :=;
+
+OP CAT (PICTURE VAR l, PICTURE CONST r) :
+ check dim (l, r.dim);
+ IF length (l.points) > max length - length (r.points)
+ THEN errorstop (overflow) FI;
+
+ l.points CAT r.points
+END OP CAT;
+
+PICTURE PROC nilpicture :
+ PICTURE : (0, 1, nil)
+END PROC nilpicture;
+
+PICTURE PROC nilpicture (INT CONST pen):
+ PICTURE : (0, pen, nil)
+END PROC nilpicture;
+
+PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, bright):
+ write (p.points, text, angle, height, bright, text key)
+END PROC draw;
+
+PROC draw (PICTURE VAR p, REAL CONST x, y, z) :
+ check dim (p, 3);
+ write (p.points, x, y, z, draw key)
+END PROC draw;
+
+PROC draw (PICTURE VAR p, REAL CONST x, y) :
+ check dim (p, 2);
+ write (p.points, x, y, draw key)
+END PROC draw;
+
+PROC draw r (PICTURE VAR p, REAL CONST x, y, z) :
+ check dim (p, 3);
+ write (p.points, x, y, z, draw r key)
+END PROC draw r;
+
+PROC draw r (PICTURE VAR p, REAL CONST x, y) :
+ check dim (p, 2);
+ write (p.points, x, y, draw r key)
+END PROC draw r;
+
+PROC move (PICTURE VAR p, REAL CONST x, y, z) :
+ check dim (p, 3);
+ write (p.points, x, y, z, move key)
+END PROC move;
+
+PROC move (PICTURE VAR p, REAL CONST x, y) :
+ check dim (p, 2);
+ write (p.points, x, y, move key)
+END PROC move;
+
+PROC move r (PICTURE VAR p, REAL CONST x, y, z) :
+ check dim (p, 3);
+ write (p.points, x, y, z, move r key)
+END PROC move r;
+
+PROC move r (PICTURE VAR p, REAL CONST x, y) :
+ check dim (p, 2);
+ write (p.points, x, y, move r key)
+END PROC move r;
+
+PROC bar (PICTURE VAR p, REAL CONST width, height, INT CONST pattern):
+ check dim (p, 2);
+ write (p.points, width, height, pattern, bar 2 key)
+END PROC bar;
+
+PROC bar (PICTURE VAR p, REAL CONST from, to, height, INT CONST pattern):
+ check dim (p, 2);
+ write (p.points, from, to, height, pattern, bar 3 key)
+END PROC bar;
+
+PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern):
+ check dim (p, 2);
+ write (p.points, radius, from, to, pattern, circle key)
+END PROC circle;
+
+PROC mark (PICTURE VAR p, REAL CONST size, INT CONST no):
+ write (p.points, size, no, mark key)
+END PROC mark;
+
+PROC write (TEXT VAR points, REAL CONST x, y, z, INT CONST key) :
+ IF length (points) < max length
+ THEN points CAT code (key);
+ replace (r3, 1, x);
+ replace (r3, 2, y);
+ replace (r3, 3, z);
+ points CAT r3
+ ELSE errorstop (overflow) FI
+END PROC write;
+
+PROC write (TEXT VAR points, REAL CONST x, y, INT CONST key) :
+ IF length (points) < max length
+ THEN points CAT code (key);
+ replace (r2, 1, x);
+ replace (r2, 2, y);
+ points CAT r2
+ ELSE errorstop (overflow) FI
+END PROC write;
+
+PROC write (TEXT VAR points, REAL CONST x, y, INT CONST n, key) :
+ IF length (points) < max length
+ THEN points CAT code (key);
+ replace (r2, 1, x);
+ replace (r2, 2, y);
+ points CAT r2;
+ replace (i1, 1, n);
+ points CAT i1
+ ELSE errorstop (overflow) FI
+END PROC write;
+
+PROC write (TEXT VAR points, REAL CONST x, y, z, INT CONST n, key) :
+ IF length (points) < max length
+ THEN points CAT code (key);
+ replace (r3, 1, x);
+ replace (r3, 2, y);
+ replace (r3, 3, z);
+ points CAT r3;
+ replace (i1, 1, n);
+ points CAT i1
+ ELSE errorstop (overflow) FI
+END PROC write;
+
+PROC write (TEXT VAR points, TEXT CONST t, REAL CONST angle, height, bright,
+ INT CONST key) :
+ IF max length - length (points) >= length (t)
+ THEN points CAT code (key);
+ replace (i1, 1, length (t));
+ points CAT i1;
+ points CAT t;
+ replace (r3, 1, angle);
+ replace (r3, 2, height);
+ replace (r3, 3, bright);
+ points CAT r3
+ FI;
+END PROC write;
+
+PROC write (TEXT VAR points, REAL CONST size, INT CONST no, key) :
+ IF length (points) < max length
+ THEN points CAT code (key);
+ replace (r1, 1, size);
+ points CAT r1;
+ replace (i1, 1, no);
+ points CAT i1;
+ ELSE errorstop (overflow) FI
+END PROC write;
+
+PROC check dim (PICTURE VAR p, INT CONST dim):
+ IF p.dim = dim
+ THEN
+ ELIF p.dim = 0
+ THEN p.dim := dim
+ ELSE errorstop (dimension) FI .
+
+dimension:
+ IF p.dim = 2
+ THEN dim 2
+ ELIF p.dim = 3
+ THEN dim 3
+ ELSE dim init FI .
+
+END PROC check dim;
+
+INT PROC length (PICTURE CONST p):
+ length (p.points)
+END PROC length;
+
+INT PROC dim (PICTURE CONST pic) :
+ pic.dim
+END PROC dim;
+
+PICTURE PROC pen (PICTURE CONST p, INT CONST pen) :
+ IF pen < 0 OR pen > 16
+ THEN errorstop (pen range) FI;
+
+ PICTURE:(p.dim, pen, p.points)
+END PROC pen;
+
+INT PROC pen (PICTURE CONST p) :
+ p.pen
+END PROC pen;
+
+PROC where (PICTURE CONST p, REAL VAR x, y) :
+ IF p.dim = 0
+ THEN x := 0.0; y := 0.0
+ ELIF p.dim = 3
+ THEN errorstop (dim 3)
+ ELSE x := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;
+ y := subtext (p.points, length (p.points)-7, length (p.points)) RSUB 1
+ FI
+END PROC where;
+
+PROC where (PICTURE CONST p, REAL VAR x, y, z) :
+ IF p.dim = 0
+ THEN x := 0.0; y := 0.0; z := 0.0
+ ELIF p.dim = 2
+ THEN errorstop (dim 2)
+ ELSE x := subtext (p.points, length (p.points)-23, length (p.points)-16) RSUB 1;
+ y := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;
+ z := subtext (p.points, length (p.points)-7, length (p.points)) RSUB 1;
+ FI
+END PROC where;
+
+
+PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max, z min, z max) :
+ x min := max real; x max :=-max real;
+ y min := max real; y max :=-max real;
+ z min := max real; z max :=-max real;
+ read pos := 0;
+ INT CONST pic length := length (p.points);
+ WHILE read pos < pic length
+ REP check position PER .
+
+check position :
+ read pos INCR 1;
+ SELECT code (p.points SUB read pos) OF
+ CASE draw key : calc extrema
+ CASE move key : calc extrema
+ CASE move r key : calc rel extrema
+ CASE draw r key : calc rel extrema
+ CASE text key : read pos INCR next int + 24
+ CASE bar 2 key : read pos INCR 18
+ CASE bar 3 key, circle key : read pos INCR 26
+ CASE mark key: read pos INCR 4
+ OTHERWISE errorstop (wrong key) END SELECT .
+
+calc extrema :
+ x := next real; y := next real; z := next real;
+ x min := min (x min, x); x max := max (x max, x);
+ y min := min (y min, y); y max := max (y max, y);
+ z min := min (z min, z); z max := max (z max, z) .
+
+calc rel extrema :
+ x INCR next real; y INCR next real; z INCR next real;
+ x min := min (x min, x); x max := max (x max, x);
+ y min := min (y min, y); y max := max (y max, y);
+ z min := min (z min, z); z max := max (z max, z) .
+
+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 .
+
+END PROC extrema;
+
+PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max):
+ x min := max real; x max :=-max real;
+ y min := max real; y max :=-max real;
+ read pos := 0;
+ INT CONST pic length := length (p.points);
+ WHILE read pos < pic length
+ REP check position PER .
+
+check position :
+ read pos INCR 1;
+ SELECT code (p.points SUB read pos) OF
+ CASE draw key : calc extrema
+ CASE move key : calc extrema
+ CASE move r key : calc rel extrema
+ CASE draw r key : calc rel extrema
+ CASE text key : read pos INCR next int + 24
+ CASE bar 2 key : read pos INCR 18
+ CASE bar 3 key, circle key : read pos INCR 26
+ CASE mark key: read pos INCR 4
+ OTHERWISE errorstop (wrong key) END SELECT .
+
+calc extrema :
+ x := next real; y := next real;
+ x min := min (x min, x); x max := max (x max, x);
+ y min := min (y min, y); y max := max (y max, y) .
+
+calc rel extrema :
+ x INCR next real; y INCR next real;
+ x min := min (x min, x); x max := max (x max, x);
+ y min := min (y min, y); y max := max (y max, y) .
+
+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 .
+
+END PROC extrema;
+
+PROC rotate (PICTURE VAR p, REAL CONST angle) :
+ REAL CONST s :: sind( angle ), c := cosd( angle );
+ transform (p, ROW 4 ROW 3 REAL :
+ (ROW 3 REAL : ( 1.0, 0.0, 0.0 ),
+ ROW 3 REAL : ( 0.0, c , s ),
+ ROW 3 REAL : ( 0.0, -s , c ),
+ ROW 3 REAL : ( 0.0, 0.0, 0.0 )))
+END PROC rotate;
+
+PROC rotate (PICTURE VAR p, REAL CONST phi, theta, lambda ) :
+ REAL CONST s :: sind ( theta ), c :: cosd ( theta ),
+ s p :: sind ( phi ), s l :: sind ( lambda ),
+ ga :: cosd ( phi ), c l :: cosd ( lambda ),
+ be :: s p * s l, al :: s p * c l, c1 :: 1.0 - c;
+ transform (p, ROW 4 ROW 3 REAL :
+ (ROW 3 REAL : ( al*al*c1 + c , be*al*c1+ga*s, ga*al*c1-be*s ),
+ ROW 3 REAL : ( al*be*c1-ga*s, be*be*c1 + c , ga*be*c1+al*s ),
+ ROW 3 REAL : ( al*ga*c1+be*s, be*ga*c1-al*s, ga*ga*c1 + c ),
+ ROW 3 REAL : ( 0.0 , 0.0 , 0.0 )))
+END PROC rotate;
+
+PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) :
+ stretch (pic, sx, sy, 1.0)
+END PROC stretch;
+
+PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) :
+ transform (p, ROW 4 ROW 3 REAL :
+ (ROW 3 REAL : ( sx, 0.0, 0.0),
+ ROW 3 REAL : (0.0, sy, 0.0),
+ ROW 3 REAL : (0.0, 0.0, sz),
+ ROW 3 REAL : (0.0, 0.0, 0.0)))
+END PROC stretch;
+
+PROC translate (PICTURE VAR p, REAL CONST dx, dy) :
+ translate (p, dx, dy, 0.0)
+END PROC translate;
+
+PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) :
+ transform (p, ROW 4 ROW 3 REAL :
+ (ROW 3 REAL : (1.0, 0.0, 0.0),
+ ROW 3 REAL : (0.0, 1.0, 0.0),
+ ROW 3 REAL : (0.0, 0.0, 1.0),
+ ROW 3 REAL : ( dx, dy, dz)))
+END PROC translate;
+
+PROC transform (PICTURE VAR p, ROW 4 ROW 3 REAL CONST a) :
+ INT CONST pic length := length (p.points);
+ INT VAR begin pos;
+ read pos := 0;
+ x := 0.0; y := 0.0; z := 0.0;
+ IF p.dim = 2
+ THEN transform 2 dim pic
+ ELSE transform 3 dim pic FI .
+
+transform 2 dim pic:
+ WHILE read pos < pic length
+ REP transform 2 dim position PER .
+
+transform 2 dim position:
+ read pos INCR 1;
+ SELECT code (p.points SUB read pos) OF
+ CASE draw key : transform 2 dim point
+ CASE move key : transform 2 dim point
+ CASE move r key : transform 2 dim point
+ CASE draw r key : transform 2 dim point
+ CASE text key : read pos INCR next int + 24
+ CASE bar 2 key : read pos INCR 18
+ CASE bar 3 key, circle key : read pos INCR 26
+ CASE mark key: read pos INCR 4
+ OTHERWISE errorstop (wrong key) END SELECT .
+
+transform 2 dim point:
+ begin pos := read pos+1;
+ x := next real; y := next real;
+ transform (a, x, y, z);
+ replace (r2, 1, x);
+ replace (r2, 2, y);
+ replace (p.points, begin pos, r2) .
+
+transform 3 dim pic:
+ WHILE read pos < pic length
+ REP transform 3 dim position PER .
+
+transform 3 dim position :
+ read pos INCR 1;
+ SELECT code (p.points SUB read pos) OF
+ CASE draw key : transform 3 dim point
+ CASE move key : transform 3 dim point
+ CASE move r key : transform 3 dim point
+ CASE draw r key : transform 3 dim point
+ CASE text key : read pos INCR next int + 24
+ CASE bar 2 key : read pos INCR 18
+ CASE bar 3 key, circle key : read pos INCR 26
+ CASE mark key: read pos INCR 4
+ OTHERWISE errorstop (wrong key) END SELECT .
+
+transform 3 dim point:
+ begin pos := read pos+1;
+ x := next real; y := next real; z := next real;
+ transform (a, x, y, z);
+ replace (r3, 1, x);
+ replace (r3, 2, y);
+ replace (r3, 3, z);
+ replace (p.points, begin pos, r3) .
+
+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 .
+
+END PROC transform;
+
+PROC transform (ROW 4 ROW 3 REAL CONST a, REAL VAR x, y, z) :
+ REAL CONST ox :: x, oy :: y, oz :: z;
+ x := ox*a(1)(1) + oy*a(2)(1) + oz*a(3)(1) + a(4)(1);
+ y := ox*a(1)(2) + oy*a(2)(2) + oz*a(3)(2) + a(4)(2);
+ z := ox*a(1)(3) + oy*a(2)(3) + oz*a(3)(3) + a(4)(3)
+END PROC transform;
+
+PROC picture (PICTURE CONST pic, TEXT VAR points, INT VAR dim, pen):
+ dim := pic.dim;
+ pen := pic.pen;
+ points := pic.points;
+END PROC picture;
+
+END PACKET picture;
+
+PACKET picfile DEFINES (*Autor: Heiko Indenbirken *)
+ (*Stand: 23.02.1985 *)
+ PICFILE, :=, picture file, (*Änderung: 13.10.89/23:11 *)
+ select pen, selected pen, background,
+ set values, get values,
+ view, viewport, window,
+ oblique, orthographic, perspective,
+ extrema,
+
+ to pic, up, down,
+ eof, picture no, pictures,
+ delete picture, insert picture,
+ read picture, write picture,
+ get picture, put picture:
+
+
+LET no picfile = "dataspace is no PICFILE",
+ pen range = "pen out of range",
+ pos under = "Position underflow",
+ pos over = "Position overflow",
+ pic over = "PICFILE overflow";
+
+LET max pics = 1024,
+ pic dataspace = 1103;
+
+
+TYPE PICFILE = BOUND STRUCT (INT size, pos, background,
+ ROW 16 ROW 3 INT pens,
+ 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);
+
+INT VAR i;
+
+OP := (PICFILE VAR l, PICFILE CONST r):
+ EXTERNAL 260
+END OP :=;
+
+OP := (PICFILE VAR p, DATASPACE CONST d) :
+ IF type (d) = pic dataspace
+ THEN CONCR (p) := d
+ ELIF type (d) < 0
+ THEN type (d, pic dataspace) ;
+ CONCR (p) := d ;
+ init picfile dataspace ;
+ ELSE errorstop (no picfile) FI .
+
+init picfile dataspace :
+ r.size := 0;
+ r.pos := 1;
+ r.background := 0;
+ r.sizes := ROW 3 ROW 2 REAL : (ROW 2 REAL : (0.0, 1.0),
+ ROW 2 REAL : (0.0, 1.0),
+ ROW 2 REAL : (0.0, 1.0));
+ r.limits := ROW 2 ROW 2 REAL : (ROW 2 REAL : (0.0, 0.0),
+ ROW 2 REAL : (0.0, 0.0));
+ r.angles := ROW 4 REAL : (0.0, 0.0, 0.0, 0.0);
+ r.obliques := ROW 2 REAL : (0.0, 0.0);
+ r.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0);
+ FOR i FROM 1 UPTO 16
+ REP r.pens [i] := ROW 3 INT : (1, 0, 1) PER .
+
+r : CONCR (CONCR (p)).
+END OP :=;
+
+DATASPACE PROC picture file (TEXT CONST name) :
+ IF exists (name)
+ THEN old (name)
+ ELSE new (name) FI
+END PROC picture file;
+
+PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type):
+ IF pen < 1 OR pen > 16
+ THEN errorstop (pen range) FI;
+ p.pens [pen] := ROW 3 INT : (colour, thickness, line type)
+END PROC select pen;
+
+PROC selected pen (PICFILE CONST p, INT CONST pen,
+ INT VAR colour, thickness, line type):
+ IF pen < 1 OR pen > 16
+ THEN errorstop (pen range) FI;
+ colour := p.pens [pen][1];
+ thickness := p.pens [pen][2];
+ line type := p.pens [pen][3];
+END PROC selected pen;
+
+INT PROC background (PICFILE CONST p):
+ p.background
+END PROC background;
+
+PROC background (PICFILE VAR p, INT CONST colour):
+ p.background := colour
+END PROC background;
+
+PROC get values (PICFILE CONST p,
+ 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) :
+ size := p.sizes;
+ limits := p.limits;
+ angles := p.angles;
+ oblique := p.obliques;
+ perspective := p.perspectives;
+
+END PROC get values;
+
+PROC set values (PICFILE VAR p,
+ ROW 3 ROW 2 REAL CONST size,
+ ROW 2 ROW 2 REAL CONST limits,
+ ROW 4 REAL CONST angles,
+ ROW 2 REAL CONST oblique,
+ ROW 3 REAL CONST perspective) :
+ p.sizes := size;
+ p.limits := limits;
+ p.angles := angles;
+ p.obliques := oblique;
+ p.perspectives := perspective;
+
+END PROC set values;
+
+PROC view (PICFILE VAR p, REAL CONST alpha):
+ p.angles [1] := alpha
+END PROC view;
+
+PROC view (PICFILE VAR p, REAL CONST phi, theta):
+ p.angles [2] := sind (theta) * cosd (phi);
+ p.angles [3] := sind (theta) * sind (phi);
+ p.angles [4] := cosd (theta);
+END PROC view;
+
+PROC view (PICFILE VAR p, REAL CONST x, y, z):
+ p.angles [2] := x;
+ p.angles [3] := y;
+ p.angles [4] := z
+END PROC view;
+
+PROC viewport (PICFILE VAR p,REAL CONST hor min,hor max,vert min,vert max) :
+ p.limits := ROW 2 ROW 2 REAL : (ROW 2 REAL : (hor min, hor max),
+ ROW 2 REAL : (vert min, vert max))
+END PROC viewport;
+
+PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) :
+ window (p, x min, x max, y min, y max, 0.0, 1.0)
+END PROC window;
+
+PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max, z min, z max) :
+ p.sizes := ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max),
+ ROW 2 REAL : (y min, y max),
+ ROW 2 REAL : (z min, z max))
+END PROC window;
+
+PROC oblique (PICFILE VAR p, REAL CONST a, b) :
+ p.obliques := ROW 2 REAL : (a, b);
+ p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0)
+END PROC oblique;
+
+PROC orthographic (PICFILE VAR p) :
+ p.obliques := ROW 2 REAL : (0.0, 0.0);
+ p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0)
+END PROC orthographic;
+
+PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) :
+ p.obliques := ROW 2 REAL : (0.0, 0.0);
+ p.perspectives := ROW 3 REAL : (cx, cy, cz)
+END PROC perspective;
+
+PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) :
+ REAL VAR dummy;
+ extrema (p, x min, x max, y min, y max, dummy, dummy)
+END PROC extrema;
+
+PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max) :
+ REAL VAR new x min, new x max, new y min, new y max, new z min, new z max;
+ x min := max real; x max := - max real;
+ y min := max real; y max := - max real;
+ z min := max real; z max := - max real;
+ FOR i FROM 1 UPTO p.size
+ REP IF dim (p.pic [i]) = 2
+ THEN extrema (p.pic [i], new x min, new x max, new y min, new y max)
+ ELSE extrema (p.pic [i], new x min, new x max, new y min, new y max,
+ new z min, new z max)
+ FI;
+ x min := min (x min, new x min); x max := max (x max, new x max);
+ y min := min (y min, new y min); y max := max (y max, new y max);
+ z min := min (z min, new z min); z max := max (z max, new z max);
+ PER
+END PROC extrema;
+
+PROC to pic (PICFILE VAR p, INT CONST n):
+ IF n < 1
+ THEN errorstop (pos under)
+ ELIF n <= p.size+1 AND n <= max pics
+ THEN p.pos := n
+ ELSE errorstop (pos over) FI
+END PROC to pic;
+
+PROC up (PICFILE VAR p):
+ to pic (p, p.pos-1)
+END PROC up;
+
+PROC up (PICFILE VAR p, INT CONST n):
+ to pic (p, p.pos-n)
+END PROC up;
+
+PROC down (PICFILE VAR p):
+ to pic (p, p.pos+1)
+END PROC down;
+
+PROC down (PICFILE VAR p, INT CONST n):
+ to pic (p, p.pos+n)
+END PROC down;
+
+BOOL PROC eof (PICFILE CONST p):
+ p.pos >= p.size
+END PROC eof;
+
+INT PROC picture no (PICFILE CONST p):
+ p.pos
+END PROC picture no;
+
+INT PROC pictures (PICFILE CONST p):
+ p.size
+END PROC pictures;
+
+PROC delete picture (PICFILE VAR p) :
+ INT VAR i;
+ FOR i FROM p.pos+1 UPTO p.size
+ REP p.pic [i-1] := p.pic [i] PER;
+
+ p.pic [p.size] := nilpicture;
+ IF p.size > 1
+ THEN p.size DECR 1 FI
+END PROC delete picture;
+
+PROC insert picture (PICFILE VAR p) :
+ INT VAR i;
+ IF p.size >= max pics
+ THEN errorstop (pic over)
+ ELSE p.size INCR 1;
+ FOR i FROM p.size DOWNTO p.pos+1
+ REP p.pic [i] := p.pic [i-1] PER;
+
+ p.pic [p.pos] := nilpicture;
+ FI
+END PROC insert picture;
+
+PROC read picture (PICFILE VAR p, PICTURE VAR pic) :
+ pic := p.pic (p.pos) .
+END PROC read picture;
+
+PROC write picture (PICFILE VAR p, PICTURE CONST pic) :
+ p.pic (p.pos) := pic .
+END PROC write picture;
+
+PROC get picture (PICFILE VAR p, PICTURE VAR pic) :
+ IF p.pos > p.size
+ THEN errorstop (pos over)
+ ELSE pic := p.pic [p.pos];
+ p.pos INCR 1;
+ FI
+END PROC get picture;
+
+PROC put picture (PICFILE VAR p, PICTURE CONST pic) :
+ IF p.pos > max pics
+ THEN errorstop (pic over)
+ ELSE p.pic [p.pos] := pic;
+
+ IF p.pos > p.size
+ THEN p.size INCR 1 FI;
+ p.pos INCR 1
+ FI
+END PROC put picture;
+
+END PACKET picfile
+
diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Plot b/system/std.graphik/1.8.7/src/GRAPHIK.Plot
new file mode 100644
index 0000000..5087abb
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Plot
@@ -0,0 +1,285 @@
+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
+
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
+
+
diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Server b/system/std.graphik/1.8.7/src/GRAPHIK.Server
new file mode 100644
index 0000000..dfe5f62
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Server
@@ -0,0 +1,97 @@
+PACKET multi user plotter: (* Autor : Rudolf Ruland *)
+ (* Stand : 24.03.86 *)
+ (*Änderung: 09.09.86/15:32 *)
+
+INT VAR c;
+put ("gib Plotterkanal : "); get (c);
+
+ server channel (c);
+ station only (FALSE) ;
+ spool duty ("Ausgabe mit dem Plotter");
+ spool control task (myself);
+
+LET ack = 0 ,
+
+ fetch code = 11 ,
+ param fetch code = 21 ,
+ picfile type = 1103 ;
+
+INT VAR reply, old heap size, sender station;
+TEXT VAR picfile name, userid, password, sendername;
+PICFILE VAR picfile ;
+
+DATASPACE VAR ds, picfile ds;
+
+BOUND STRUCT (TEXT picfile name, userid, password, sendername, INT station) VAR msg;
+BOUND TEXT VAR error msg ;
+
+spool manager (PROC plotter);
+
+PROC plotter :
+
+ disable stop ;
+ command dialogue (FALSE);
+ ds := nilspace; picfile ds := nilspace;
+ continue (server channel) ;
+ check error ("Kanal belegt");
+
+ old heap size := heap size ;
+ REP
+ execute plot ;
+
+ IF is error
+ THEN put error;
+ clear error;
+ FI ;
+
+ IF heap size > old heap size + 4
+ THEN collect heap garbage ;
+ old heap size := heap size
+ FI
+ PER
+
+ENDPROC plotter ;
+
+
+PROC execute plot :
+
+ enable stop ;
+ forget (picfile ds) ; picfile ds := nilspace ;
+ call (father, fetch code, picfile ds, reply) ;
+ IF reply = ack CAND type (picfile ds) = picfile type
+ THEN get picfile params;
+ plot picfile
+ FI ;
+
+. get picfile params :
+ forget (ds); ds := nilspace;
+ call (father, param fetch code, ds, reply);
+ IF reply <> ack
+ THEN error msg := ds; errorstop (error msg);
+ ELSE msg := ds;
+ picfile name := msg. picfile name;
+ userid := msg. userid;
+ password := msg. password;
+ sendername := msg. sender name;
+ sender station := msg. station;
+ FI;
+
+. plot picfile :
+ picfile := picfile ds;
+ plotter (picfile) .
+
+ENDPROC execute plot ;
+
+
+PROC check error (TEXT CONST message) :
+ IF is error
+ THEN clear error;
+ rename myself (message);
+ IF is error THEN clear error; end (myself) FI;
+ pause (18000);
+ end (myself);
+ FI;
+END PROC check error;
+
+ENDPACKET multi user plotter ;
+
diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Transform b/system/std.graphik/1.8.7/src/GRAPHIK.Transform
new file mode 100644
index 0000000..54690cc
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Transform
@@ -0,0 +1,366 @@
+PACKET transformation DEFINES transform, (* Autor: Heiko Indenbirken*)
+ diagonal, (* Stand: 12.04.85 *)
+ height, width, (*Änderung: 05.08.86/13:14 *)
+ set values, (*Änderung: 17.09.86/19:57 *)
+ get values,
+ new values,
+ projektion,
+ window,
+ viewport,
+ view,
+ oblique,
+ orthographic,
+ perspective:
+(* ******************* Hardwareunabhängiger Teil ********************* *)
+(* transform: Die Prozedur projeziert einen 3-dimensionalen Vektor *)
+(* ---------- (x, y, z) auf einen 2-dimensionalen (h, v) *)
+(* diagonal Die Prozedur berechnet die Pixel als Prozent der *)
+(* ---------- Diagonalen der Zeichenfläche *)
+(* height Die Prozedur berechnet die Pixel als Prozent der *)
+(* ---------- Höhe der Zeichenfläche *)
+(* width Die Prozedur berechnet die Pixel als Prozent der *)
+(* ---------- Breite der Zeichenfläche *)
+(* *)
+(* set values: Mit dieser Prozedur werden die Projektionsparameter *)
+(* ----------- gesetzt. *)
+(* size: Weltkoordinatenbereich *)
+(* ((xmin,xmax),(ymin,ymax),(zmin,zmax)) *)
+(* limits: Zeichenfläche *)
+(* ((h min, h max), (v min, v max)) *)
+(* Bei Werten < 2.0 werden die Werte als *)
+(* Prozente interpretiert, ansonsten als *)
+(* cm-Grössen. *)
+(* get values: Übergibt die aktuellen Werte *)
+(* ----------- *)
+(* new values: Berechnet die neue Projektionsmatrix *)
+(* ----------- *)
+(*=======================================================================*)
+
+BOOL VAR perspective projektion :: FALSE;
+INT VAR hor pixel, vert pixel, i;
+REAL VAR hor cm, vert cm,
+ h min limit, h max limit, v min limit, v max limit;
+ROW 5 ROW 5 REAL VAR p;
+ROW 3 ROW 2 REAL VAR size;
+ROW 2 ROW 2 REAL VAR limits;
+ROW 4 REAL VAR angles;
+ROW 2 REAL VAR obliques;
+ROW 3 REAL VAR perspectives;
+
+(* Initialisieren der Projektionsmatrizen *)
+INT VAR d;
+window (0.0, 1.0, 0.0, 1.0, 0.0, 1.0);
+viewport (0.0, 0.0, 0.0, 0.0);
+view (0.0, 0.0, 1.0);
+view (0.0);
+orthographic;
+new values (27.46, 19.21, 274, 192, d, d, d, d);
+
+PROC projektion (ROW 5 ROW 5 REAL VAR matrix):
+ matrix := p
+END PROC projektion;
+
+PROC oblique (REAL CONST a, b) :
+ set values (size, limits, angles, ROW 2 REAL : (a, b), ROW 3 REAL : (0.0, 0.0, 0.0))
+END PROC oblique;
+
+PROC orthographic :
+ set values (size, limits, angles, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (0.0, 0.0, 0.0))
+END PROC orthographic;
+
+PROC perspective (REAL CONST cx, cy, cz) :
+ set values (size, limits, angles, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (cx, cy, cz))
+END PROC perspective;
+
+PROC window (REAL CONST x min, x max, y min, y max) :
+ window (x min, x max, y min, y max, 0.0, 1.0)
+END PROC window;
+
+PROC window (REAL CONST x min, x max, y min, y max, z min, z max) :
+ set values (ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max),
+ ROW 2 REAL : (y min, y max),
+ ROW 2 REAL : (z min, z max)),
+ limits, angles, obliques, perspectives)
+END PROC window;
+
+PROC viewport (REAL CONST h min, h max, v min, v max) :
+ set values (size, ROW 2 ROW 2 REAL : (ROW 2 REAL : (h min, h max),
+ ROW 2 REAL : (v min, v max)),
+ angles, obliques, perspectives)
+END PROC view port;
+
+PROC view (REAL CONST alpha) :
+ set values (size, limits, ROW 4 REAL : (alpha, angles(2), angles (3), angles (4)),
+ obliques, perspectives)
+END PROC view;
+
+PROC view (REAL CONST phi, theta):
+ set values (size, limits, ROW 4 REAL : (angles (1), sind (theta) * cosd (phi),
+ sind (theta) * sind (phi), cosd (theta)),
+ obliques, perspectives)
+END PROC view;
+
+PROC view (REAL CONST x, y, z) :
+ set values (size, limits, ROW 4 REAL : (angles (1), x, y, z), obliques, perspectives)
+END PROC view;
+
+PROC get values (ROW 3 ROW 2 REAL VAR act size,
+ ROW 2 ROW 2 REAL VAR act limits,
+ ROW 4 REAL VAR act angles,
+ ROW 2 REAL VAR act obliques,
+ ROW 3 REAL VAR act perspectives) :
+ act size := size;
+ act limits := limits;
+ act angles := angles;
+ act obliques := obliques;
+ act perspectives := perspectives;
+
+END PROC get values;
+
+PROC set values (ROW 3 ROW 2 REAL CONST new size,
+ ROW 2 ROW 2 REAL CONST new limits,
+ ROW 4 REAL CONST new angles,
+ ROW 2 REAL CONST new obliques,
+ ROW 3 REAL CONST new perspectives) :
+ size := new size;
+ limits := new limits;
+ angles := new angles;
+ obliques := new obliques;
+ perspectives := new perspectives
+
+END PROC set values;
+
+PROC new values (INT VAR h min range, h max range, v min range, v max range):
+ new values (hor cm, vert cm, hor pixel, vert pixel,
+ h min range, h max range, v min range, v max range)
+END PROC new values;
+
+PROC new values (REAL CONST size hor, size vert,
+ INT CONST pixel hor, pixel vert,
+ INT VAR h min range, h max range,
+ v min range, v max range):
+ remember screensize;
+ calc views;
+ calc projektion;
+ calc limits;
+ calc projection frame;
+ normalize projektion;
+ set picture range;
+ set perspective mark .
+
+remember screensize:
+ hor cm := size hor;
+ vert cm := size vert;
+ hor pixel := pixel hor;
+ vert pixel := pixel vert .
+
+calc views :
+ calc diagonale;
+ calc projektion;
+ calc angles;
+ calc normale;
+ calc matrix;
+ calc alpha angle .
+
+calc diagonale:
+ REAL VAR diagonale := sqrt (angles [2] * angles [2] +
+ angles [3] * angles [3] +
+ angles [4] * angles [4]) .
+
+calc projektion:
+ REAL VAR projektion := sqrt (angles [2] * angles [2] +
+ angles [4] * angles [4]) .
+
+calc angles:
+ REAL VAR sin p, cos p, sin t, cos t, sin a, cos a;
+
+ IF diagonale = 0.0
+ THEN sin p := 0.0; cos p := 1.0;
+ sin t := 0.0; cos t := 1.0
+ ELIF projektion = 0.0
+ THEN sin p := angles [3] / diagonale;
+ cos p := projektion / diagonale;
+ sin t := 0.0; cos t := 1.0
+ ELSE sin p := angles [3] / diagonale;
+ cos p := projektion / diagonale;
+ sin t := angles [2] / projektion;
+ cos t := angles [4] / projektion
+ FI .
+
+calc normale:
+ REAL VAR sin p sin t := sin p * sin t,
+ sin p cos t := sin p * cos t,
+ cos p sin t := cos p * sin t,
+ cos p cos t := cos p * cos t,
+
+ dx := size [1][2] - size [1][1],
+ dy := size [2][2] - size [2][1],
+ dz := size [3][2] - size [3][1],
+ norm az := obliques [1] ,
+ norm bz := obliques [2] ,
+ norm cx := perspectives [1] / dx,
+ norm cy := perspectives [2] / dy,
+ norm cz := perspectives [3] / dz .
+
+calc matrix:
+p := ROW 5 ROW 5 REAL :
+ (ROW 5 REAL : ( cos t / dx - cos p sin t / dx * norm az ,
+ - sin p sin t / dx - cos p sin t / dx * norm bz,
+ 0.0,
+ - cos p sin t / dx * norm cz,
+ 0.0 ),
+ ROW 5 REAL : ( - sin p / dy * norm az,
+ cos p / dy - sin p / dy * norm bz,
+ 0.0,
+ - sin p / dy * norm cz,
+ 0.0 ),
+ ROW 5 REAL : ( sin t / dz + cos p cos t / dz * norm az,
+ + sin p cos t / dz + cos p cos t / dz * norm bz,
+ 0.0,
+ cos p cos t / dz * norm cz,
+ 0.0 ),
+ ROW 5 REAL : (- norm cx, - norm cy, 0.0, 1.0, 0.0 ),
+ ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0)) .
+
+calc alpha angle:
+ IF angles (1) = 0.0
+ THEN set alpha as y vertical
+ ELSE sin a := sind (angles (1));
+ cos a := cosd (angles (1))
+ FI .
+
+set alpha as y vertical :
+ REAL VAR r := sqrt (p(2)(1)**2 + p(2)(2)**2);
+ IF r = 0.0
+ THEN sin a := 0.0;
+ cos a := 1.0
+ ELSE sin a :=-p(2)(1)/r;
+ cos a := p(2)(2)/r
+ FI .
+
+calc limits :
+ IF limits as percent
+ THEN calc percent limits
+ ELSE calc centimeter limits FI .
+
+limits as percent:
+ limits [1][2] < 2.0 AND limits [2][2] < 2.0 .
+
+max limits:
+ h min limit := 0.0;
+
+ v min limit := 0.0;
+ v max limit := real (pixel vert) .
+
+calc percent limits:
+ h min limit := real (pixel hor) * limits (1)(1)*size vert / size hor;
+ v min limit := limits (2)(1) * real (pixel vert);
+
+ IF limits [1][2] = 0.0
+ THEN h max limit := real (pixel hor)
+ ELSE h max limit := real (pixel hor) * limits [1][2]*size vert / size hor FI;
+
+ IF limits [2][2] = 0.0
+ THEN v max limit := real (pixel vert)
+ ELSE v max limit := limits (2)(2) * real (pixel vert) FI .
+
+calc centimeter limits:
+ h min limit := real (pixel hor) * (limits (1)(1)/size hor);
+ v min limit := real (pixel vert) * (limits (2)(1)/size vert);
+
+ IF limits [1][2] = 0.0
+ THEN h max limit := real (pixel hor)
+ ELSE h max limit := real (pixel hor) * (limits (1)(2)/size hor) FI;
+
+ IF limits [2][2] = 0.0
+ THEN v max limit := real (pixel vert)
+ ELSE v max limit := real (pixel vert) * (limits (2)(2)/size vert) FI .
+
+calc projection frame:
+ REAL VAR h min := max real, h max :=-max real,
+ v min := max real, v max :=-max real;
+
+ extrema (size [1][1], size [2][1], size [3][1], h min, h max, v min, v max);
+ extrema (size [1][2], size [2][1], size [3][1], h min, h max, v min, v max);
+ extrema (size [1][2], size [2][2], size [3][1], h min, h max, v min, v max);
+ extrema (size [1][1], size [2][2], size [3][1], h min, h max, v min, v max);
+ extrema (size [1][1], size [2][1], size [3][2], h min, h max, v min, v max);
+ extrema (size [1][2], size [2][1], size [3][2], h min, h max, v min, v max);
+ extrema (size [1][2], size [2][2], size [3][2], h min, h max, v min, v max);
+ extrema (size [1][1], size [2][2], size [3][2], h min, h max, v min, v max) .
+
+normalize projektion :
+ REAL VAR sh := (h max limit - h min limit) / (h max - h min),
+ sv := (v max limit - v min limit) / (v max - v min),
+ dh := h min limit - h min*sh,
+ dv := v min limit - v min*sv;
+
+ FOR i FROM 1 UPTO 5
+ REP REAL CONST p i 1 := p (i)(1);
+ p (i)(1) := (p i 1 * cos a - p (i)(2) * sin a) * sh;
+ p (i)(2) := (p i 1 * sin a + p (i)(2) * cos a) * sv
+ PER;
+ p (5)(1) := dh;
+ p (5)(2) := dv .
+
+set picture range:
+ h min range := int (h min limit-0.5);
+ h max range := int (h max limit+0.5);
+ v min range := int (v min limit-0.5);
+ v max range := int (v max limit+0.5) .
+
+set perspective mark:
+ perspective projektion := perspectives [3] <> 0.0 .
+
+END PROC new values;
+
+PROC transform (REAL CONST x, y, z, INT VAR h, v) :
+ IF perspective projektion
+ THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);
+ h := int ((x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (4)(1))*w + p (5)(1));
+ v := int ((x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (4)(2))*w + p (5)(2))
+ ELSE h := int (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (5)(1));
+ v := int (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (5)(2));
+ FI;
+END PROC transform;
+
+PROC extrema (REAL CONST x, y, z, REAL VAR h min, h max, v min, v max):
+ REAL VAR h, v;
+ IF perspective projektion
+ THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);
+ h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) +p (4)(1))*w;
+ v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) +p (4)(2))*w
+ ELSE h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1));
+ v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2))
+ FI;
+
+ IF h < h min
+ THEN h min := h
+ ELIF h > h max
+ THEN h max := h FI;
+
+ IF v < v min
+ THEN v min := v
+ ELIF v > v max
+ THEN v max := v FI
+
+END PROC extrema;
+
+INT PROC diagonal (REAL CONST percent):
+ int (percent * 0.01 * diagonale + 0.5) .
+
+diagonale:
+ sqrt ((h max limit-h min limit) ** 2 + (v max limit-v min limit) ** 2) .
+
+END PROC diagonal;
+
+INT PROC height (REAL CONST percent):
+ int (percent * 0.01 * (v max limit-v min limit) + 0.5)
+END PROC height;
+
+INT PROC width (REAL CONST percent):
+ int (percent * 0.01 * (h max limit-h min limit) + 0.5)
+END PROC width;
+
+END PACKET transformation
+
diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.vektor plot b/system/std.graphik/1.8.7/src/GRAPHIK.vektor plot
new file mode 100644
index 0000000..8bef1e4
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.vektor plot
@@ -0,0 +1,506 @@
+PACKET clipping DEFINES set range, (*Autor: Heiko Indenbirken *)
+ get range, (*Stand: 27.06.85/12:39 *)
+ clip: (*Änderung: 11.08.86/15:02 *)
+
+INT VAR x min :: 0, x max :: 1024, y min :: 0, y max :: 1024;
+
+PROC set range (INT CONST h min, v min, h max, v max):
+ IF h min >= h max OR v min >= v max
+ THEN errorstop ("Incorrect Range") FI;
+ x min := h min; x max := h max;
+ y min := v min; y max := v max
+END PROC set range;
+
+PROC get range (INT VAR h min, v min, h max, v max):
+ h min := x min; h max := x max;
+ v min := y min; v max := y max
+END PROC get range;
+
+PROC clip (INT CONST from x, from y, to x, to y,
+ PROC (INT CONST, INT CONST) move,
+ PROC (INT CONST, INT CONST) draw):
+ INT VAR x, y;
+ calculate parts of line;
+ IF both points inside
+ THEN draw (to x, to y)
+ ELIF both points outside
+ THEN
+ ELIF first point outside
+ THEN intersection (to x, to y, from x, from y, from part, x, y);
+ move (x, y);
+ draw (x, y); (* Macke im SHARD *)
+ draw (to x, to y)
+ ELIF second point outside
+ THEN intersection (from x, from y, to x, to y, to part, x, y);
+ draw (x, y)
+ ELSE intersection (to x, to y, from x, from y, from part, x, y);
+ move (x, y);
+ draw (x, y); (* Macke im SHARD *)
+ clip (x, y, to x, to y, PROC (INT CONST, INT CONST) move,
+ PROC (INT CONST, INT CONST) draw)
+ FI .
+
+calculate parts of line:
+ INT CONST from part :: part (from x, from y),
+ to part :: part (to x, to y) .
+
+both points inside:
+ from part = 0 AND to part = 0 .
+
+both points outside:
+ (from part AND to part) <> 0 .
+
+first point outside:
+ from part <> 0 AND to part = 0 .
+
+second point outside:
+ to part <> 0 AND from part = 0 .
+
+END PROC clip;
+
+INT PROC part (INT CONST x, y):
+ INT VAR index :: 0;
+ IF x > x max
+ THEN set bit (index, 0)
+ ELIF x < x min
+ THEN set bit (index, 1) FI;
+
+ IF y > y max
+ THEN set bit (index, 2)
+ ELIF y < y min
+ THEN set bit (index, 3) FI;
+
+ index
+
+END PROC part;
+
+PROC intersection (INT CONST from x, from y, to x, to y, to part, INT VAR x, y):
+ SELECT to part OF
+ CASE 1: right side
+ CASE 2: left side
+ CASE 4: up side
+ CASE 5: upright side
+ CASE 6: upleft side
+ CASE 8: down side
+ CASE 9: downright side
+ CASE 10: downleft side
+ OTHERWISE errorstop ("wrong partno.:" + text (to part)) ENDSELECT .
+
+right side:
+ y := from y + int (real (x max-from x)*(dy/dx));
+ x := x max .
+
+left side:
+ y := from y + int (real (x min-from x)*(dy/dx));
+ x := x min .
+
+up side:
+ x := from x + int (real (y max-from y)*(dx/dy));
+ y := y max .
+
+down side:
+ x := from x + int (real (y min-from y)*(dx/dy));
+ y := y min .
+
+upright side:
+ right side;
+ IF y > y max
+ THEN up side FI .
+
+downright side:
+ right side;
+ IF y < y min
+ THEN down side FI .
+
+upleft side:
+ left side;
+ IF y > y max
+ THEN up side FI .
+
+downleft side:
+ left side;
+ IF y < y min
+ THEN down side FI .
+
+dx: real (to x-from x) .
+dy: real (to y-from y) .
+
+END PROC intersection;
+
+END PACKET clipping;
+
+PACKET thick line DEFINES thick: (*Autor: Heiko Indenbirken *)
+ (*Stand: 02.07.85/15:07 *)
+ (*Änderung: 05.08.86/15:52 *)
+PROC thick (INT CONST x0, y0, x1, y1, thick,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ IF is point
+ THEN draw point
+ ELIF is horizontal line
+ THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ x0, y0, x1, y1, thick)
+ ELSE vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ x0, y0, x1, y1, thick)
+ FI .
+
+is point:
+ x0 = x1 AND y0 = y1 .
+
+is horizontal line:
+ abs (x0-x1) >= abs (y0-y1) .
+
+draw point:
+ INT VAR i;
+ FOR i FROM -thick UPTO thick
+ REP line (x0-thick, y0+i, x0+thick, y0+i) PER .
+
+END PROC thick;
+
+PROC horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ INT CONST from x, from y, to x, to y, thick):
+ IF from x > to x
+ THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ to x, to y, from x, from y, thick)
+ ELSE draw line FI .
+
+draw line:
+ INT VAR i;
+ calculate increase;
+ calculate limit points;
+ FOR i FROM -thick UPTO thick
+ REP calculate delta x;
+ line (x start+delta x, y start+i, x end+delta x, y end+i)
+ PER .
+
+calculate increase:
+ REAL VAR increase :: -dy / dx .
+
+calculate limit points:
+ INT CONST x start :: from x - thick,
+ x end :: to x + thick,
+ y start :: from y + int (increase * real (thick)),
+ y end :: to y - int (increase * real (thick)) .
+
+calculate delta x:
+ INT CONST delta x :: int (increase*real (i)) .
+
+dx: real (to x-from x) .
+dy: real (to y-from y) .
+
+END PROC horizontal line;
+
+PROC vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ INT CONST from x, from y, to x, to y, thick):
+ IF from y > to y
+ THEN vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ to x, to y, from x, from y, thick)
+ ELSE draw line FI .
+
+draw line:
+ INT VAR i;
+ calculate increase;
+ calculate limit points;
+ FOR i FROM -thick UPTO thick
+ REP calculate delta y;
+ line (x start+i, y start+delta y, x end+i, y end+delta y)
+ PER .
+
+calculate increase:
+ REAL VAR increase :: -dx / dy .
+
+calculate limit points:
+ INT CONST x start :: from x + int (increase * real (thick)),
+ x end :: to x - int (increase * real (thick)),
+ y start :: from y - thick,
+ y end :: to y + thick .
+
+calculate delta y:
+ INT CONST delta y :: int (increase*real (i)) .
+
+dx: real (to x-from x) .
+dy: real (to y-from y) .
+
+END PROC vertical line;
+
+END PACKET thick line;
+
+PACKET graphik text DEFINES draw char, (*Autor: Heiko Indenbirken *)
+ zeichensatz: (*Stand: 27.06.85/16:03 *)
+ (*Änderung: 28.06.85/19:06 *)
+ (*Änderung: 05.08.86/16:00 *)
+LET ZEICHENSATZ = ROW 255 TEXT;
+ZEICHENSATZ VAR zeichen;
+INT CONST char x :: 6, char y :: 10;
+
+zeichensatz ("ZEICHENSATZ");
+
+PROC zeichensatz (TEXT CONST name):
+ IF exists (name)
+ THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);
+ zeichen := new zeichen;
+ ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI
+END PROC zeichensatz;
+
+PROC draw char (INT CONST char no, INT CONST x, y, x size, y size, direction,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ TEXT CONST character :: zeichen [char no];
+ INT VAR n :: 1, x0, y0, x1, y1;
+ INT CONST len :: length (character);
+ WHILE n < len
+ REP value (character, n, x0, y0, x1, y1);
+ transform (x0, y0, x, y, x size, y size, direction);
+ transform (x1, y1, x, y, x size, y size, direction);
+ line (x0, y0, x1, y1);
+ n INCR 4
+ PER .
+
+END PROC draw char;
+
+PROC value (TEXT CONST char, INT CONST n, INT VAR x0, y0, x1, y1):
+ x0 := val (code (char SUB n)); y0 := val (code (char SUB n+1));
+ x1 := val (code (char SUB n+2)); y1 := val (code (char SUB n+3));
+END PROC value;
+
+INT PROC val (INT CONST n):
+ IF n > 127
+ THEN -256 OR n
+ ELSE n FI
+END PROC val;
+
+PROC transform (INT VAR x, y, INT CONST x0, y0, x size, y size, direction):
+ INT CONST old x :: x, old y :: y;
+ SELECT direction OF
+ CASE 0: x := x0 + x vektor; y := y0 + y vektor
+ CASE 1: x := x0 - y vektor; y := y0 + x vektor
+ CASE 2: x := x0 - x vektor; y := y0 - y vektor
+ CASE 3: x := x0 + y vektor; y := y0 - x vektor
+ ENDSELECT .
+
+x vektor:
+ IF x size = 0
+ THEN old x
+ ELSE (old x*x size) DIV char x FI .
+
+y vektor:
+ IF y size = 0
+ THEN old y
+ ELSE (old y*y size) DIV char y FI .
+
+END PROC transform;
+
+END PACKET graphik text;
+
+PACKET graphik text DEFINES draw text: (*Autor: Heiko Indenbirken *)
+ (*Stand: 03.07.85/11:55 *)
+ (*Änderung: 05.08.86/16:04 *)
+PROC draw text (INT CONST x pos, y pos,
+ TEXT CONST msg, REAL CONST angle, INT CONST height, width,
+ PROC (INT CONST, INT CONST,
+ INT CONST, INT CONST, INT CONST, INT CONST) draw char):
+ INT CONST dir :: int (((angle MOD 360.0)+45.0) / 90.0);
+ INT VAR i;
+ REAL VAR x :: real (x pos), y :: real (y pos),
+ x step :: cosd (angle)*real (width),
+ y step :: sind (angle)*real (width);
+ FOR i FROM 1 UPTO length (msg)
+ REP IF control char
+ THEN execute control char
+ ELSE execute normal char FI
+ PER .
+
+control char:
+ akt char < ""32"" .
+
+execute control char:
+ SELECT code (akt char) OF
+ CASE 1: home
+ CASE 2: right
+ CASE 3: up
+ CASE 7: out (""7"")
+ CASE 8: left
+ CASE 10: down
+ CASE 13: return
+ ENDSELECT .
+
+home:
+ x := real (x pos);
+ y := real (y pos) .
+
+right:
+ x INCR x step; y INCR y step .
+
+up:
+ x INCR y step; y INCR x step .
+
+left:
+ x DECR x step; y DECR y step .
+
+down:
+ x DECR y step; y DECR x step .
+
+return:
+ x := real (x pos) .
+
+execute normal char:
+ draw char (code (akt char), dir, int (x+0.5), int (y+0.5), height, width);
+ x INCR x step;
+ y INCR y step .
+
+akt char:
+ msg SUB i .
+
+END PROC draw text;
+
+END PACKET graphik text;
+
+PACKET comercial plot DEFINES bar, (*Autor: Heiko Indenbirken *)
+ circle: (*Stand: 03.04.1985 *)
+ (*Änderung: 03.07.85/15:37 *)
+PROC bar (INT CONST from x, from y, to x, to y, pattern,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ IF from x > to x
+ THEN bar (to x, from y, from x, to y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ ELIF from y > to y
+ THEN bar (from x, to y, to x, from y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ ELSE draw frame;
+ fill frame with pattern
+ FI .
+
+draw frame:
+ line (from x, from y, from x, to y);
+ line (from x, to y, to x, to y);
+ line (to x, to y, to x, from y);
+ line (to x, from y, from x, from y) .
+
+fill frame with pattern:
+ SELECT pattern OF
+ CASE 1: fill right (from x, to x, from y, to y, 2, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 2: fill hor (from x, to x, from y, to y, 1, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 3: fill hor (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 4: fill vert (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 5: fill hor (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line);
+ fill vert (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 6: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 7: fill left (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 8: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line);
+ fill left (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ ENDSELECT .
+
+END PROC bar;
+
+PROC fill hor (INT CONST from x, to x, from y, to y, step,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ INT VAR y :: from y;
+ REP line (from x, y, to x, y);
+ y INCR step
+ UNTIL y > to y PER .
+
+END PROC fill hor;
+
+PROC fill vert (INT CONST from x, to x, from y, to y, step,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ INT VAR x :: from x;
+ REP line (x, from y, x, to y);
+ x INCR step
+ UNTIL x > to x PER .
+
+END PROC fill vert;
+
+PROC fill right (INT CONST from x, to x, from y, to y, step,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ INT CONST width :: to x - from x,
+ height :: to y - from y,
+ length :: width + height,
+ height step :: height + step,
+ width step :: width + step;
+
+ INT VAR t :: step, left :: from x, right :: from x,
+ lower :: from y, upper :: from y;
+(* Ausfüllen von links unten nach rechts oben *)
+ WHILE t < length
+ REP calc start point;
+ calc end point;
+ line (left, upper, right, lower);
+ t INCR step
+ PER .
+
+calc start point:
+ IF t < height
+ THEN upper INCR step
+ ELIF t < height step
+ THEN left := from x + t - height;
+ upper := to y
+ ELSE left INCR step FI .
+
+calc end point:
+ IF t < width
+ THEN right INCR step
+ ELIF t < width step
+ THEN lower := from y + t - width;
+ right := to x
+ ELSE lower INCR step FI .
+
+END PROC fill right;
+
+PROC fill left (INT CONST from x, to x, from y, to y, step,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ INT CONST width :: to x - from x,
+ height :: to y - from y,
+ length :: width + height,
+ height step :: height + step,
+ width step :: width + step;
+
+ INT VAR t :: step, left :: to x, right :: to x,
+ lower :: from y, upper :: from y;
+(* Ausfüllen von rechts unten nach links oben *)
+ WHILE t < length
+ REP calc start point;
+ calc end point;
+ line (right, upper, left, lower);
+ t INCR step
+ PER .
+
+calc start point:
+ IF t < height
+ THEN upper INCR step
+ ELIF t < height step
+ THEN right := to x - t + height;
+ upper := to y
+ ELSE right DECR step FI .
+
+calc end point:
+ IF t < width
+ THEN left DECR step
+ ELIF t < width step
+ THEN lower := from y + t - width;
+ left := from x
+ ELSE lower INCR step FI .
+
+END PROC fill left;
+
+PROC circle (INT CONST x, y, REAL CONST rad, from, to, INT CONST pattern,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ REAL VAR t :: from;
+ INT VAR last x :: x, last y :: y;
+ WHILE t <= to
+ REP calc circle;
+ draw step;
+ t INCR 1.0
+ PER;
+ line (x rad, y rad, x, y) .
+
+draw step:
+ IF pattern = 0
+ THEN line (last x, last y, x rad, y rad);
+ last x := x rad;
+ last y := y rad
+ ELSE line (x, y, x rad, y rad) FI .
+
+calc circle:
+ INT CONST x rad :: int (cosd (t)*rad+0.5)+x,
+ y rad :: int (sind (t)*rad+0.5)+y .
+
+END PROC circle;
+
+END PACKET comercial plot;
+
diff --git a/system/std.graphik/1.8.7/src/HP7475.plot b/system/std.graphik/1.8.7/src/HP7475.plot
new file mode 100644
index 0000000..860dd03
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/HP7475.plot
@@ -0,0 +1,254 @@
+PACKET hp7475 plot DEFINES set range, (*Autor: Heiko Indenbirken *)
+ get range, (*Stand: 03.09.86/15:09 *)
+ drawing area,
+ begin plot,
+ end plot,
+ clear,
+
+ set pen, get pen,
+ move,
+ draw,
+ marker,
+ bar, circle,
+ where:
+
+(* *)
+(* Hardware Anschluß des HP7475A: *)
+(* 9600 Baud, 8 Bit, no parity, RTS/CTS *)
+(* Leitungen 1 ----- 1 *)
+(* gekreuzt: 2 --x-- 3 *)
+(* 3 --x-- 2 *)
+(* *)
+
+
+LET POS = STRUCT (INT x, y);
+LET RANGE = STRUCT (POS min, max);
+LET PEN = STRUCT (INT back, fore, thick, line);
+
+LET width scale = 0.002690217391304,
+ height scale = 0.002728921124206;
+
+LET term = ";",
+ comma = ",",
+ point = ".",
+ zero = "0",
+ nil = "",
+ etx = ""3"";
+
+
+POS VAR old :: POS:(0, 0);
+RANGE VAR area :: RANGE:(POS:(0,0), POS:(11040, 7721));
+PEN VAR pen :: PEN : (0, 1, 0, 1);
+TEXT VAR result;
+
+ROW 16 TEXT VAR mark := ROW 16 TEXT:
+("99,0,2,-2,0,0,-4,4,0,0,4,-2,0;",
+"99,0,2,-1,0,-1,-1,0,-2,1,-1,2,0,1,1,0,2,-1,1,-1,0;",
+"99,0,2,-2,-3,4,0,-2,3;",
+"-99,-2,0,99,4,0,-99,-2,2,99,0,-4;",
+"-99,-2,-2,99,4,4,-99,-4,0,99,4,-4;",
+"99,0,2,-2,-2,2,-2,2,2,-2,2;",
+"-99,0,-2,99,0,4,-2,-2,4,0,-2,2;",
+"-99,-2,0,99,4,0,-99,-2,2,99,0,-4,2,2,-2,2,-2,-2,2,-2;",
+"-99,-2,-2,99,4,4,-4,0,4,-4;",
+"-99,-2,2,99,4,0,-4,-4,4,0;",
+"99,0,-2,-99,-2,4,99,2,-2,2,2;",
+"99,1,1,-2,0,0,-2,2,0,0,2,1,1,-99,-4,0,99,1,-1,-99,0,-2,99,-1,-1,-99,4,0,99,-1,1;",
+"-99,-2,0,99,4,0,-99,-1,1,99,-2,-2,-99,1,-1,99,0,4,-99,-1,-1,99,2,-2;",
+"-99,-2,2,99,4,0,-4,-4,4,0,-4,4;",
+"-99,-2,0,99,4,0;",
+"-99,0,299,0,-4;");
+
+ROW 5 TEXT CONST line pattern := ROW 5 TEXT:("LT;", "LT1;", "LT2;", "LT3;", "LT4;");
+ROW 8 TEXT CONST fill pattern := ROW 8 TEXT:("FT4,25,45;", "FT1,0,0;", "FT3,50,0;",
+ "FT3,50,90;", "FT4,50,0;", "FT3,50,-45;",
+ "FT3,50,45;", "FT4,50,45;");
+
+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) :
+ x cm := 29.7; y cm := 21.07;
+ x pixel := 11040; y pixel := 7721;
+END PROC drawing area;
+
+
+PROC set range (INT CONST h min, v min, h max, v max):
+ IF h min >= h max OR v min >= v max
+ THEN errorstop ("Incorrect Range") FI;
+ area := RANGE:(POS:(h min, v min), POS:(h max, v max))
+END PROC set range;
+
+PROC get range (INT VAR h min, v min, h max, v max):
+ h min := area.min.x; v min := area.min.y;
+ h max := area.max.x; v max := area.max.y
+END PROC get range;
+
+PROC begin plot:
+ out ("IN;")
+ENDPROC begin plot;
+
+PROC end plot:
+ TEXT VAR rec;
+ out ("IN;SP;PA22040,7721;DP;");
+ REP pause (10);
+ out ("OS;");
+ input (rec, ""13"", 600)
+ UNTIL enter pressed PER;
+ out ("IN;") .
+
+enter pressed:
+ (int (rec) AND 4) > 0 .
+
+ENDPROC end plot;
+
+PROC clear:
+ new values (29.7, 21.07, 11040, 7721, area.min.x, area.max.x, area.min.y, area.max.y);
+ pen := PEN : (0, 1, 0, 1);
+ old := area.min;
+ out ("DF;IP;"); (* Default *)
+ out ("IW" + text (area.min.x, area.min.y) + ", " + (* Clipping *)
+ text (area.max.x, area.max.y) + term);
+ out ("SP1;"); (* Pen 1 *)
+ out ("LT;"); (* durchgehend *)
+ out ("PU;PA" + text (old.x, old.y)); (* Startpunkt *)
+
+END PROC clear;
+
+PROC set pen (INT CONST back, fore, thick, type):
+ set colour;
+ set linetype .
+
+set colour:
+ IF abs (fore) >= 1 AND abs (fore) <= 6
+ THEN out ("SP" + text (abs (fore)) + term);
+ pen.fore := abs (fore);
+ FI .
+
+set linetype:
+ IF type >= 1 AND type <= 5
+ THEN out (line pattern [type]);
+ pen.line := type
+ ELSE out ("SP;");
+ pen.line := 0
+ FI .
+
+END PROC set pen;
+
+PROC get pen (INT VAR back, fore, thick, line):
+ back := pen.back;
+ fore := pen.fore;
+ thick := pen.thick;
+ line := pen.line
+END PROC get pen;
+
+PROC move (INT CONST x, y) :
+ out ("PU;PA" + text (x, y) + term);
+ old := POS : (x, y)
+END PROC move;
+
+PROC draw (INT CONST x, y):
+ out ("PD;PA" + text (x, y) + term);
+ old := POS : (x, y)
+END PROC draw;
+
+PROC draw (TEXT CONST msg, REAL CONST angle, INT CONST height, width):
+ set angle;
+ set height and width;
+ plot msg .
+
+set angle:
+ out ("DI " + text (cosd (angle), sind (angle)) + term) .
+
+set height and width:
+ IF width = 0 AND height = 0
+ THEN out ("SR;")
+ ELSE out ("SI" + text (real (width) * width scale,
+ real (height) * height scale) + term)
+ FI .
+
+plot msg:
+ out ("LB" + msg + etx) .
+
+END PROC draw;
+
+PROC bar (INT CONST from x, from y, to x, to y, pattern):
+ out ("PU;PA" + text (from x, from y) + term);
+ out ("LT;EA" + text (to x, to y) + term);
+ IF pattern > 0 AND pattern <= 8
+ THEN out (fill pattern [pattern]);
+ out ("RA" + text (to x, to y) + term);
+ FI;
+ out ("PU;PA" + text (old.x, old.y) + term);
+ out (line pattern [pen.line]) .
+
+END PROC bar;
+
+PROC circle (INT CONST x, y, rad, REAL CONST from, to, INT CONST pattern):
+ out ("LT;PU;PA" + text (x, y) + term);
+ IF (from MOD 360.0) = 0.0 AND (to MOD 360.0) = 0.0
+ THEN out ("CI" + text (rad) + term)
+ ELSE out ("EW" + text (rad) + comma + text (from, to-from) + term) FI;
+
+ IF pattern > 0 AND pattern <= 6
+ THEN out (fill pattern [pattern]);
+ out ("WG" + text (rad) + comma + text (from, to-from) + term)
+ FI;
+ out ("PU;PA" + text (old.x, old.y) + term);
+ out (line pattern [pen.line]) .
+
+END PROC circle;
+
+PROC marker (INT CONST x, y, no, size):
+ out ("LT;PU;PA" + text (x, y) + term);
+ out ("DI1,0;");
+ IF size = 0
+ THEN out ("SI0.25,0.5;")
+ ELSE out ("SI" + text (real (size)*0.001, real (size)*0.002) + term) FI;
+ out ("UC" + mark [mark no]);
+ out ("PU;PA" + text (old.x, old.y) + term);
+ out (line pattern [pen.line]) .
+
+mark no:
+ IF no >= 1 AND no <= 16
+ THEN no
+ ELSE 1 FI .
+
+END PROC marker;
+
+PROC where (INT VAR x, y):
+ x := old.x; y := old.y
+END PROC where;
+
+TEXT PROC text (INT CONST x, y):
+ text (x) + comma + text (y)
+END PROC text;
+
+TEXT PROC text (REAL CONST x, y):
+ text (x) + comma + text (y)
+END PROC text;
+
+TEXT PROC text (REAL CONST x):
+ result := compress (text (x, 9, 4));
+
+ IF (result SUB 1) = point
+ THEN insert char (result, zero, 1)
+ ELIF (result SUB LENGTH result) = point
+ THEN result CAT zero FI;
+ result
+END PROC text;
+
+PROC input (TEXT VAR rec, TEXT CONST del, INT CONST time):
+ enable stop;
+ rec := nil;
+ REP TEXT CONST char := incharety (time);
+
+ IF char = nil
+ THEN errorstop ("Timeout after " + text (time))
+ ELIF pos (del, char) > 0
+ THEN LEAVE input
+ ELSE rec CAT char FI
+
+ PER .
+
+END PROC input;
+
+END PACKET hp7475 plot
+
diff --git a/system/std.graphik/1.8.7/src/PC.plot b/system/std.graphik/1.8.7/src/PC.plot
new file mode 100644
index 0000000..712f5ea
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/PC.plot
@@ -0,0 +1,758 @@
+PACKET clipping DEFINES set range, (*Autor: Heiko Indenbirken *)
+ get range, (*Stand: 27.06.85/12:39 *)
+ clip: (*Änderung: 11.08.86/15:02 *)
+
+INT VAR x min :: 0, x max :: 1024, y min :: 0, y max :: 1024;
+
+PROC set range (INT CONST h min, v min, h max, v max):
+ IF h min >= h max OR v min >= v max
+ THEN errorstop ("Incorrect Range") FI;
+ x min := h min; x max := h max;
+ y min := v min; y max := v max
+END PROC set range;
+
+PROC get range (INT VAR h min, v min, h max, v max):
+ h min := x min; h max := x max;
+ v min := y min; v max := y max
+END PROC get range;
+
+PROC clip (INT CONST from x, from y, to x, to y,
+ PROC (INT CONST, INT CONST) move,
+ PROC (INT CONST, INT CONST) draw):
+ INT VAR x, y;
+ calculate parts of line;
+ IF both points inside
+ THEN draw (from x, from y); (* Macke im SHARD *)
+ draw (to x, to y)
+ ELIF both points outside
+ THEN
+ ELIF first point outside
+ THEN intersection (to x, to y, from x, from y, from part, x, y);
+ move (x, y);
+ draw (x, y); (* Macke im SHARD *)
+ draw (to x, to y)
+ ELIF second point outside
+ THEN intersection (from x, from y, to x, to y, to part, x, y);
+ draw (x, y)
+ ELSE intersection (to x, to y, from x, from y, from part, x, y);
+ move (x, y);
+ draw (x, y); (* Macke im SHARD *)
+ clip (x, y, to x, to y, PROC (INT CONST, INT CONST) move,
+ PROC (INT CONST, INT CONST) draw)
+ FI .
+
+calculate parts of line:
+ INT CONST from part :: part (from x, from y),
+ to part :: part (to x, to y) .
+
+both points inside:
+ from part = 0 AND to part = 0 .
+
+both points outside:
+ (from part AND to part) <> 0 .
+
+first point outside:
+ from part <> 0 AND to part = 0 .
+
+second point outside:
+ to part <> 0 AND from part = 0 .
+
+END PROC clip;
+
+INT PROC part (INT CONST x, y):
+ INT VAR index :: 0;
+ IF x > x max
+ THEN set bit (index, 0)
+ ELIF x < x min
+ THEN set bit (index, 1) FI;
+
+ IF y > y max
+ THEN set bit (index, 2)
+ ELIF y < y min
+ THEN set bit (index, 3) FI;
+
+ index
+
+END PROC part;
+
+PROC intersection (INT CONST from x, from y, to x, to y, to part, INT VAR x, y):
+ SELECT to part OF
+ CASE 1: right side
+ CASE 2: left side
+ CASE 4: up side
+ CASE 5: upright side
+ CASE 6: upleft side
+ CASE 8: down side
+ CASE 9: downright side
+ CASE 10: downleft side
+ OTHERWISE errorstop ("wrong partno.:" + text (to part)) ENDSELECT .
+
+right side:
+ y := from y + int (real (x max-from x)*(dy/dx));
+ x := x max .
+
+left side:
+ y := from y + int (real (x min-from x)*(dy/dx));
+ x := x min .
+
+up side:
+ x := from x + int (real (y max-from y)*(dx/dy));
+ y := y max .
+
+down side:
+ x := from x + int (real (y min-from y)*(dx/dy));
+ y := y min .
+
+upright side:
+ right side;
+ IF y > y max
+ THEN up side FI .
+
+downright side:
+ right side;
+ IF y < y min
+ THEN down side FI .
+
+upleft side:
+ left side;
+ IF y > y max
+ THEN up side FI .
+
+downleft side:
+ left side;
+ IF y < y min
+ THEN down side FI .
+
+dx: real (to x-from x) .
+dy: real (to y-from y) .
+
+END PROC intersection;
+
+END PACKET clipping;
+
+PACKET thick line DEFINES thick: (*Autor: Heiko Indenbirken *)
+ (*Stand: 02.07.85/15:07 *)
+ (*Änderung: 05.08.86/15:52 *)
+PROC thick (INT CONST x0, y0, x1, y1, thick,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ IF is point
+ THEN draw point
+ ELIF is horizontal line
+ THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ x0, y0, x1, y1, thick)
+ ELSE vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ x0, y0, x1, y1, thick)
+ FI .
+
+is point:
+ x0 = x1 AND y0 = y1 .
+
+is horizontal line:
+ abs (x0-x1) >= abs (y0-y1) .
+
+draw point:
+ INT VAR i;
+ FOR i FROM -thick UPTO thick
+ REP line (x0-thick, y0+i, x0+thick, y0+i) PER .
+
+END PROC thick;
+
+PROC horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ INT CONST from x, from y, to x, to y, thick):
+ IF from x > to x
+ THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ to x, to y, from x, from y, thick)
+ ELSE draw line FI .
+
+draw line:
+ INT VAR i;
+ calculate increase;
+ calculate limit points;
+ FOR i FROM -thick UPTO thick
+ REP calculate delta x;
+ line (x start+delta x, y start+i, x end+delta x, y end+i)
+ PER .
+
+calculate increase:
+ REAL VAR increase :: -dy / dx .
+
+calculate limit points:
+ INT CONST x start :: from x - thick,
+ x end :: to x + thick,
+ y start :: from y + int (increase * real (thick)),
+ y end :: to y - int (increase * real (thick)) .
+
+calculate delta x:
+ INT CONST delta x :: int (increase*real (i)) .
+
+dx: real (to x-from x) .
+dy: real (to y-from y) .
+
+END PROC horizontal line;
+
+PROC vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ INT CONST from x, from y, to x, to y, thick):
+ IF from y > to y
+ THEN vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+ to x, to y, from x, from y, thick)
+ ELSE draw line FI .
+
+draw line:
+ INT VAR i;
+ calculate increase;
+ calculate limit points;
+ FOR i FROM -thick UPTO thick
+ REP calculate delta y;
+ line (x start+i, y start+delta y, x end+i, y end+delta y)
+ PER .
+
+calculate increase:
+ REAL VAR increase :: -dx / dy .
+
+calculate limit points:
+ INT CONST x start :: from x + int (increase * real (thick)),
+ x end :: to x - int (increase * real (thick)),
+ y start :: from y - thick,
+ y end :: to y + thick .
+
+calculate delta y:
+ INT CONST delta y :: int (increase*real (i)) .
+
+dx: real (to x-from x) .
+dy: real (to y-from y) .
+
+END PROC vertical line;
+
+END PACKET thick line;
+
+PACKET graphik text DEFINES draw char, (*Autor: Heiko Indenbirken *)
+ zeichensatz: (*Stand: 27.06.85/16:03 *)
+ (*Änderung: 28.06.85/19:06 *)
+ (*Änderung: 05.08.86/16:00 *)
+LET ZEICHENSATZ = ROW 255 TEXT;
+ZEICHENSATZ VAR zeichen;
+INT CONST char x :: 6, char y :: 10;
+
+zeichensatz ("ZEICHENSATZ");
+
+PROC zeichensatz (TEXT CONST name):
+ IF exists (name)
+ THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);
+ zeichen := new zeichen;
+ ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI
+END PROC zeichensatz;
+
+PROC draw char (INT CONST char no, INT CONST x, y, x size, y size, direction,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ TEXT CONST character :: zeichen [char no];
+ INT VAR n :: 1, x0, y0, x1, y1;
+ INT CONST len :: length (character);
+ WHILE n < len
+ REP value (character, n, x0, y0, x1, y1);
+ transform (x0, y0, x, y, x size, y size, direction);
+ transform (x1, y1, x, y, x size, y size, direction);
+ line (x0, y0, x1, y1);
+ n INCR 4
+ PER .
+
+END PROC draw char;
+
+PROC value (TEXT CONST char, INT CONST n, INT VAR x0, y0, x1, y1):
+ x0 := val (code (char SUB n)); y0 := val (code (char SUB n+1));
+ x1 := val (code (char SUB n+2)); y1 := val (code (char SUB n+3));
+END PROC value;
+
+INT PROC val (INT CONST n):
+ IF n > 127
+ THEN -256 OR n
+ ELSE n FI
+END PROC val;
+
+PROC transform (INT VAR x, y, INT CONST x0, y0, x size, y size, direction):
+ INT CONST old x :: x, old y :: y;
+ SELECT direction OF
+ CASE 0: x := x0 + x vektor; y := y0 + y vektor
+ CASE 1: x := x0 - y vektor; y := y0 + x vektor
+ CASE 2: x := x0 - x vektor; y := y0 - y vektor
+ CASE 3: x := x0 + y vektor; y := y0 - x vektor
+ ENDSELECT .
+
+x vektor:
+ IF x size = 0
+ THEN old x
+ ELSE (old x*x size) DIV char x FI .
+
+y vektor:
+ IF y size = 0
+ THEN old y
+ ELSE (old y*y size) DIV char y FI .
+
+END PROC transform;
+
+END PACKET graphik text;
+
+PACKET graphik text DEFINES draw text: (*Autor: Heiko Indenbirken *)
+ (*Stand: 03.07.85/11:55 *)
+ (*Änderung: 05.08.86/16:04 *)
+PROC draw text (INT CONST x pos, y pos,
+ TEXT CONST msg, REAL CONST angle, INT CONST height, width,
+ PROC (INT CONST, INT CONST,
+ INT CONST, INT CONST, INT CONST, INT CONST) draw char):
+ INT CONST dir :: int (((angle MOD 360.0)+45.0) / 90.0);
+ INT VAR i;
+ REAL VAR x :: real (x pos), y :: real (y pos),
+ x step :: cosd (angle)*real (width),
+ y step :: sind (angle)*real (width);
+ FOR i FROM 1 UPTO length (msg)
+ REP IF control char
+ THEN execute control char
+ ELSE execute normal char FI
+ PER .
+
+control char:
+ akt char < ""32"" .
+
+execute control char:
+ SELECT code (akt char) OF
+ CASE 1: home
+ CASE 2: right
+ CASE 3: up
+ CASE 7: out (""7"")
+ CASE 8: left
+ CASE 10: down
+ CASE 13: return
+ ENDSELECT .
+
+home:
+ x := real (x pos);
+ y := real (y pos) .
+
+right:
+ x INCR x step; y INCR y step .
+
+up:
+ x INCR y step; y INCR x step .
+
+left:
+ x DECR x step; y DECR y step .
+
+down:
+ x DECR y step; y DECR x step .
+
+return:
+ x := real (x pos) .
+
+execute normal char:
+ draw char (code (akt char), dir, int (x+0.5), int (y+0.5), height, width);
+ x INCR x step;
+ y INCR y step .
+
+akt char:
+ msg SUB i .
+
+END PROC draw text;
+
+END PACKET graphik text;
+
+PACKET comercial plot DEFINES bar, (*Autor: Heiko Indenbirken *)
+ circle: (*Stand: 03.04.1985 *)
+ (*Änderung: 03.07.85/15:37 *)
+PROC bar (INT CONST from x, from y, to x, to y, pattern,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ IF from x > to x
+ THEN bar (to x, from y, from x, to y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ ELIF from y > to y
+ THEN bar (from x, to y, to x, from y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ ELSE draw frame;
+ fill frame with pattern
+ FI .
+
+draw frame:
+ line (from x, from y, from x, to y);
+ line (from x, to y, to x, to y);
+ line (to x, to y, to x, from y);
+ line (to x, from y, from x, from y) .
+
+fill frame with pattern:
+ SELECT pattern OF
+ CASE 1: fill right (from x, to x, from y, to y, 2, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 2: fill hor (from x, to x, from y, to y, 1, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 3: fill hor (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 4: fill vert (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 5: fill hor (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line);
+ fill vert (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 6: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 7: fill left (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ CASE 8: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line);
+ fill left (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+ ENDSELECT .
+
+END PROC bar;
+
+PROC fill hor (INT CONST from x, to x, from y, to y, step,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ INT VAR y :: from y;
+ REP line (from x, y, to x, y);
+ y INCR step
+ UNTIL y > to y PER .
+
+END PROC fill hor;
+
+PROC fill vert (INT CONST from x, to x, from y, to y, step,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ INT VAR x :: from x;
+ REP line (x, from y, x, to y);
+ x INCR step
+ UNTIL x > to x PER .
+
+END PROC fill vert;
+
+PROC fill right (INT CONST from x, to x, from y, to y, step,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ INT CONST width :: to x - from x,
+ height :: to y - from y,
+ length :: width + height,
+ height step :: height + step,
+ width step :: width + step;
+
+ INT VAR t :: step, left :: from x, right :: from x,
+ lower :: from y, upper :: from y;
+(* Ausfüllen von links unten nach rechts oben *)
+ WHILE t < length
+ REP calc start point;
+ calc end point;
+ line (left, upper, right, lower);
+ t INCR step
+ PER .
+
+calc start point:
+ IF t < height
+ THEN upper INCR step
+ ELIF t < height step
+ THEN left := from x + t - height;
+ upper := to y
+ ELSE left INCR step FI .
+
+calc end point:
+ IF t < width
+ THEN right INCR step
+ ELIF t < width step
+ THEN lower := from y + t - width;
+ right := to x
+ ELSE lower INCR step FI .
+
+END PROC fill right;
+
+PROC fill left (INT CONST from x, to x, from y, to y, step,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ INT CONST width :: to x - from x,
+ height :: to y - from y,
+ length :: width + height,
+ height step :: height + step,
+ width step :: width + step;
+
+ INT VAR t :: step, left :: to x, right :: to x,
+ lower :: from y, upper :: from y;
+(* Ausfüllen von rechts unten nach links oben *)
+ WHILE t < length
+ REP calc start point;
+ calc end point;
+ line (right, upper, left, lower);
+ t INCR step
+ PER .
+
+calc start point:
+ IF t < height
+ THEN upper INCR step
+ ELIF t < height step
+ THEN right := to x - t + height;
+ upper := to y
+ ELSE right DECR step FI .
+
+calc end point:
+ IF t < width
+ THEN left DECR step
+ ELIF t < width step
+ THEN lower := from y + t - width;
+ left := from x
+ ELSE lower INCR step FI .
+
+END PROC fill left;
+
+PROC circle (INT CONST x, y, rad, REAL CONST from, to, INT CONST pattern,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+ REAL VAR t :: from;
+ INT VAR last x :: x, last y :: y;
+ WHILE t <= to
+ REP calc circle;
+ draw step;
+ t INCR 5.0
+ PER;
+ line (x rad, y rad, x, y) .
+
+draw step:
+ IF pattern = 0
+ THEN line (last x, last y, x rad, y rad);
+ last x := x rad;
+ last y := y rad
+ ELSE line (x, y, x rad, y rad) FI .
+
+calc circle:
+ INT CONST x rad :: int (cosd (t)*real (rad)+0.5)+x,
+ y rad :: int (sind (t)*real (rad)+0.5)+y .
+
+END PROC circle;
+
+END PACKET comercial plot;
+
+PACKET pc plot DEFINES drawing area, (*Autor: Heiko Indenbirken *)
+ begin plot, (*Stand: 20.05.85 *)
+ end plot, (*Änderung: 27.06.85/16:17 *)
+ clear, (*Änderung: 03.07.85/15:59 *)
+ (*Änderung: 06.08.86/10:03 *)
+ graphik,
+ set pen, get pen,
+
+ move,
+ draw,
+ draw line,
+ marker,
+ bar, circle,
+ where:
+
+
+LET POS = STRUCT (INT x, y);
+LET PEN = STRUCT (INT back, fore, thick, line);
+INT CONST back code :: -4,
+ modus code :: -5,
+ draw code :: -6,
+ move code :: -7,
+ pen code :: -8,
+ full line :: -1;
+
+INT VAR d, y, pause time :: 10,
+ resolution :: 4, max x :: 319, max y :: 199;
+BOOL VAR is clear := FALSE;
+POS VAR old :: POS : (0, 0);
+PEN VAR pen :: PEN : (0, 1, 0, full line);
+
+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) :
+ x cm := 22.0; y cm := 13.7;
+ x pixel := max x; y pixel := max y;
+END PROC drawing area;
+
+PROC graphik (INT CONST modus, pause):
+ pause time := pause;
+ SELECT modus OF
+ CASE 0: resolution := 3;
+ CASE 1: resolution := 72;
+ max x := 639;
+ max y := 399
+ CASE 2: resolution := 64;
+ max x := 639;
+ max y := 399
+ CASE 3: resolution := 6;
+ max x := 639;
+ max y := 199
+ CASE 4: resolution := 4;
+ max x := 319;
+ max y := 199
+ OTHERWISE errorstop ("Nur Modi 0-4") ENDSELECT;
+
+ set range (0, 0, max x, max y);
+END PROC graphik;
+
+PROC begin plot :
+ control (modus code, resolution, 0, d);
+ is clear := TRUE;
+ENDPROC begin plot ;
+
+PROC end plot :
+ IF pause time > 0
+ THEN indicate end plot FI;
+ control (modus code, 3, 0, d) .
+
+indicate end plot:
+ control (pen code, full line, full line, d);
+ REP set indicator;
+ UNTIL incharety (pause time) <> "" PER .
+
+set indicator:
+ control (move code, 0, max y, d);
+ control (draw code, max x, max y, d) .
+
+ENDPROC end plot ;
+
+PROC clear:
+ INT VAR x0, x1, y0, y1;
+ new values (22.0, 13.7, max x, max y, x0, x1, y0, y1);
+ set range (x0, y0, x1, y1);
+ clear screen;
+ clear pen;
+ clear pos;
+ is clear := FALSE .
+
+clear screen:
+ IF is clear OR full screen
+ THEN control (modus code, resolution, 0, d)
+ ELSE draw frame;
+ clear frame
+ FI .
+
+full screen:
+ x0 < 10 AND x1 > (max x-10) AND
+ y0 < 10 AND y1 > (max y-10) .
+
+draw frame:
+ control (move code, x0, y0, d);
+ control (draw code, x1, y0, d);
+ control (draw code, x1, y1, d);
+ control (draw code, x0, y1, d);
+ control (draw code, x0, y0, d) .
+
+clear frame:
+ control (pen code, full line, 0, d);
+ FOR y FROM max y-y1 UPTO max y-y0
+ REP control (move code, x0, y, d);
+ control (draw code, x1, y, d);
+ PER .
+
+clear pen:
+ pen := PEN : (0, 1, 0, full line);
+ control (pen code, full line, 1, d) .
+
+clear pos:
+ old := POS : (x0, y0);
+ control (move code, x0, max y-y0, d) .
+
+END PROC clear;
+
+PROC set pen (INT CONST back, fore, thick, type):
+ set background;
+ set foreground and linetype;
+ set thickness .
+
+set background:
+ pen.back := back; (*Hintergrund über niederwertiges *)
+ control (back code, 0, back no, d) .(*Byte von colour code *)
+ (*Höherwetiges Byte regelt die *)
+back no: (*Farbpalette *)
+ IF back = 0
+ THEN std background
+ ELSE back FI .
+
+std background:
+ IF resolution = 4
+ THEN 16
+ ELSE 15 FI .
+
+set foreground and linetype: (*0, 1, 2, 3 Farben: löschend,*)
+ pen.fore := possible colour; (*ändernd oder überschreibend *)
+ pen.line := type; (* in allen Linientypen. *)
+ control (pen code, line (type), pen.fore, d) .
+
+possible colour:
+ IF fore <= full line
+ THEN full line
+ ELIF fore > 3 OR (fore > 1 AND resolution <> 4)
+ THEN 1
+ ELSE fore FI .
+
+set thickness:
+ pen.thick := thick DIV 10 .
+
+END PROC set pen;
+
+PROC get pen (INT VAR back, fore, thick, line):
+ back := pen.back;
+ fore := pen.fore;
+ thick := pen.thick;
+ line := pen.line
+END PROC get pen;
+
+INT PROC line (INT CONST type):
+ SELECT type OF
+ CASE 0: 0
+ CASE 1: full line
+ CASE 2: 21845
+ CASE 3: 3855
+ CASE 4: 255
+ CASE 5: 4351
+ OTHERWISE type END SELECT
+END PROC line;
+
+PROC int move (INT CONST x, y):
+ control (move code, x, max y-y, d);
+END PROC int move;
+
+PROC int draw (INT CONST x, y):
+ control (draw code, x, max y-y, d);
+END PROC int draw;
+
+PROC draw line (INT CONST from x, from y, to x, to y):
+ control (move code, from x, max y-from y, d);
+ clip (from x, from y, to x, to y, PROC int move, PROC int draw)
+END PROC draw line;
+
+PROC move (INT CONST x, y) :
+ control (move code, x, max y-y, d);
+ old := POS : (x, y)
+END PROC move;
+
+PROC draw (INT CONST x, y):
+ IF std thickness
+ THEN clip (old.x, old.y, x, y, PROC int move, PROC int draw)
+ ELSE thick (old.x, old.y, x, y, pen.thick, PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line) FI;
+ old := POS : (x, y) .
+
+std thickness: pen.thick = 0 .
+END PROC draw;
+
+PROC draw (TEXT CONST msg, REAL CONST angle, INT CONST height, width):
+ control (pen code, full line, pen.fore, d);
+ draw text (old.x, old.y, msg, angle, y size, x size,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST, INT CONST, INT CONST) draw char);
+ control (move code, old.x, max y-old.y, d);
+ control (pen code, line (pen.line), pen.fore, d) .
+
+x size: IF width = 0
+ THEN 6
+ ELSE width FI .
+y size: IF height = 0
+ THEN 10
+ ELSE height FI .
+
+END PROC draw;
+
+PROC draw char (INT CONST char, direction, x, y, INT CONST height, width):
+ draw char (char, x, y, width, height, direction,
+ PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line)
+END PROC draw char;
+
+PROC bar (INT CONST from x, from y, to x, to y, pattern):
+ control (pen code, full line, pen.fore, d);
+ bar (from x, from y, to x, to y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line);
+ control (move code, old.x, max y-old.y, d);
+ control (pen code, line (pen.line), pen.fore, d) .
+END PROC bar;
+
+PROC circle (INT CONST x, y, rad, REAL CONST from, to, INT CONST pattern):
+ control (pen code, full line, pen.fore, d);
+ circle (x, y, rad, from, to, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line);
+ control (move code, old.x, max y-old.y, d);
+ control (pen code, line (pen.line), pen.fore, d) .
+END PROC circle;
+
+PROC marker (INT CONST x, y, no, size):
+ control (pen code, full line, pen.fore, d);
+ draw char (no, 0, x, y, size, size);
+ control (move code, old.x, max y-old.y, d);
+ control (pen code, line (pen.line), pen.fore, d) .
+END PROC marker;
+
+PROC where (INT VAR x, y):
+ x := old.x; y := old.y
+END PROC where;
+
+END PACKET pc plot
+
diff --git a/system/std.graphik/1.8.7/src/ZEICHENSATZ b/system/std.graphik/1.8.7/src/ZEICHENSATZ
new file mode 100644
index 0000000..9866ec2
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/ZEICHENSATZ
Binary files differ
diff --git a/system/std.graphik/1.8.7/src/gen Graphik b/system/std.graphik/1.8.7/src/gen Graphik
new file mode 100644
index 0000000..f70cc66
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/gen Graphik
@@ -0,0 +1,16 @@
+TEXT VAR geraet;
+page;
+out ("Bitte den Namen der Hardwareanpassung (z.B. 'PC.plot') eingeben: ");
+get line (geraet);
+IF NOT exists (geraet)
+THEN errorstop ("Endgerät nicht vorhanden") FI;
+
+insert ("GRAPHIK.Picfile");
+insert ("GRAPHIK.Transform");
+insert (geraet);
+insert ("GRAPHIK.Plot");
+
+
+
+
+
diff --git a/system/std.graphik/1.8.7/src/gen Plotter b/system/std.graphik/1.8.7/src/gen Plotter
new file mode 100644
index 0000000..73d7b2f
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/gen Plotter
@@ -0,0 +1,16 @@
+TEXT VAR geraet;
+page;
+out ("Bitte den Namen der Hardwareanpassung (z.B. 'PC.plot') eingeben: ");
+get line (geraet);
+IF NOT exists (geraet)
+THEN errorstop ("Endgerät nicht vorhanden") FI;
+
+insert ("GRAPHIK.Picfile");
+insert ("GRAPHIK.Transform");
+insert (geraet);
+insert ("GRAPHIK.Plotter");
+insert ("GRAPHIK.Server")
+
+
+
+
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;
+