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