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
|
(* Typtabellengenerierungsprogramm, Stand : 26.11.85 *)
page ;
putline ("- Erzeugen einer .gen Datei aus einer Typtabelle -") ;
line ;
BOUND STRUCT (INT maxx, maxy,
ROW 248 INT align,
ROW 128 INT outcodes,
ROW 128 INT instrings,
ROW 128 INT outstrings) VAR x ;
TEXT VAR t , filename ;
INT VAR i , laenge , position , eumel code ;
FILE VAR f ;
put ("Name der Tabelle:") ;
getline (t) ;
IF exists (t+".gen") THEN forget (t+".gen") FI ;
IF exists (t+".gen")
THEN filename := t + ".new.gen"
ELSE filename := t + ".gen"
FI ;
f := sequentialfile (output, filename) ;
putline (f, "(" + 49 * "*" + ")") ;
putline (f, "(* Typtabelle : " + text (t, 30) + " *)") ;
putline (f, "(* Generiert am : " + text (date, 30) + " *)") ;
putline (f, "(* Version/Typ : " + text ("1.8.2/32001", 30) + " *)") ;
putline (f, "(" + 49 * "*" + ")") ;
line (f) ;
putline (f, "forget (""" + t + """, quiet) ;") ;
putline (f, "new type (""" + t + """) ;") ;
line (f) ;
x := old (t, 32001) ;
putline (f, "enter xsize ("+text (x.maxx)+") ;") ;
putline (f, "enter ysize ("+text (x.maxy)+") ;") ;
t := " " ;
IF (x.outstrings (1) AND 255) = 2
THEN putline (f, "elbit cursor ;") ;
line (f) ;
ELSE write (f, "cursor logic (") ;
position := x.outstrings(2) ;
put (f, text (position AND 255) + ",") ;
position := (x.outcodes (4) AND 127) * 8+1 ;
put (f, denoter (x.outstrings, position, 0) + ",") ;
position INCR (laenge + 2) ;
put (f, denoter (x.outstrings, position, 0) + ",") ;
position INCR (laenge + 2) ;
putline (f, denoter (x.outstrings, position, 0) + ") ;") ;
line (f)
FI ;
putline (f, "(* Ausgabe Codes : *)") ;
FOR i FROM 1 UPTO 128 REP
cout (lineno (f)) ;
replace (t, 1, x.outcodes (i)) ;
IF i <> 4
THEN IF code (t SUB 1) <> 255
THEN eumel code := (i-1) * 2 ;
put (f, "enter outcode (" + text (eumel code, 3) + ",") ;
IF code (t SUB 1) > 127
THEN outstring ((code (t SUB 1)-128)*8)
ELSE numberput (code (t SUB 1))
FI ;
line (f)
FI
FI ;
IF code (t SUB 2) <> 255
THEN eumel code := (i-1) * 2 + 1 ;
put (f, "enter outcode (" + text (eumel code, 3) + ",") ;
IF code (t SUB 2) > 127
THEN outstring ((code (t SUB 2)-128)*8)
ELSE numberput (code (t SUB 2))
FI ;
line (f)
FI ;
PER ;
line (f) ;
line (f) ;
putline (f, "(* Eingabe Codes : *)") ;
i := 0 ;
WHILE i < 256 CAND incode (i) <> 255 REP
cout (lineno (f)) ;
eumel code := incode (i) ;
put (f, "enter incode (" + text (eumel code,3) + ",") ;
write (f, denoter (x.instrings, i + 1, 255)) ;
put (f, ") ; (*") ;
i INCR 1 ;
IF in bezeichnung (eumel code) <> ""
THEN put (f, in bezeichnung (eumel code) + ":")
FI ;
WHILE i < 256 CAND incode (i) <> 255 REP
charput (incode (i)) ;
i INCR 1
PER ;
i INCR 1 ;
putline (f, "*)")
PER ;
edit (filename) ;
INT PROC incode (INT CONST element) :
TEXT VAR t := " " ;
replace (t, 1, x.instrings (element DIV 2 + 1));
IF (element MOD 2) = 0 THEN code (t SUB 1)
ELSE code (t SUB 2)
FI
ENDPROC incode ;
TEXT PROC in bezeichnung (INT CONST code) :
SELECT code OF
CASE 1 : "HOP "
CASE 2 : "Cursor right"
CASE 3 : "Cursor up "
CASE 4 : "Info "
CASE 7 : "SV - Call "
CASE 8 : "Cursor left "
CASE 9 : "TAB "
CASE 10: "Cursor down "
CASE 11: "RUBIN "
CASE 12: "RUBOUT "
CASE 13: "CR "
CASE 16: "MARK "
CASE 17: "Stop "
CASE 18: "Insert line "
CASE 23: "Weiter "
CASE 27: "Escape "
CASE 214:"ae-Taste "
CASE 215:"oe-Taste "
CASE 216:"ue-Taste "
CASE 217:"Ae-Taste "
CASE 218:"Oe-Taste "
CASE 219:"Ue-Taste "
CASE 220:"Trenn-k "
CASE 221:"Trennstrich "
CASE 222:"Fest-# "
CASE 223:"Fest-Blank "
CASE 251:"sz-Taste "
OTHERWISE IF code < 32 THEN "Funct.-Taste"
ELSE ""
FI
ENDSELECT
ENDPROC in bezeichnung ;
TEXT PROC out bezeichnung (INT CONST code) :
SELECT code OF
CASE 1 : "Cursor Home "
CASE 2 : "Cursor right"
CASE 3 : "Cursor up "
CASE 4 : "CLEOP "
CASE 5 : "CLEOL "
CASE 6 : "Cursor (YX) "
CASE 7 : "Beep "
CASE 8 : "Cursor left "
CASE 10: "Cursor down "
CASE 13: "CR "
CASE 14: "END MARK "
CASE 15: "BEGIN MARK "
CASE 214:"ae "
CASE 215:"oe "
CASE 216:"ue "
CASE 217:"Ae "
CASE 218:"Oe "
CASE 219:"Ue "
CASE 220:"Trenn-k "
CASE 221:"Trennstrich "
CASE 222:"Fest-# "
CASE 223:"Fest-Blank "
CASE 251:"sz "
OTHERWISE ""
ENDSELECT
ENDPROC out bezeichnung ;
PROC charput (INT CONST nr) :
IF nr = 27 THEN put (f, "<ESC>")
ELIF nr = 10 THEN put (f, "<LF>")
ELIF nr = 13 THEN put (f, "<CR>")
ELIF nr = 32 THEN put (f, "<SPACE>")
ELIF nr = 127 THEN put (f, "<DEL>")
ELIF nr > 127 THEN put (f, "<" + text (nr) + ">")
ELIF nr > 32 THEN put (f, code (nr))
ELSE put (f, "<CTRL-" + code (nr+64) + ">")
FI
ENDPROC charput ;
PROC numberput (INT CONST nr) :
put (f, text (nr,3 ) + ") ; (*") ;
IF out bezeichnung (eumel code) <> ""
THEN put (f, out bezeichnung (eumel code) + ":")
FI ;
charput (nr) ;
put (f, "*)") ;
ENDPROC numberput ;
TEXT PROC denoter (ROW 128 INT VAR y, INT CONST pos, ende) :
INT VAR i := pos ;
TEXT VAR t := " " , zeile := """" ;
laenge := 0 ;
WHILE i < 256 AND zugriff <> ende REP
IF zugriff > 31 AND zugriff < 127 THEN zeile CAT code (zugriff)
ELIF zugriff = 34 THEN zeile CAT """"""
ELIF zugriff = 251 THEN zeile CAT "ß"
ELIF zugriff > 216 AND zugriff < 224 THEN zeile CAT code (zugriff)
ELSE zeile CAT """" ;
zeile CAT text (zugriff) ;
zeile CAT """"
FI ;
i INCR 1 ;
laenge INCR 1
PER ;
zeile CAT """" ;
zeile.
zugriff :
replace (t, 1, y (i DIV 2 + 1)) ;
IF (i MOD 2) = 0 THEN code (t SUB 1)
ELSE code (t SUB 2)
FI
ENDPROC denoter ;
PROC outstring (INT CONST element) :
INT VAR i := element ;
put (f, text (zugriff) + ",") ;
put (f, denoter (x.outstrings, i + 1, 0) + ") ; (*") ;
IF out bezeichnung (eumel code) <> ""
THEN put (f, out bezeichnung (eumel code) + ":")
FI ;
i INCR 1 ;
WHILE zugriff <> 0 REP
charput (zugriff) ;
i INCR 1
PER ;
put (f, "*)") .
zugriff :
TEXT VAR t := " " ;
replace (t, 1, x.outstrings (i DIV 2 + 1)) ;
IF (i MOD 2) = 0 THEN code (t SUB 1)
ELSE code (t SUB 2)
FI
ENDPROC outstring
|
