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