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
|
PACKET plotten spool DEFINES plot: #Autor: H.Indenbirken #
#Stand: 10.02.1985 #
LET draw key = 1,
move key = 2,
text key = 3,
move r key = 4,
draw r key = 5,
move cm key = 6,
draw cm key = 7,
move cm r key = 8,
draw cm r key = 9,
bar key = 10,
circle key = 11,
max length = 32000;
TYPE PICTURE = STRUCT (INT dim, pen, TEXT points);
INT VAR i, read pos, key;
REAL VAR x, y, z;
TEXT VAR t;
PROC plot (PICTURE CONST p) :
INT CONST pic length := length (p.points);
read pos := 0;
IF p.dim = 2
THEN plot two dim pic
ELSE plot three dim pic FI .
plot two dim pic:
WHILE read pos < pic length
REP plot two dim position PER .
plot two dim position :
read pos INCR 1;
SELECT code (p.points SUB read pos) OF
CASE draw key : draw (next real, next real)
CASE move key : move (next real, next real)
CASE move r key : move r (next real, next real)
CASE draw r key : draw r (next real, next real)
CASE move cm key : move cm (next real, next real)
CASE draw cm key : draw cm (next real, next real)
CASE move cm r key : move cm r (next real, next real)
CASE draw cm r key : draw cm r (next real, next real)
CASE text key : draw (next text, next real, next real, next real)
CASE bar key : bar (next real, next real, next int)
CASE circle key : circle (next real, next real, next real, next int)
OTHERWISE errorstop ("wrong key code") END SELECT .
plot three dim pic:
WHILE read pos < pic length
REP plot three dim position PER .
plot three dim position :
read pos INCR 1;
SELECT code (p.points SUB read pos) OF
CASE draw key : draw (next real, next real, next real)
CASE move key : move (next real, next real, next real)
CASE move r key : move r (next real, next real, next real)
CASE draw r key : draw r (next real, next real, next real)
CASE move cm key : move cm (next real, next real)
CASE draw cm key : draw cm (next real, next real)
CASE move cm r key : move cm r (next real, next real)
CASE draw cm r key : draw cm r (next real, next real)
CASE text key : draw (next text, next real, next real, next real)
CASE bar key : bar (next real, next real, next int)
CASE circle key : circle (next real, next real, next real, next int)
OTHERWISE errorstop ("wrong key code") END SELECT .
next real :
read pos INCR 8;
subtext (p.points, read pos-7, read pos) RSUB 1 .
next int :
read pos INCR 2;
subtext (p.points, read pos-1, read pos) ISUB 1 .
next text :
INT CONST text length :: next int;
read pos INCR text length;
subtext (p.points, read pos-text length+1, read pos) .
END PROC plot;
LET max pics = 1024,
pic dataspace = 1102;
TYPE PICFILE = BOUND STRUCT (INT size, pos, background,
ROW 16 ROW 3 INT pens,
ROW 16 BOOL hidden,
ROW 3 ROW 2 REAL sizes,
ROW 2 ROW 2 REAL limits,
ROW 4 REAL angles,
ROW 2 REAL obliques,
ROW 3 REAL perspectives
ROW max pics PICTURE pic);
PICFILE VAR p;
PROC plot (DATASPACE VAR ds):
IF type (ds) = pic dataspace
THEN CONCR (p) :: old (ds);
plot (p)
ELSE errorstop ("Dataspace is no PICFILE") FI;
END PROC plot;
PROC plot (PICFILE VAR p) :
set values (p.sizes, p.limits, p.angles, p.obliques,
p.perspectives);
begin plot;
clear;
FOR i FROM 1 UPTO p.size
REP IF pen (p.pic [i]) <> 0
THEN plot pic FI
PER;
end plot .
plot pic:
pen (p.background, p.pens (pen (p.pic (i)))(1),
p.pens (pen (p.pic (i)))(2), p.pens (pen (p.pic (i)))(3));
hidden lines (p.hidden [pen (p.pic [i])]);
plot (p.pic (i)) .
END PROC plot;
END PACKET plotten spool
|
