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
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
|
# Stand : 26.Juni 1985 #
PACKET videostar plot DEFINES drawing area,
begin plot,
end plot,
clear,
background,
foreground,
thickness,
linetype,
move,
draw,
marker,
range,
clipping:
LET begin vector = ""16"";
LET max x = 679,
max y = 479; (* Direkt-Adressierung *)
LET POS = STRUCT (INT x, y);
POS VAR pos :: POS : (0, 0);
INT VAR akt pen :: 1, akt pen line type :: 1;
BOOL VAR check :: TRUE;
INT VAR thick :: 0, i, x min :: 0, x max :: 679, y min :: 0, y max :: 479;
TEXT VAR old pos :: "";
PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) :
x cm := 27.0 ; y cm := 20.00;
x pixel := 679; y pixel := 479
END PROC drawing area;
PROC range (INT CONST h min, h max, v min, v max):
x min := h min; x max := h max;
y min := v min; y max := v max
END PROC range;
PROC clipping (BOOL CONST flag):
check := flag
END PROC clipping;
BOOL PROC clipping:
check
END PROC clipping;
PROC begin plot :
ENDPROC begin plot ;
PROC end plot :
out (""27"0@")
ENDPROC end plot ;
PROC clear :
write (""29""27""140""27"/0d"24"")
END PROC clear;
PROC background (INT CONST desired, INT VAR realized):
realized := 0 (*Nur schwarzer Hintergrund mglich *)
END PROC background;
PROC foreground (INT CONST desired, INT VAR realized):
akt pen := desired;
realized := sign (desired) . (*Nur weier Sift mglich, aber *)
(*lschend, ndernd oder berschreibend *)
END PROC foreground;
PROC thickness (INT CONST desired, INT VAR realized):
thick := desired DIV 10;
realized := thick*2+1 (*Breite des Stiftes in Pixel *)
END PROC thickness;
PROC linetype (INT CONST desired, INT VAR realized):
IF desired <> akt pen linetype
THEN write (""29"") ; # Graphicmode on #
akt pen line type := desired;
write (type cmd);
write (""27"x"24"")
FI;
IF desired >= 0 AND desired <= 5
THEN realized := desired
ELSE realized := 0 FI .
type cmd:
SELECT desired OF
CASE 1 : ""27"/a" # durchgngige Linie #
CASE 2 : ""27"/1;1a" # gepunktet #
CASE 3 : ""27"/3;3a" # kurz gestrichelt #
CASE 4 : ""27"/6;6a" # lang gestrichelt #
CASE 5 : ""27"/6;3;1;3a" # Strichpunkt #
OTHERWISE ""27"/a" END SELECT
END PROC linetype;
PROC move (INT CONST x, y) :
x MOVE y;
pos := POS:(x, y) .
END PROC move;
PROC draw (INT CONST x, y):
IF std thickness
THEN draw (pos.x, pos.y, x, y)
ELIF is point
THEN point (x, y, thick);
x MOVE y;
ELIF is horizontal line
THEN horizontal line (pos.x, pos.y, x, y, thick);
x MOVE y;
ELSE vertical line (pos.x, pos.y, x, y, thick);
x MOVE y
FI;
pos := POS:(x, y) .
std thickness:
thick = 0 .
is point:
pos.x = x AND pos.y = y .
is horizontal line:
abs (pos.x-x) >= abs (pos.y-y) .
END PROC draw;
PROC point (INT CONST x, y, thick):
INT VAR i;
FOR i FROM -thick UPTO thick
REP line (x-thick, y+i, x+thick, y+i) PER
END PROC point;
PROC horizontal line (INT CONST from x, from y, to x, to y, thick):
IF from x > to x
THEN horizontal line (to x, to y, from x, from y, thick)
ELSE draw line FI .
draw line:
INT VAR i;
calculate increase;
calculate limit points;
FOR i FROM -thick UPTO thick
REP calculate delta x;
line (x start+delta x, y start+i, x end+delta x, y end+i)
PER .
calculate increase:
REAL VAR increase :: -dy / dx .
calculate limit points:
INT CONST x start :: from x - thick,
x end :: to x + thick,
y start :: from y + int (increase * real (thick)),
y end :: to y - int (increase * real (thick)) .
calculate delta x:
INT CONST delta x :: int (increase*real (i)) .
dx: real (to x-from x) .
dy: real (to y-from y) .
END PROC horizontal line;
PROC vertical line (INT CONST from x, from y, to x, to y, thick):
IF from y > to y
THEN vertical line (to x, to y, from x, from y, thick)
ELSE draw line FI .
draw line:
INT VAR i;
calculate increase;
calculate limit points;
FOR i FROM -thick UPTO thick
REP calculate delta y;
line (x start+i, y start+delta y, x end+i, y end+delta y)
PER .
calculate increase:
REAL VAR increase :: -dx / dy .
calculate limit points:
INT CONST x start :: from x + int (increase * real (thick)),
x end :: to x - int (increase * real (thick)),
y start :: from y - thick,
y end :: to y + thick .
calculate delta y:
INT CONST delta y :: int (increase*real (i)) .
dx: real (to x-from x) .
dy: real (to y-from y) .
END PROC vertical line;
PROC marker (INT CONST x, y, no, size):
IF no = 0
THEN draw cursor FI;
pos.x MOVE pos.y .
draw cursor:
write(""29""27"/f"27""26"") .
END PROC marker;
PROC line (INT CONST from x, from y, to x, to y):
from x MOVE from y;
draw (from x, from y, to x, to y)
END PROC line;
PROC draw (INT CONST from x, from y, to x, to y):
IF check
THEN draw with clipping
ELSE to x DRAW to y FI .
draw with clipping:
INT VAR x, y;
calculate parts of line;
IF both points inside
THEN to x DRAW to y
ELIF both points outside
THEN
ELIF first point outside
THEN intersection (to x, to y, to part, from x, from y, from part, x, y);
x MOVE y;
to x DRAW to y
ELIF second point outside
THEN intersection (from x, from y, from part, to x, to y, to part, x, y);
x DRAW y
ELSE check intersection FI .
calculate parts of line:
INT CONST from part :: part (from x, from y),
to part :: part (to x, to y) .
both points inside:
from part = 0 AND to part = 0 .
both points outside:
(from part AND to part) <> 0 .
first point outside:
from part <> 0 AND to part = 0 .
second point outside:
to part <> 0 AND from part = 0 .
check intersection:
intersection (to x, to y, to part, from x, from y, from part, x, y);
x MOVE y;
draw (x, y, to x, to y) .
END PROC draw;
INT PROC part (INT CONST x, y):
INT VAR index :: 0;
IF x > x max
THEN set bit (index, 0)
ELIF x < x min
THEN set bit (index, 1) FI;
IF y > y max
THEN set bit (index, 2)
ELIF y < y min
THEN set bit (index, 3) FI;
index
END PROC part;
PROC intersection (INT CONST from x, from y, from part, to x, to y, to part,
INT VAR x, y):
SELECT to part OF
CASE 1: right side
CASE 2: left side
CASE 4: up side
CASE 5: upright side
CASE 6: upleft side
CASE 8: down side
CASE 9: downright side
CASE 10: downleft side
OTHERWISE errorstop ("wrong partno.:" + text (to part)) ENDSELECT .
right side:
y := from y + int (real (x max-from x)*(dy/dx));
x := x max .
left side:
y := from y + int (real (x min-from x)*(dy/dx));
x := x min .
up side:
x := from x + int (real (y max-from y)*(dx/dy));
y := y max .
down side:
x := from x + int (real (y min-from y)*(dx/dy));
y := y min .
upright side:
right side;
IF y > y max
THEN up side FI .
downright side:
right side;
IF y < y min
THEN down side FI .
upleft side:
left side;
IF y > y max
THEN up side FI .
downleft side:
left side;
IF y < y min
THEN down side FI .
dx: real (to x-from x) .
dy: real (to y-from y) .
END PROC intersection;
PROC draw (TEXT CONST text, REAL CONST angle, height, thick) :
INT CONST hoehe :: int(height);
IF akt pen linetype <> 0
THEN write (""29"");
write (old pos);
write (""31"");
write (size);
write (text);
write(""24"")
FI .
size:
SELECT hoehe OF
CASE 1 : ""27"4"
CASE 2 : ""27"5"
CASE 3 : ""27"0"
CASE 4 : ""27"1"
CASE 5 : ""27"2"
CASE 6 : ""27"3"
OTHERWISE ""27"0" END SELECT . # Gre 3 fr undefinierte Werte #
END PROC draw;
PROC draw (TEXT CONST record) :
draw (record, 0.0, 0.0, 0.0)
END PROC draw;
OP MOVE (INT CONST x, y) :
write (""29"");
old pos := koordinaten (x,y);
write (old pos);
write (""24"");
END OP MOVE;
OP DRAW (INT CONST x, y) :
IF akt pen line type = 0
THEN x MOVE y
ELSE write (""29""); (* plot ein *)
write (colour cmd);
write (old pos);
old pos := koordinaten (x,y);
write (old pos);
write (""24""); (* plot aus *)
FI .
colour cmd:
IF akt pen = 0 THEN ""27"/1d" # lschend #
ELIF akt pen < 0 THEN ""27"/2d" # XOR #
ELSE ""27"/0" # normal #
FI .
END OP DRAW;
TEXT PROC koordinaten (INT CONST x,y):
code(32+((y DIV 32) AND 31)) + code(96+(y MOD 32)) +
code(32+((x DIV 32) AND 31)) + code(64+(x MOD 32))
END PROC koordinaten;
END PACKET videostar plot
|
