From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- .../1.8.7/doc/Altes Handbuch - Teil 10 - Graphik | 831 +++++++++++++++++++ system/std.graphik/1.8.7/doc/GRAPHIK.book | 897 +++++++++++++++++++++ system/std.graphik/1.8.7/doc/graphik beschreibung | 661 +++++++++++++++ system/std.graphik/1.8.7/source-disk | 1 + system/std.graphik/1.8.7/src/Beispiel.Kreuz | 41 + system/std.graphik/1.8.7/src/Beispiel.Sinus | 45 ++ system/std.graphik/1.8.7/src/GRAPHIK.Picfile | 738 +++++++++++++++++ system/std.graphik/1.8.7/src/GRAPHIK.Plot | 285 +++++++ system/std.graphik/1.8.7/src/GRAPHIK.Plotter | 247 ++++++ system/std.graphik/1.8.7/src/GRAPHIK.Server | 97 +++ system/std.graphik/1.8.7/src/GRAPHIK.Transform | 366 +++++++++ system/std.graphik/1.8.7/src/GRAPHIK.vektor plot | 506 ++++++++++++ system/std.graphik/1.8.7/src/HP7475.plot | 254 ++++++ system/std.graphik/1.8.7/src/PC.plot | 758 +++++++++++++++++ system/std.graphik/1.8.7/src/ZEICHENSATZ | Bin 0 -> 11776 bytes system/std.graphik/1.8.7/src/gen Graphik | 16 + system/std.graphik/1.8.7/src/gen Plotter | 16 + system/std.graphik/1.8.7/src/graphik editor | 324 ++++++++ 18 files changed, 6083 insertions(+) create mode 100644 system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik create mode 100644 system/std.graphik/1.8.7/doc/GRAPHIK.book create mode 100644 system/std.graphik/1.8.7/doc/graphik beschreibung create mode 100644 system/std.graphik/1.8.7/source-disk create mode 100644 system/std.graphik/1.8.7/src/Beispiel.Kreuz create mode 100644 system/std.graphik/1.8.7/src/Beispiel.Sinus create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.Picfile create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.Plot create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.Plotter create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.Server create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.Transform create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.vektor plot create mode 100644 system/std.graphik/1.8.7/src/HP7475.plot create mode 100644 system/std.graphik/1.8.7/src/PC.plot create mode 100644 system/std.graphik/1.8.7/src/ZEICHENSATZ create mode 100644 system/std.graphik/1.8.7/src/gen Graphik create mode 100644 system/std.graphik/1.8.7/src/gen Plotter create mode 100644 system/std.graphik/1.8.7/src/graphik editor (limited to 'system/std.graphik') 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 Binary files /dev/null and b/system/std.graphik/1.8.7/src/ZEICHENSATZ 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; + -- cgit v1.2.3