From 724cc003460ec67eda269911da85c9f9e40aa6cf Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Fri, 30 Sep 2016 16:57:23 +0200 Subject: Add extracted sources from floppy disk images Some files have no textual representation (yet) and were added as raw dataspaces. --- dynamo/dyn.plot | 235 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 235 insertions(+) create mode 100644 dynamo/dyn.plot (limited to 'dynamo/dyn.plot') diff --git a/dynamo/dyn.plot b/dynamo/dyn.plot new file mode 100644 index 0000000..fe1228a --- /dev/null +++ b/dynamo/dyn.plot @@ -0,0 +1,235 @@ +PACKET dynamo plotter (* Änder.: C.Szymanski, 21.07.88 *) + DEFINES b initialize plot, b new plot line, b plot, b end of program, + b plot scale : + +LET maxvalue = 200, + valuepagelength = 18, + max param numb = 10; + +TYPE PLOTPARAM = STRUCT (TEXT name, id, + INT scale pointer, + REAL lower bound, upper bound, + BOOL l fixed scale, u fixed scale); + +ROW max param numb PLOTPARAM VAR plotparam;(* Enth. Plotparameter *) +ROW maxvalue REAL VAR value; (* Ausgabepuffer *) +ROW max param numb ROW 5 REAL VAR scale; (* Enth. errechnete Skalierungen *) + +BOOL VAR plt; +TEXT VAR headline; +REAL VAR pltper, nextplot; +INT VAR value no, param no, plot line no, + plot param no, line no; +INT CONST nil := 0; + +LET line1 = ".____________.____________.____________.____________.", + line2 = ". . . . ."; + +PROC plot one page : + init plot routine; + plot values. + + init plot routine : + print suppressed output; + plot line no := nil. + + plot values : + INT VAR act value := 1, i; + TEXT VAR plot buf; + line; + vdt; + line; + IF b stop request THEN LEAVE plot one page END IF; + sys page; + plot output (headline); + put scales; + WHILE act value < value no REP + put time; + gen line; + FOR i FROM 1 UPTO plot param no REP + plot single value + END REP; + plot output (plot buf + line0 + collision); + plot line no INCR 1; + act value INCR plot param no; + act value INCR 1 + END REP. + + put time : + plot buf := text (text (round (value (act value), 2)), 6). + (* Erstes Pufferelement enthaelt time *) + + gen line : + TEXT VAR line0, collision := ""; + line0 := act line. + + act line : + IF (plot line no MOD 5) = nil (* Prueft, ob gestrichelte oder durch - *) + THEN line1 (* gezogene Linie gedruckt wird *) + ELSE line2 + FI. + + plot single value : + INT VAR position := int ((x-low)*53.0/(up-low))+1; (*Interpolationsformel*) + position := limit; + IF pos ("._ ", line0 SUB position) > nil + THEN replace (line0, position, plotparam (i).id) + ELSE collision CAT plotparam (i).id + FI. + + limit : + IF position > 53 + THEN 53 + ELIF position < 1 + THEN 1 + ELSE position + FI. + + up : + scale (i) (5). (* Oberer Grenzwert (der Skalierung) *) + + low : + scale (i) (1). (* Unterer Grenzwert *) + + x : + value (act value + i). + + put scales : (* Gibt Skalierung der Variablen aus *) + INT VAR j := 1, l, scalecounter; + WHILE j <= plot param no REP + plot buf := " "; + FOR l FROM 1 UPTO 4 REP + plot buf CAT text (text (scale (j) (l)), 13) + END REP; + plot buf CAT text (scale (j) (5)); + scalecounter := plotparam (j).scalepointer; + WHILE scalecounter = plotparam (j).scalepointer REP + plot buf CAT plotparam (j).id; + j INCR 1 + UNTIL j > max param numb END REP; + plot output (plot buf) + END REP. +END PROC plot one page; + +PROC b plot scale (TEXT CONST id, INT CONST scale pointer, + REAL CONST lower bound, upper bound, + BOOL CONST l fixed scale, u fixed scale) : + (* Liest Skalierungen vom Zielprogramm ein *) + plot param no INCR 1; + plot param (plot param no).id := id; (*Variablenname *) + plot param (plot param no).scale pointer := scale pointer;(*Zeiger *) + plot param (plot param no).lower bound := lower bound; (*Obere Grenze *) + plot param (plot param no).upper bound := upper bound; (*Untere Grenze *) + plot param (plot param no).l fixed scale := l fixed scale;(*Fix-Skalierung*) + plot param (plot param no).u fixed scale := u fixed scale; +END PROC b plot scale; + +PROC gen scales : + INT VAR act param, i; (* Generiert Skalierungen fuer eine Seite *) + FOR act param FROM 1 UPTO plot param no REP + compute single scale + END REP. + + compute single scale : + REAL VAR max := plotparam(plot param(act param).scale pointer).upper bound, + min := plotparam(plot param(act param).scale pointer).lower bound; + IF min > max THEN errorstop ("invalid scale") FI; + compute extreme scales; + FOR i FROM 1 UPTO 3 REP + scale (act param) (i+1) := (scale (act param) (5) - scale (act param) (1)) + * real (i) / 4.0 + scale (act param) (1) + (* Interpolationsformel *) + END REP. + + compute extreme scales : + (* Wenn die Skalierungen nicht gegeben sind, muessen sie berechnet werden. + Zur leichteren Lesbarkeit werden die Skalierungen nach oben bzw. unten + um jeweils eine Stelle gerundet *) + scale (act param) (5) := upper limit; + scale (act param) (1) := lower limit. + + upper limit : + IF plot param (plot param (act param).scale pointer).u fixed scale + THEN max + ELSE round (floor (max) + 0.5, 0) + FI. + + lower limit : + IF plot param (plot param (act param).scale pointer).l fixed scale + THEN min + ELSE round (floor (min) - 0.5, 0) + FI. +END PROC gen scales; + +PROC b initialize plot (TEXT CONST h) : + headline := h; + pltper := get pltper; + plot line no := value pagelength; + nextplot := 0.0; + value no := nil; + line no := nil; + plot param no := nil +END PROC b initialize plot; + +PROC b new plot line (REAL CONST time) : + plt := time >= nextplot; + IF plt (* Wird vom Zielprogramm aufgerufen, um *) + THEN add (time); (* Zeilenvorschub durchzufuehren *) + line no INCR 1; + param no := nil + FI; + WHILE time >= nextplot REP (* Ist noetig, weil pltper ungleich dt sein *) + nextplot INCR pltper (* kann *) + END REP +END PROC b new plot line; + +PROC b end of program : (* Druckt am Schluss evt. noch gepufferte *) + IF plot line no = value page length AND NOT stop request (* Werte aus *) + THEN gen scales; + plot one page + FI +END PROC b end of program; + +PROC b plot (REAL CONST r) : + IF plt (* Wenn genuegend PLOT-Werte gepuffert *) + THEN get extreme value; (* sind, wird eine neue Seite gedruckt *) + add (r); + IF param no = plot param no AND line no = value pagelength + THEN gen scales; + plot one page; + value no := nil; + line no := nil + FI + FI. + + get extreme value : + (* Sucht Maximal bzw. Minimalwert, falls keine festen Skalierungs- *) + (* grenzen angegeben wurden (im Quellprogramm)*) + param no INCR 1; + INT VAR act pointer := plot param (param no).scalepointer; + set lower bound; + set upper bound. + + set lower bound : + IF NOT plot param (act pointer).l fixed scale AND + r < plot param (act pointer).lower bound + THEN plot param (act pointer).lower bound := r + FI. + + set upper bound : + IF NOT plot param (act pointer).u fixed scale AND + r > plot param (act pointer).upper bound + THEN plot param (act pointer).upper bound := r + FI. +END PROC b plot; + +PROC add (REAL CONST r) : (* Puffert PLOT-Werte *) + value no INCR 1; + value (value no) := r +END PROC add; + +END PACKET dynamo plotter; + + + + -- cgit v1.2.3