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
|
PACKET basic transput DEFINES
out ,
outsubtext ,
outtext ,
TIMESOUT ,
cout ,
display ,
inchar ,
incharety ,
cat input ,
pause ,
cursor ,
get cursor ,
channel ,
online ,
control ,
blockout ,
blockin :
LET channel field = 4 ,
blank times 64 =
" " ;
LET BLOCKIO = STRUCT (ALIGN page align, ROW 256 INT buffer) ,
buffer page = 2 ;
BOUND BLOCKIO VAR block io ;
DATASPACE VAR block io ds ;
INITFLAG VAR this packet := FALSE ;
PROC out (TEXT CONST text ) :
EXTERNAL 60
ENDPROC out ;
PROC outsubtext ( TEXT CONST source, INT CONST from ) :
EXTERNAL 62
END PROC outsubtext;
PROC outsubtext (TEXT CONST source, INT CONST from, to) :
EXTERNAL 63
END PROC outsubtext;
PROC outtext ( TEXT CONST source, INT CONST from, to ) :
out subtext (source, from, to) ;
INT VAR trailing ;
IF from <= LENGTH source
THEN trailing := to - LENGTH source
ELSE trailing := to + 1 - from
FI ;
IF trailing > 0
THEN trailing TIMESOUT " "
FI
ENDPROC outtext ;
OP TIMESOUT (INT CONST times, TEXT CONST text) :
IF text = " "
THEN fast timesout blank
ELSE timesout
FI .
fast timesout blank :
INT VAR i := 0 ;
WHILE i + 64 < times REP
out (blank times 64) ;
i INCR 64
PER ;
outsubtext (blank times 64, 1, times - i) .
timesout :
FOR i FROM 1 UPTO times REP
out(text)
ENDREP .
ENDOP TIMESOUT ;
PROC display (TEXT CONST text) :
IF online
THEN out (text)
FI
ENDPROC display ;
PROC inchar (TEXT VAR character ) :
EXTERNAL 64
ENDPROC inchar ;
TEXT PROC incharety :
EXTERNAL 65
END PROC incharety ;
TEXT PROC incharety (INT CONST time limit) :
internal pause (time limit) ;
incharety
ENDPROC incharety ;
PROC pause (INT CONST time limit) :
internal pause (time limit) ;
TEXT CONST dummy := incharety
ENDPROC pause ;
PROC pause :
TEXT VAR dummy; inchar (dummy)
ENDPROC pause ;
PROC internal pause (INT CONST time limit) :
EXTERNAL 66
ENDPROC internal pause ;
PROC cat input (TEXT VAR t, esc char) :
EXTERNAL 68
ENDPROC cat input ;
PROC cursor (INT CONST x, y) :
out (""6"") ;
out (code(y-1)) ;
out (code(x-1)) ;
ENDPROC cursor ;
PROC get cursor (INT VAR x, y) :
EXTERNAL 67
ENDPROC get cursor ;
PROC cout (INT CONST number) :
EXTERNAL 61
ENDPROC cout ;
INT PROC channel :
pcb (channel field)
ENDPROC channel ;
BOOL PROC online :
pcb (channel field) <> 0
ENDPROC online ;
PROC control (INT CONST code1, code2, code3, INT VAR return code) :
EXTERNAL 84
ENDPROC control ;
PROC blockout (ROW 256 INT CONST block, INT CONST code1, code2,
INT VAR return code) :
access block io ds ;
block io.buffer := block ;
blockout (block io ds, buffer page, code1, code2, return code) .
access block io ds :
IF NOT initialized (this packet)
THEN block io ds := nilspace
FI ;
block io := block io ds .
ENDPROC blockout ;
PROC blockin (ROW 256 INT VAR block, INT CONST code1, code2,
INT VAR return code) :
access block io ds ;
blockin (block io ds, buffer page, code1, code2, return code) ;
block := block io.buffer .
access block io ds :
IF NOT initialized (this packet)
THEN block io ds := nilspace
FI ;
block io := block io ds .
ENDPROC blockin ;
ENDPACKET basic transput ;
|
