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 --- lang/dynamo/1.8.7/src/dyn.plot+ | 729 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 729 insertions(+) create mode 100644 lang/dynamo/1.8.7/src/dyn.plot+ (limited to 'lang/dynamo/1.8.7/src/dyn.plot+') diff --git a/lang/dynamo/1.8.7/src/dyn.plot+ b/lang/dynamo/1.8.7/src/dyn.plot+ new file mode 100644 index 0000000..db04dfc --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.plot+ @@ -0,0 +1,729 @@ +PACKET graphics DEFINES graphmode, + attribut, + palette, + move, + plot, + draw line, + draw linetype, + color, + draw to: + + +(* Autor: Giffeler GD *) +(* Datum: 31.03.1988 *) +(* Schönbeck SHard *) + +INT VAR linie :: -1, farbe :: 1, dummy; + + +PROC attribut (INT CONST nr): + +(* 0..15 Vordergrundfarben fuer Textdarstellung + 0..7 Hintergrundfarben + Attribut fuer blinkende Darstellung (+128) *) + + control (-3, nr, 0, dummy) + +END PROC attribut; + + +PROC palette (INT CONST nr): + +(* Farbauswahl fuer Grafikmodi *) + + control (-4, 0, nr, dummy) + +END PROC palette; + + +PROC graphmode (INT CONST mode): + +(* 0 -> TEXT 40*25 monochrom + 2 -> 80*25 + 1 -> 40*25 farbig + 3 -> 80*25 + 7 -> 80*25 Herkules + 4 -> GRAFIK 320*200 farbig + 5 -> monochrom + 6 -> 640*200 + 64 -> Olivetti 640*400 monochrom + 72 -> kleine Schrift + 512 -> Herkules 720*348 monochrom *) + + control (-5, mode, 0, dummy) + +END PROC graphmode; + + +PROC draw linetype (INT CONST pen, color): + +(* Linienschraffur und Zeichenfarbe *) + + linie:= pen; + farbe:= color; + control (-8, linie, farbe, dummy) + +END PROC draw linetype; + + +PROC draw linetype (INT CONST nr): + +(* Ausschliessliche Aenderung der Linienschraffur *) + + linie:= nr; + control (-8, linie, farbe, dummy) + +END PROC draw linetype; + + +PROC color (INT CONST nr): + +(* Ausschliessliche Aenderung der Zeichenfarbe *) + + farbe:= nr; + control (-8, linie, farbe, dummy) + +END PROC color; + + +PROC move (INT CONST x, y): + +(* Bewegt Zeichencursor zu Koordinaten (0,0 = Links oben) *) + + control (-7, x, y, dummy) + +END PROC move; + + +PROC move (REAL CONST x, y): + + control (-7, int(x+0.5), int(y+0.5), dummy) + +END PROC move; + + +PROC draw to (INT CONST x, y): + +(* Zeichnet Gerade von momentaner Zeichencursorposition nach x,y *) + + control (-6, x, y, dummy) + +END PROC draw to; + + +PROC draw to (REAL CONST x, y): + + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC draw to; + + +PROC draw line (INT CONST x1, y1, x2, y2): + +(* Zieht eine Linie von x1,y1 nach x2,y2 *) + + plot (x1, y1); + draw to (x2, y2) + +END PROC draw line; + + +PROC draw line (REAL CONST x1, y1, x2, y2): + + plot (x1, y1); + draw to (x2, y2) + +END PROC draw line; + + +PROC plot (INT CONST x, y): + +(* Zeichnet einen Punkt *) + + control (-7, x, y, dummy); + control (-6, x, y, dummy) + +END PROC plot; + + +PROC plot (REAL CONST x, y): + + control (-7, int(x+0.5), int(y+0.5), dummy); + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC plot; + + +PROC draw to (INT CONST x, y, f): + +(* Zeichnet Gerade von momentaner Zeichencursorposition nach x,y *) + + color (f); + control (-6, x, y, dummy) + +END PROC draw to; + + +PROC draw to (REAL CONST x, y, INT CONST f): + + color (f); + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC draw to; + + +PROC draw line (INT CONST x1, y1, x2, y2, f): + +(* Zieht eine Linie von x1,y1 nach x2,y2 *) + + plot (x1, y1, f); + draw to (x2, y2) + +END PROC draw line; + + +PROC draw line (REAL CONST x1, y1, x2, y2, INT CONST f): + + plot (x1, y1, f); + draw to (x2, y2) + +END PROC draw line; + + +PROC plot (INT CONST x, y, f): + +(* Zeichnet einen Punkt mit der Farbe f (0 = schwarz) *) + + color (f); + control (-7, x, y, dummy); + control (-6, x, y, dummy) + +END PROC plot; + + +PROC plot (REAL CONST x, y, INT CONST f): + + color (f); + control (-7, int(x+0.5), int(y+0.5), dummy); + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC plot + + +END PACKET graphics; + + +PACKET dynamo plotter plus DEFINES configurate plot, + initialize plot, + new plot line, + plot, + end of program, + stop request, + plot scale: + +(* DYNAMO Grafikausgabe *) +(* Autor : Giffeler GD *) +(* Datum : 29.04.1988, 03.06.1988 *) +(* Änder.: Christian Szymanski *) +(* 21.07.88 *) + + +LET max value = 330, + value page length = 30, + max param numb = 10, + + PARAM = ROW value page length REAL, + BIG = ROW 300 REAL, + + max devices = 3, + SWITCH = STRUCT (TEXT bezeichnung, INT on, off, + zeichenbreite, zeichenhoehe, + h offset, + x, y, breite, hoehe), + SIZE = ROW max devices SWITCH; + + +TYPE PLOTPARAM = STRUCT (TEXT name, REAL lower bound, upper bound); + + +ROW max param numb PLOTPARAM VAR plotparam; +ROW max value REAL VAR value; + +BOOL VAR plt, ende; +REAL VAR pltper, nextplot; +INT VAR value no, param no, plot line no, mode nr, plot param no, line no, + xp, yp; + +SIZE CONST table :: SIZE: + (SWITCH: ("CGA 640 * 200", 6, 2, 8, 8, 5, 4, 20, 615, 102), + SWITCH: ("HGC 720 * 348", 512, 0, 0, 0, 0, 0, 0, 0, 0), + SWITCH: ("OLI 640 * 400", 64, 2, 8, 16, 10, 4, 25, 615, 223)); + +configurate plot; (* Erster Aufruf nach der Insertierung *) + + +PROC plot one page : +INT VAR loop nr, n, m; +PARAM VAR x, y; +BIG VAR xr, yr; + + kopfzeile ("Stuetzstellen: ", TRUE); + xp:= 1; yp:= 19; + FOR loop nr FROM 1 UPTO plot param no REP + werte aus value in x und y uebertragen; + koordinatenkreuz (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe); + x raster (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe, n); + zusatzinformationen ausgeben; + spline (n, m, 1, x, y, xr, yr); + draw picture (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe, + loop nr, m, + plot param[loop nr].lower bound, + plot param[loop nr].upper bound, + xr, yr); + legende ausgeben + PER; + abbruch; + graphmode(table[mode nr].off). + +werte aus value in x und y uebertragen: +INT CONST erh :: plot param no + 1; +INT VAR z :: 1, w :: loop nr + 1; + + FOR n FROM 1 UPTO value no DIV erh REP + x[n]:= value[z]; y[n]:= value[w]; + z INCR erh; + w INCR erh + PER; + n DECR 1; + m:= n * 10. + +zusatzinformationen ausgeben: +TEXT CONST xn :: text(x[n]); + + cursor (1, 17); put (x[1]); + cursor (81 - LENGTH xn, 17); + out (xn); + cursor (74, 1). + +legende ausgeben: +INT VAR xph, yph; + + cursor (xp, yp); + put (plot param[loop nr].name + "="); + put (plot param[loop nr].lower bound); + put ("-"); + put (plot param[loop nr].upper bound); + get cursor (xph, yph); + draw line (xph * table[mode nr].zeichenbreite - 8, + yph * table[mode nr].zeichenhoehe - table[mode nr].h offset, + xph * table[mode nr].zeichenbreite + 24, + yph * table[mode nr].zeichenhoehe - table[mode nr].h offset); + IF xp > 1 THEN line ELSE cursor (40, yph) FI; + get cursor (xp, yp). + +abbruch: +TEXT VAR eingabe; + + REP + cursor (30, 1); + put (39*" "+"(+, p, e)?"); + inchar (eingabe); + SELECT code (eingabe) OF + CASE 43 : eingabe:= "" + CASE 69, 101: ende:= TRUE; eingabe:= "" + CASE 80, 112: phasendiagramm + OTHERWISE out(""7"") + END SELECT + UNTIL eingabe = "" PER + +END PROC plot one page; + + +PROC initialize plot (TEXT CONST h) : +INT VAR c :: 1, typ; +TEXT VAR sym, num; + + ende:= FALSE; + pltper:= get pltper; + plot line no:= value page length; + nextplot:= 0.0; + value no:= 0; + line no:= 0; + plot param no:= 0; + kopfzeile zerlegen. + +kopfzeile zerlegen: + scan (h); + REP + next symbol (plot param[c].name); + next symbol (sym, typ); + IF sym = "(" THEN + next symbol (num); + next symbol (sym, typ); + IF sym = ")" THEN + plot param[c].name CAT ("(" + num + ")") + FI + FI; + WHILE typ < 7 CAND NOT (sym = "(" COR sym = ",") REP + next symbol (sym, typ) + PER; + IF typ < 7 CAND sym = "(" THEN + REP next symbol (sym) + UNTIL sym = "," PER; + REP next symbol (sym, typ) + UNTIL typ > 6 COR sym = "," COR sym = "/" PER + FI; + c INCR 1 + UNTIL typ > 6 PER + +END PROC initialize plot; + + +PROC plot scale (TEXT CONST id, INT CONST scale pointer, + REAL CONST lower bound, upper bound, + BOOL CONST l fixed scale, u fixed scale) : + + plot param no INCR 1; + plot param[plot param no].lower bound:= lower bound; + plot param[plot param no].upper bound:= upper bound + +END PROC plot scale; + + +PROC new plot line (REAL CONST time) : + + plt:= time >= nextplot; + IF plt THEN + add (time); + line no INCR 1; + param no:= 0 + FI; + WHILE time >= nextplot REP + nextplot INCR pltper + PER + +END PROC new plot line; + + +PROC plot (REAL CONST r): + + IF plt THEN + param no INCR 1; + add (r); + IF NOT ende CAND param no = plot param no AND + line no = value page length THEN + plot one page; + value no:= 0; + line no:= 0 + FI + FI + +END PROC plot; + + +PROC add (REAL CONST r): + + IF NOT ende THEN + value no INCR 1; + value[value no]:= r + FI + +END PROC add; + + +PROC spline (INT CONST n, m, s, PARAM CONST x, y, BIG VAR xr, yr): + +{ Kubische Splineinterpolation 3. Grades; 2 fach Differenzierbar } +{ Quelle: Rita Schmidt, Hahn-Meitner-Institut für Kernforschung Berlin } +{ "Spline-Prozeduren" (HMI-B 220) } +{ Umsetzung & Modifikation: Giffeler GD, 13.04.1988, 22.04.1988 } + +{ n = Anzahl der Stützstellen } +{ m = Anzahl der zu berechnenden Funktionswerte } +{ s = Index des x-Startpunktes } +{ x = x-Werte der Stützstellen (linear steigend) } +{ y = y-Werte der Stützstellen } +{ xr = x-Werte der Punkte, an denen die Funktion berechnet werden } +{ soll } +{ yr = y-Werte der Punkte, an denen die Funktion berechnet werden } +{ soll } + + +INT CONST nn :: n - 1; +REAL CONST steps :: (real(nn) * (x[2] - x[1])) / real(m - 1); + +PARAM VAR q, au; +REAL VAR hi, hk, hk1, dij, dim1j; +INT VAR k, kk, j, m1, m2, m3; + + q[1]:= 0.0; + yr[1]:= x[s]; + FOR j FROM 2 UPTO m REP yr[j]:= yr[j - 1] + steps PER; + xr:= yr; + block 0; + FOR k FROM 2 UPTO nn REP block 1 PER; + FOR kk FROM 2 UPTO nn REP block 2 PER; + FOR j FROM 1 UPTO m REP block 3 PER. + +block 0: + au[1]:= (y[3] - y[2] - y[2] + y[1]) / ((x[2] - x[1]) * (x[3] - x[2])); + au[n]:= (y[n] - y[nn] - y[nn] + y[n - 2]) / + ((x[n] - x[nn]) * (x[nn] - x[n - 2])). + +block 1: +INT CONST km1 :: k - 1, kp1 :: k + 1; + + hk:= x[k] - x[km1]; + hk1:= x[kp1] - x[k]; + q[k]:= - hk1 / (hk * (q[km1] + 2.0) + 2.0 * hk1); + au[k]:= (hk * au[km1] - 6.0 * ((y[kp1] - y[k]) / hk1 - (y[k] - + y[km1]) / hk)) * q[k] / hk1. + +block 2: + k:= nn - kk + 2; + au[k]:= q[k] * au[k + 1] + au[k]. + +block 3: + zeige benutzer das du noch lebst; + IF yr[j] < x[1] THEN + m1:= 1; + m2:= 2 + ELIF yr[j] > x[n] THEN + m1:= n - 1; + m2:= n + ELSE + m1:= 1; + m2:= n; + wiederholung + FI; + dij:= x[m2] - yr[j]; + hi:= x[m2] - x[m1]; + dim1j:= x[m1] - yr[j]; + yr[j]:= 1.0 / 6.0 / hi * (au[m1] * dij ** 3 - au[m2] * dim1j ** 3 + + (6.0 * y[m1] - hi ** 2 * au[m1]) * dij - (6.0 * y[m2] - hi ** 2 + * au[m2]) * dim1j). + +wiederholung: + REP + m3:= (m2 + m1) DIV 2; + IF yr[j] >= x[m3] THEN m1:= m3 ELSE m2:= m3 FI + UNTIL m2 - m1 = 1 PER. + +zeige benutzer das du noch lebst: + cout (j) + +END PROC spline; + + +PROC phasendiagramm: +REAL VAR l :: maxreal, u :: smallreal; +BIG VAR x, y; +INT VAR i, no1, no2; + + IF plot param no > 1 THEN + partnerwahl; + werte aus value uebertragen; + kopfzeile ("Phasendiagramm", TRUE); + koordinatenkreuz (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe+50); + draw picture (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe+50, + 1, i-1, l, u, x, y); + legende + FI. + +partnerwahl: + kopfzeile ("Phasendiagramm", FALSE); + line (2); + FOR i FROM 1 UPTO plot param no REP + putline (text(i, 3) + " = " + plot param[i].name) + PER; + REP + cursor (1, plot param no +5); + put ("X-ACHSE:"); get (no1); + cursor (1, plot param no +5); + put ("Y-ACHSE:"); get (no2) + UNTIL no1 > 0 CAND no1 <= plot param no CAND + no2 > 0 CAND no2 <= plot param no CAND + no1 <> no2 PER. + +werte aus value uebertragen: +INT CONST erh :: plot param no + 1; +INT VAR n1 :: no1 + 1, n2 :: no2 + 1; + + FOR i FROM 1 UPTO value no DIV erh REP + x[i]:= value[n1]; + y[i]:= value[n2]; + n1 INCR erh; + n2 INCR erh + PER. + +legende: + cursor (1, 23); + putline ("X-Achse: " + plot param[no1].name); + out ("Y-Achse: " + plot param[no2].name) + +END PROC phasendiagramm; + + +PROC draw picture (INT CONST x, y, xb, yb, schraffur, m, + REAL VAR lower bound, upper bound, + BIG CONST xr, yr): + +{ Ausgabe einer Funktionskurve } +{ Autor: Giffeler GD, 22.04.1988, 27.04.1988 } + +{ x = X-Position (oben links = 0) } +{ y = Y-Position (oben links = 0) } +{ xb = Ausgabebreite } +{ yb = Ausgabehöhe } +{ schraffur = Linienschraffur (1 - 10) } +{ m = Anzahl der Funktionswerte } +{ lower bound = Unterer Grenzwert (maxreal wenn Grenze beliebig) } +{ upper bound = Oberer Grenzwert (smallreal wenn Grenze beliebig) } +{ xr = Durch SPLINE erzeugte X-Werte } +{ yr = Durch SPLINE erzeugte Y-Werte } + + +ROW 10 INT CONST linienarten :: ROW 10 INT: (-1, -256, 3855, -240, + 21845, -1, -1, -1, -1, -1); + +REAL VAR lbx :: maxreal, ubx :: smallreal; +INT VAR i; + + minimum und maximum fuer x und y berechnen; + abmessungsparameter umwandeln; + spannweite errechnen; + linienschraffur bestimmen; + eine funktion ausgeben. + +minimum und maximum fuer x und y berechnen: + FOR i FROM 1 UPTO m REP + lower bound:= min (lower bound, yr[i]); + upper bound:= max (upper bound, yr[i]); + lbx:= min (lbx, xr[i]); + ubx:= max (ubx, xr[i]) + PER. + +abmessungsparameter umwandeln: +REAL CONST xpos :: real (x), ypos :: real (y), + breite :: real (xb), hoehe :: real (yb). + +spannweite errechnen: +REAL CONST sy :: (upper bound - lower bound) / hoehe, + sx :: (ubx - lbx) / breite. + +linienschraffur bestimmen: + draw linetype (linienarten [abs(schraffur) MOD 10]). + +eine funktion ausgeben: + move (xpos + (xr[1] - lbx) / sx, + ypos + hoehe - (yr[1] - lower bound) / sy); + FOR i FROM 2 UPTO m REP + drawto (xpos + (xr[i] - lbx) / sx, + ypos + hoehe - (yr[i] - lower bound) / sy) + PER + +END PROC draw picture; + + +PROC koordinatenkreuz (INT CONST nx, ny, breite, hoehe): + + anpassung; + rahmen; + pfeil oben; + pfeil rechts. + +anpassung: +INT CONST x :: nx - 1, + y :: ny - 10, + b :: breite + 21, + h :: hoehe + 11. + +rahmen: + draw linetype (-1); + draw line (x, y, x, y + h); + draw to (x + b, y + h). + +pfeil oben: + draw line (x - 3, y + 4, x, y); + draw to (x + 3, y + 4). + +pfeil rechts: + draw line (x + b - 5, y + h - 2, x + b, y + h); + draw to (x + b - 5, y + h + 2) + +END PROC koordinatenkreuz; + + +PROC x raster (INT CONST nx, ny, breite, hoehe, anzahl): +REAL CONST y :: real (ny + hoehe + 2), + w :: real (breite) / real (anzahl); +REAL VAR s :: real (nx); +INT VAR i; + + FOR i FROM 1 UPTO anzahl REP + s INCR w; + plot (s, y) + PER + +END PROC x raster; + + +PROC configurate plot: +(* +BOOL CONST cmd :: command dialogue; +INT VAR i; + + command dialogue (TRUE); + REP + bildschirmausgabe zur auswahl + UNTIL (mode nr <= max devices AND mode nr > 0) CAND + yes ("Eingabe richtig") PER; + command dialogue (cmd). + +bildschirmausgabe zur auswahl: + page; + putline ("CONFIGURATIONSTABELLE DYNAMO GRAFIK"); + line (2); + FOR i FROM 1 UPTO max devices REP + putline (text(i)+" -- "+table[i].bezeichnung) + PER; + line (2); + put ("Modus:"); + get (mode nr) + +*) +mode nr := 1. (* CGA *) +END PROC configurate plot; + + +PROC kopfzeile (TEXT CONST message, BOOL CONST grafik): + + IF grafik THEN graphmode (table[mode nr].on) + ELSE graphmode (table[mode nr].off) FI; + out (""1""); (* C.S. 21.07.88 *) + out ("DYNAMO 3.3+"); + cursor (79 - LENGTH message, 1); + out (message) + +END PROC kopfzeile; + + +PROC end of program : + + IF NOT ende CAND (value no DIV (plot param no + 1)) > 2 THEN + plot one page + FI + +END PROC end of program; + + +BOOL PROC stop request: ende END PROC stop request + + +END PACKET dynamo plotter plus + -- cgit v1.2.3