summaryrefslogtreecommitdiff
path: root/lang/dynamo/1.8.7/src/dyn.plot
blob: fe1228aa4806ac1f4bb7a72ef721f920f753ca0c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
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;