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
|
(* ------------------- VERSION 4 22.04.86 ------------------- *)
PACKET konfigurieren DEFINES (* Autor: D.Heinrichs *)
ansi cursor,
baudrate ,
bits ,
cursor logic ,
elbit cursor ,
enter incode ,
enter outcode ,
flow ,
input buffer size ,
link ,
new configuration ,
new type ,
ysize :
LET max dtype nr = 5, (* maximum number of active device tables *)
device table = 32000,
ack = 0 ;
INT VAR next outstring,
next instring;
BOUND STRUCT (ALIGN space, (* umsetzcodetabelle *)
ROW 128 INT outcodes,
ROW 64 INT outstrings,
ROW 64 INT instrings) VAR x;
ROW max dtype nr DATASPACE VAR device code table;
THESAURUS VAR dtypes ;
PROC new configuration :
dtypes := empty thesaurus ;
INT VAR i ;
insert (dtypes, "psi", i) ;
insert (dtypes, "transparent", i) ;
FOR i FROM 1 UPTO max dtype nr REP
forget (device code table (i))
PER .
ENDPROC new configuration ;
PROC block out (DATASPACE CONST ds, INT CONST page, code):
INT VAR err;
block out (ds,page,0,code,err);
announce error (err)
END PROC block out;
PROC announce error (INT CONST err):
SELECT err OF
CASE 0:
CASE 1: errorstop ("unbekanntes Terminalkommando")
CASE 2: errorstop ("Nummer der Terminal-Typ-Tabelle falsch")
CASE 3: errorstop ("falsche Terminalnummer")
OTHERWISE errorstop ("blockout: unzulaessiger Kanal")
ENDSELECT
END PROC announce error;
PROC flow (INT CONST nr, INT CONST dtype):
control (6, dtype, nr)
END PROC flow;
PROC ysize (INT CONST channel ,new size, INT VAR old size) :
control (11, channel, new size, old size)
ENDPROC ysize ;
PROC input buffer size (INT CONST nr,size):
INT VAR err;
control (2,nr,size,err)
END PROC input buffer size;
PROC baudrate (INT CONST nr, rate) :
control (8, rate, nr)
ENDPROC baudrate ;
PROC bits (INT CONST channel, number, parity) :
bits (channel, number-1 + 8*parity)
ENDPROC bits ;
PROC bits (INT CONST channel, key) :
control (9, key, channel)
ENDPROC bits ;
PROC control (INT CONST function, key, channel) :
INT VAR err ;
IF key > -128 AND key < 127
THEN control (function, channel, key, err)
ELIF key = -128
THEN control (function, channel, -maxint-1, err)
FI
ENDPROC control ;
PROC new type (TEXT CONST dtype):
x := new (dtype);
type (old (dtype), device table);
next outstring := 4;
next instring := 0;
INT VAR i;
(* Defaults, damit trmpret den cursor mitfuehrt: *)
FOR i FROM 1 UPTO 6 REP
enter outcode (i,i)
PER;
enter outcode (8,8);
enter outcode (10,10);
enter outcode (13,13);
enter outcode (14,126);
enter outcode (15,126);
END PROC new type;
INT PROC activate dtype (TEXT CONST dtype):
INT VAR i := link (dtypes, dtype);
IF (exists (dtype) CAND type (old (dtype)) = device table)
THEN IF i <= 0
THEN insert (dtypes, dtype, i);
FI;
forget(device code table (i-2));
device code table (i-2) := old (dtype)
FI;
IF i > max dtype nr +2 (* 5 neue Typen erlaubt *)
THEN delete (dtypes,i);
error stop ("Anzahl Terminaltypen > "+text (i));0
ELIF i <= 0
THEN error stop ("Unbekannter Terminaltyp" + dtype); 0
ELSE i
FI.
END PROC activate dtype;
PROC link (INT CONST nr, TEXT CONST dtype):
INT VAR lst nr := activate dtype (dtype)-3;
IF lst nr < 0
THEN lst nr INCR 256 (* fuer std terminal und std device *)
ELSE blockout (device code table(lst nr+1), 2, lst nr);
FI;
INT VAR err := 0;
control (1,nr,lst nr,err) ;
announce error(err)
END PROC link;
PROC enter outcode (INT CONST eumel code, ziel code):
IF ziel code < 128
THEN simple entry (eumel code, ziel code)
ELSE enter outcode (eumel code, 0, code (ziel code))
FI .
ENDPROC enter outcode ;
PROC simple entry (INT CONST eumel code, ziel code) :
INT CONST position := eumel code DIV 2 +1,
teil := eumel code - 2*position + 2;
TEXT VAR h :=" ";
replace (h,1,out word);
replace (h,1+teil,code (ziel code));
out word := (h ISUB 1).
out word: x.outcodes (position).
END PROC simple entry ;
PROC enter outcode (INT CONST eumel code, wartezeit,
TEXT CONST sequenz):
INT VAR i;
simple entry (eumel code, next outstring + 128);
enter part (x.outstrings, next outstring, wartezeit);
FOR i FROM 1 UPTO length (sequenz) REP
enter part (x.outstrings, next outstring + i, code (sequenzSUBi))
PER;
next outstring INCR length (sequenz)+2;
abschluss.
abschluss:
enter part (x.outstrings, next outstring-1, 0)
END PROC enter outcode;
PROC enter outcode (INT CONST eumelcode, TEXT CONST wert):
enter outcode (eumelcode,code(wert))
END PROC enter outcode;
PROC enter part (ROW 64 INT VAR a,INT CONST index, wert):
INT CONST position := index DIV 2 +1,
teil := index - 2*position + 2;
IF position > 64 THEN errorstop ("Ueberlauf der Terminaltyptabelle") FI;
TEXT VAR h :=" ";
replace (h,1,out word);
replace (h,1+teil,code (wert));
out word := (h ISUB 1).
out word: a (position).
END PROC enter part;
PROC enter incode (INT CONST elan code, TEXT CONST sequenz):
IF elan code > 254 OR elan code < 0 THEN errorstop ("kein Eingabecode")
ELSE
INT VAR i;
enter part (x.instrings, next instring, elan code);
FOR i FROM 1 UPTO length (sequenz) REP
enter part (x.instrings, next instring + i, code (sequenzSUBi))
PER;
next instring INCR length (sequenz)+2;
FI
END PROC enter incode;
PROC cursor logic (INT CONST dist, TEXT CONST pre, mid, post):
cursor logic (dist,255,pre,mid,post)
END PROC cursor logic;
PROC ansi cursor (TEXT CONST pre, mid, post):
cursor logic (0, 1, pre, mid, post)
END PROC ansi cursor;
PROC cursor logic (INT CONST dist, modus, TEXT CONST pre, mid, post):
enter part (x.outstrings,2,dist);
enter part (x.outstrings,3,dist);
enter part (x.outstrings,0,modus);
enter part (x.outstrings,1,modus);
enter outcode (6,0,pre+""0"y"+mid+""0"x"+post+""0"")
END PROC cursor logic;
PROC elbit cursor:
cursor logic (0,""27"","","");
enter part (x.outstrings,0,2);
enter part (x.outstrings,1,255);
END PROC elbit cursor;
ENDPACKET konfigurieren;
|
