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
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
PACKET matrix plot DEFINES drawing area,
begin plot,
end plot,
clear,
pen,
move,
draw,
get cursor,
zeichensatz,
reset,
SCREEN, :=,
get screen, put screen:
LET max x = 511, {Bildschirm : 1-512 x 1-256}
max x plus 1 = 512,
max y = 255,
hor faktor = 22.21739, {***** x pixel / x cm *****}
vert faktor = 18.61314, {***** y pixel / y cm *****}
delete = 0, {Farbcodes}
std = 1,
black = 5,
white = 6,
durchgehend = 1, {Linientypen}
gepunktet = 2,
kurz gestrichelt = 3,
lang gestrichelt = 4,
strichpunkt = 5;
LET PEN = STRUCT (INT back, fore, thick, line, BOOL hidden, action);
LET POS = STRUCT (INT x, y);
TYPE SCREEN = ROW 32 ROW 256 INT;
LET ZEICHENSATZ = STRUCT (ROW 255 TEXT char, INT width, height);
ROW max x plus 1 INT VAR akt maxima, last maxima;
ZEICHENSATZ VAR zeichen;
SCREEN VAR screen;
PEN VAR stift :: PEN : (black, white, 0, durchgehend, FALSE, TRUE);
POS VAR pos :: POS : (0, 0), start, delta;
INT VAR i, n, diff, up right error, right error, old error,
pattern pos :: 0, line pattern :: -1;
BOOL VAR bit set :: TRUE;
reset;
zeichensatz ("STD Zeichensatz");
clear (screen);
PROC reset:
FOR i FROM 1 UPTO 512
REP last maxima [i] := -1;
akt maxima [i] := -1
PER
END PROC reset;
PROC zeichensatz (TEXT CONST name):
IF exists (name)
THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);
zeichen := new zeichen
ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI
END PROC zeichensatz;
PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) :
x cm := 23.0; y cm := 13.7; {***** Horizontale und vertikale *****}
{***** Gre in Zentimetern. *****}
x pixel := 511; y pixel := 255 {***** Koordinaten des rechten *****}
{***** oberen Punktes. *****}
END PROC drawing area;
PROC begin plot :
ENDPROC begin plot ;
PROC end plot :
ENDPROC end plot ;
PROC clear :
stift := PEN : (black, white, 0, durchgehend, FALSE, TRUE);
pos := POS : (0, 0);
(* Lschen der Hiddenmaxima *);
reset;
(* Ausgabe der Bildmatrix auf dem Endgert *);
put screen;
(* Lschen der Bildmatrix *);
clear (screen)
END PROC clear;
PROC pen (INT CONST background, foreground, thickness, linetype):
set linetype;
stift := PEN : (background, foreground,thickness, linetype,
linetype <> 0, thickness < 0) .
set linetype:
pattern pos := 0;
SELECT linetype OF
CASE durchgehend : stift.line := -1
CASE gepunktet : stift.line := 21845
CASE kurz gestrichelt : stift.line := 3855
CASE lang gestrichelt : stift.line := 255
CASE strichpunkt : stift.line := 4351
OTHERWISE stift.line := linetype END SELECT;
END PROC pen;
PROC move (INT CONST x, y) :
pattern pos := 0;
IF stift.hidden
THEN last maxima := akt maxima FI;
pos := POS : (x, y)
END PROC move;
PROC draw (INT CONST x, y) :
IF stift.action
THEN IF stift.thick > 1
THEN draw thick vektor
ELSE vector (x-pos.x, y-pos.y) FI
FI;
pos := POS : (x, y) .
draw thick vektor:
INT CONST old pattern pos := pattern pos;
check direction;
FOR diff FROM -stift.thick UPTO stift.thick
REP draw single vektor PER .
check direction :
BOOL CONST x direction := abs (x-pos.x) > abs (y-pos.y);
IF x direction
THEN start := POS : (pos.x+stift.thick * sign (pos.x-x), pos.y);
delta := POS : (x+stift.thick * sign (x-pos.x)-pos.x, y-pos.y)
ELSE start := POS : (pos.x, pos.y+stift.thick * sign (pos.y-y));
delta := POS : (x-pos.x, y+stift.thick * sign (y-pos.y)-pos.y);
FI .
draw single vektor :
pattern pos := old pattern pos;
IF x direction
THEN pos := POS : (start.x, start.y+diff);
vector (delta.x, delta.y+diff)
ELSE pos := POS : (start.x+diff, start.y+diff);
vector (delta.x+diff, delta.y)
FI .
END PROC draw;
PROC vector (INT CONST dx , dy) :
IF dx >= 0
THEN IF dy > dx THEN vector (pos.y, pos.x, dy, dx, 1, 1)
ELIF dy > 0 THEN vector (pos.x, pos.y, dx, dy, 1, 1)
ELIF dy > -dx THEN vector (pos.x, pos.y, dx, -dy, 1,-1)
ELSE vector (pos.y, pos.x, -dy, dx,-1, 1) FI
ELSE IF dy > -dx THEN vector (pos.y, pos.x, dy, -dx, 1,-1)
ELIF dy > 0 THEN vector (pos.x, pos.y, -dx, dy,-1, 1)
ELIF dy > dx THEN vector (pos.x, pos.y, -dx, -dy,-1,-1)
ELSE vector (pos.y, pos.x, -dy, -dx,-1,-1) FI
FI .
ENDPROC vector ;
PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) :
prepare first step ;
point;
FOR i FROM 1 UPTO dx
REP do one step PER .
prepare first step :
up right error := dy - dx;
right error := dy;
old error := 0 .
do one step:
IF right is better
THEN do right step
ELSE do up right step
FI .
right is better :
abs (old error + right error) < abs (old error + up right error) .
do upright step :
x pos INCR right ;
y pos INCR up ;
point ;
old error INCR upright error .
do right step :
x pos INCR right ;
point ;
old error INCR right error .
point :
IF visible (pos)
THEN SELECT (pos.x+1) MOD 16 OF
CASE 0: set bit (block [byte], 8)
CASE 1: set bit (block [byte], 7)
CASE 2: set bit (block [byte], 6)
CASE 3: set bit (block [byte], 5)
CASE 4: set bit (block [byte], 4)
CASE 5: set bit (block [byte], 3)
CASE 6: set bit (block [byte], 2)
CASE 7: set bit (block [byte], 1)
CASE 8: set bit (block [byte], 0)
CASE 9: set bit (block [byte], 15)
CASE 10: set bit (block [byte], 14)
CASE 11: set bit (block [byte], 13)
CASE 12: set bit (block [byte], 12)
CASE 13: set bit (block [byte], 11)
CASE 14: set bit (block [byte], 10)
CASE 15: set bit (block [byte], 9)
END SELECT;
FI .
block:
screen [(255-pos.y) DIV 8 + 1] .
byte:
pos.x DIV 16 + ((255-pos.y) AND 7) * 32 + 1 .
END PROC vector;
BOOL PROC visible (POS CONST pos) :
IF pos.x < 0 OR pos.x > max x OR pos.y < 0 OR pos.y > max y
THEN FALSE
ELSE pattern AND hidden FI .
pattern:
bit set := bit (line pattern, pattern pos);
pattern pos := (pattern pos+1) AND 15;
bit set .
hidden:
IF akt maxima [pos.x+1] < pos.y
THEN akt maxima [pos.x+1] := pos.y FI;
pos.y > last maxima [pos.x+1] .
END PROC visible;
PROC draw (TEXT CONST record, REAL CONST angle, height, width):
{**** Hier werden Texte mit dem Winkel 'angle',der Hhe 'height' und *****}
{**** der Breite 'width' gezeichnet. Falls die Hardware dieses *****}
{**** bereits ermglicht, so mssen die Variable 'zeichen' und die *****}
{**** Prozedur Zeichensatz gelscht werden. Der Datenraum *****}
{**** 'STD Zeichensatz' wird in diesem Fall nicht bentigt. *****}
BOOL CONST horizontal :: NOT (abs (angle) MOD 180.0 > 45.0 AND abs (angle) MOD 180.0 < 135.0);
INT CONST x fak :: character width, x step :: character x step,
y fak :: character height, y step :: character y step;
INT VAR x pos :: pos.x, y pos :: pos.y, i;
POS VAR old pos := pos;
FOR i FROM 1 UPTO length (record)
REP draw character i PER;
pos := old pos .
character width:
IF width <> 0.0
THEN int (hor faktor * width+0.5)
ELSE zeichen.width FI .
character x step:
IF horizontal
THEN IF width <> 0.0
THEN int (cosd (angle) * hor faktor * width+0.5)
ELSE int (cosd (angle) * real (zeichen.width)+0.5) FI
ELSE IF width <> 0.0
THEN int (cosd (angle) * vert faktor * width+0.5)
ELSE int (cosd (angle) * real (zeichen.height)+0.5) FI
FI .
character height:
IF height <> 0.0
THEN int (vert faktor * height+0.5)
ELSE zeichen.height FI .
character y step:
IF horizontal
THEN IF height <> 0.0
THEN int (sind (angle) * vert faktor * height+0.5)
ELSE int (sind (angle) * real (zeichen.height)+0.5) FI
ELSE IF height <> 0.0
THEN int (sind (angle) * hor faktor * height+0.5)
ELSE int (sind (angle) * real (zeichen.width)+0.5) FI
FI .
draw character i:
IF code (record SUB i) < 32
THEN steuerzeichen
ELSE normale zeichen FI .
steuerzeichen:
SELECT code (record SUB i) OF
CASE 7: out (""0""7""16"")
CASE 13: x pos := pos.x; y pos := pos.y
END SELECT .
normale zeichen:
TEXT CONST char :: zeichen.char [code (record SUB i)];
IF horizontal
THEN draw horizontal
ELSE draw vertical FI .
draw vertical:
n := 3;
IF char <> ""
THEN pos := POS : (((char ISUB 2)*y fak) DIV zeichen.height + x pos,
-((char ISUB 1)*x fak) DIV zeichen.width + y pos)
FI;
WHILE n <= length (char) DIV 2
REP IF (char ISUB n) < 0 OR (char ISUB n+1) < 0
THEN pos := POS : (((char ISUB n+1)*y fak) DIV zeichen.height + x pos,
-((char ISUB n )*x fak) DIV zeichen.width + y pos)
ELSE vector (-((char ISUB n+1)*y fak) DIV zeichen.height + x pos-pos.x,
((char ISUB n )*x fak) DIV zeichen.width + y pos-pos.y)
FI;
n INCR 2
PER;
x pos INCR x step;
y pos INCR y step .
draw horizontal:
n := 3;
IF char <> ""
THEN pos := POS : (-((char ISUB 1)*x fak) DIV zeichen.width + x pos,
-((char ISUB 2)*y fak) DIV zeichen.height + y pos)
FI;
WHILE n <= length (char) DIV 2
REP IF (char ISUB n) < 0 OR (char ISUB n+1) < 0
THEN pos := POS : (-((char ISUB n )*x fak) DIV zeichen.width + x pos,
-((char ISUB n+1)*y fak) DIV zeichen.height + y pos)
ELSE vector (((char ISUB n )*x fak) DIV zeichen.width + x pos-pos.x,
((char ISUB n+1)*y fak) DIV zeichen.height + y pos-pos.y)
FI;
n INCR 2
PER;
x pos INCR x step;
y pos INCR y step .
END PROC draw;
PROC draw (TEXT CONST record) :
draw (record, 0.0, 0.0, 0.0)
END PROC draw;
PROC get cursor (TEXT VAR t, INT VAR x, y) :
t := "";
x := 0;
y := 0
END PROC get cursor;
OP := (SCREEN VAR l, SCREEN CONST r):
CONCR (l) := CONCR (r)
END OP :=;
PROC get screen (TEXT CONST name):
IF exists (name)
THEN get screen (old (name))
ELSE get screen (new (name)) FI;
END PROC get screen;
PROC get screen (DATASPACE CONST ds):
BOUND SCREEN VAR ds screen :: ds;
ds screen := screen
END PROC get screen;
PROC get screen (SCREEN VAR ds screen):
ds screen := screen
END PROC get screen;
PROC get screen:
FOR i FROM 1 UPTO 32
REP block in (screen [i], -1, i-1, n) PER
END PROC get screen;
PROC put screen (TEXT CONST name):
IF exists (name)
THEN put screen (old (name))
ELSE errorstop ("Der Datenraum """ + name + """ existiert nicht") FI
END PROC put screen;
PROC put screen (DATASPACE CONST ds):
BOUND SCREEN VAR ds screen :: ds;
screen := ds screen;
put screen
END PROC put screen;
PROC put screen (SCREEN VAR ds screen):
screen := ds screen;
put screen
END PROC put screen;
PROC put screen:
FOR i FROM 1 UPTO 32
REP block out (screen [i], -1, i-1, n) PER
END PROC put screen;
PROC clear (SCREEN VAR screen):
FOR i FROM 1 UPTO 256
REP screen [1] [i] := 0 PER;
FOR i FROM 2 UPTO 32
REP screen [i] := screen [1] PER
END PROC clear;
END PACKET matrix plot;
|
