summaryrefslogtreecommitdiff
path: root/dynamo/dyn.plot+
diff options
context:
space:
mode:
Diffstat (limited to 'dynamo/dyn.plot+')
-rw-r--r--dynamo/dyn.plot+729
1 files changed, 729 insertions, 0 deletions
diff --git a/dynamo/dyn.plot+ b/dynamo/dyn.plot+
new file mode 100644
index 0000000..db04dfc
--- /dev/null
+++ b/dynamo/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
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-24 15:29:16 +0000