disk8: Initial commit
[pdp8.git] / sw / adventure / SPEAK.RA
CommitLineData
84b5715c
PH
1/ SPEAK - Types out messages from the database\r
2/ Also includes TTY output routines that unpack\r
3/ packed sixbit into mixed case ASCII.\r
4/\r
5 FIELD1 ADVTTY\r
6\r
7TTY, 0 / TTY Output routine, dupe of FRTS\r
8 IOF / Protect from race conditions\r
9 SNA / Input or output?\r
10 JMP KBD / Input - read character\r
11 DCA HANGPT / Output - save char\r
12 RDF\r
13 TAD CDIF00\r
14 DCA CDFX\r
15 CDF 0\r
16 TAD% TOCHR / Output character status in FRTS\r
17 SMA SZA CLA / If gt 0, char backed up\r
18 JMP BUSY / Else must wait\r
19LOOP, TAD% TOCHR / Get the status\r
20 CLL RAL /Busy flag in link\r
21 CLA CML RAR /Complement of busy in sign\r
22 TAD HANGPT\r
23 SPA /If tty not busy, \r
24 TLS /Send it\r
25 DCA% TOCHR /Store pos or neg, backed up or busy\r
26TTYRET, ION /Interrupts back on\r
27CDFX, HLT /Caller's field\r
28 JMP% TTY /Return\r
29\r
30CDIF00, CIF CDF\r
31\r
32BUSY, CDF 10 /Busy, must wait. Call Field 0 HANG routine\r
33 CIF 0\r
34 JMS% HANGPT+1\r
35 0451 / TTUHNG\r
36 CDF 0\r
37 JMP LOOP / Try output again\r
38\r
39KBD, RDF\r
40 TAD CDIF00\r
41 DCA CDFX\r
42 CDF 0\r
43 TAD% TICHR / Any input?\r
44 SNA CLA\r
45 JMP WAIT / No, wait\r
46GETIN, TAD% TICHR / Get character\r
47 DCA HANGPT / Save\r
48 DCA% TICHR / Clear buffer\r
49 TAD HANGPT\r
50 JMP TTYRET / Return\r
51\r
52WAIT, CDF 10\r
53 CIF 0\r
54 JMS% HANGPT+1 /Hang\r
55 465 /KBUHNG\r
56 CDF 0\r
57 JMP GETIN /Get input\r
58TOCHR, 4\r
59TICHR, 5\r
60HANGPT, ADDR #HANG\r
61/\r
62/ Terminal line input routine. Used because the FRTS input is quite limited.\r
63/ This one handles scope rubouts and allows lower case input.\r
64/ Inputs: Array Returned characters, stored one sixbit per array word\r
65/ (The FORTRAN input routine is set up this way to unpack)\r
66/ Size Number of characters to allow\r
67/ Prompt Prompt string\r
68 FIELD1 RDLIN\r
69/\r
70 ENTRY RDLINE\r
71RDLINE, JA #RLST\r
72#RLXR, ORG .+10\r
73 TEXT +RDLINE+\r
74#RLRET, SETX #RLXR\r
75 SETB #RLBAS\r
76 JA .+3\r
77#RLBAS, ORG .+6\r
78BUFPT, ORG .+3\r
79BUFLEN, ORG .+3\r
80\r
81 ORG #RLBAS+30\r
82 FNOP\r
83 JA #RLRET\r
84 FNOP\r
85#RGOBK, 0;0\r
86#RLRTN, BASE #RLBAS\r
87 JA #RGOBK\r
88#RLST, STARTD\r
89 0210\r
90 FSTA #RGOBK,0\r
91 0200\r
92 SETX #RLXR\r
93 SETB #RLBAS\r
94 LDX 0,1\r
95 FSTA #RLBAS\r
96 FLDA% #RLBAS,1+\r
97 FSTA BUFPT\r
98 FLDA% #RLBAS,1+\r
99 FSTA BUFLEN\r
100 STARTF\r
101/\r
102/ Pass down size to '8' code\r
103/\r
104 SETX BUFSIZ \r
105 FLDA% BUFLEN\r
106 FNEG / Make it negative\r
107 ATX 0 / Pass buffer len\r
108 SETX #RLXR\r
109 TRAP4 GETLIN / Get input line\r
110 JA #RLRTN / And return\r
111/ Input reader\r
112\r
113 FIELD1 GETLN\r
114\r
115GETLIN, 0\r
116 CLA\r
117 DCA OFFSET / Start at offset zero\r
118 TAD% SCOPT\r
119 AND K200\r
120 DCA SCOPE\r
121 TAD% BUFFLD+1 / Get CDF for buffer\r
122 AND FLDMSK\r
123 CLL RTL\r
124 RAL\r
125 TAD CDFG\r
126 DCA BUFCDF\r
127/\r
128/ Go get an input character\r
129/\r
130GETNXT, JMS% PTTY+1 / Called with zero to get char\r
131 DCA INCH / Save input\r
132/\r
133/ Specials?\r
134/\r
135 TAD INCH\r
136 TAD MDEL / Delete?\r
137 SNA CLA\r
138 JMP DELETE / Handle that\r
139 TAD INCH\r
140 TAD MCR / CR?\r
141 SNA CLA\r
142 JMP ENTER / End of line, let's go.\r
143 TAD INCH\r
144 TAD MSPC / Less than space?\r
145 SPA CLA\r
146 JMP BELL / Nope, ignore\r
147 TAD OFFSET\r
148 TAD BUFSIZ / Room left?\r
149 SMA CLA\r
150 JMP BELL / Bell if not\r
151 TAD INCH\r
152 JMS% PTTY+1 / Echo it\r
153 TAD INCH\r
154 TAD LWRA / Is it lowercase?\r
155 SPA CLA\r
156 JMP UPPER / No, store it\r
157 TAD INCH\r
158 TAD LWRZ\r
159 SMA CLA\r
160 JMP UPPER / More than lowercase z\r
161 TAD INCH\r
162 TAD AMINA / Adjust to uppercase\r
163 DCA INCH\r
164UPPER, JMS STORE / Store this character\r
165 JMP GETNXT / Get more\r
166/ Store a character in the output buffer\r
167/ using the current offset\r
168/\r
169\r
170STORE, 0\r
171 TAD OFFSET\r
172 TAD OFFSET\r
173 TAD OFFSET / Count FPP words\r
174 TAD% BUFPTR+1 / Pointer to exponent word\r
175 DCA BPT\r
176 TAD K27 / Exponent 27 for integer\r
177 JMS STO\r
178 JMS STO / Zero high word\r
179 TAD INCH / Char value\r
180 AND SIXMSK / Convert to sixbit\r
181 JMS STO / Store in buffer\r
182 CDF 10 / Back to my field\r
183 ISZ OFFSET / One more in the buffer\r
184SPC, 240 / Really shouldn't overflow; harmless AND\r
185 JMP% STORE / Return\r
186STO, 0\r
187BUFCDF, HLT / Gets CDF for buffer field\r
188 DCA% BPT\r
189 ISZ BPT / Next word\r
190 JMP% STO / Return if no skip\r
191 TAD BUFCDF\r
192 TAD BS / Next field\r
193 DCA BUFCDF\r
194 JMP% STO\r
195\r
196BELL, TAD BEL / Warn the user\r
197 JMS% PTTY+1\r
198 JMP GETNXT\r
199\r
200DELETE, TAD OFFSET / How far into the buffer are we?\r
201 SNA CLA\r
202 JMP BELL / Ignore extra deletes\r
203 TAD SCOPE\r
204 SNA CLA\r
205 JMP DUMBDL / Simple fortran-format delete\r
206 TAD BS\r
207 JMS% PTTY+1\r
208 TAD SPC\r
209 JMS% PTTY+1\r
210 TAD BS\r
211 JMS% PTTY+1\r
212 JMP FIXOFF / Fix the offset\r
213DUMBDL, TAD K334 / Backslash\r
214 JMS% PTTY+1\r
215FIXOFF, CLA CMA\r
216 TAD OFFSET\r
217 DCA OFFSET\r
218 JMP GETNXT\r
219\r
220ENTER, TAD CR / Send a RETURN\r
221 JMS% PTTY+1\r
222CLRLP, TAD OFFSET / Is there space available?\r
223 TAD BUFSIZ\r
224 SMA CLA\r
225 JMP CLRDN\r
226 TAD SPC\r
227 DCA INCH\r
228 JMS STORE\r
229 JMP CLRLP\r
230CLRDN, CIF CDF 0\r
231 JMP% GETLIN\r
232\r
233BUFSIZ, 0\r
234SCOPT, 7726 / Scope flag in OS/8\r
235K200, 200\r
236MDEL, -377 / Delete \r
237MCR, -215\r
238CR, 215\r
239MSPC, -240\r
240BEL, 207\r
241LWRA, -341\r
242LWRZ, -373\r
243AMINA, -40 / Add to "a" to make "A"\r
244BPT,\r
245BUFFLD, ADDR BUFPT+1\r
246SCOPE,\r
247BUFPTR, ADDR BUFPT+2\r
248OFFSET,\r
249PTTY, ADDR TTY\r
250BS, 10\r
251K334, 334\r
252CDFG, CDF 0\r
253K27, 27\r
254SIXMSK, 77\r
255FLDMSK, 7\r
256INCH, 0\r
257\r
258/\r
259/ Fortran-callable message printer\r
260/ Put here to avoid wasting the rest of the page.\r
261/ Arguments:\r
262/ BUF Buffer pointer\r
263/ COUNT Number of characters to write, zero to look for end\r
264/ CRFLAG Carriage return flags.\r
265/ Bit 11 (1) = no lead LF\r
266/ Bit 10 (2) = no trail CR\r
267/ Bit 9 (4) = start lowercase\r
268/\r
269 ENTRY SIXOUT\r
270SIXOUT, JA #STRT\r
271#SXR, ORG .+10\r
272 TEXT +SIXOUT+\r
273#SRET, SETX #SXR\r
274 SETB #SBASE\r
275 JA .+3\r
276#SBASE, ORG .+6\r
277CNT, ORG .+3\r
278SFLAG, ORG .+3\r
279\r
280 ORG #SBASE+30\r
281 FNOP\r
282 JA #SRET\r
283 FNOP\r
284#SGOBK, 0;0\r
285#SRTN, BASE #SBASE\r
286 JA #SGOBK\r
287#STRT, STARTD\r
288 0210\r
289 FSTA #SGOBK,0\r
290 0200\r
291 SETX #SXR\r
292 SETB #SBASE\r
293 LDX 0,1\r
294 FSTA #SBASE\r
295 FLDA% #SBASE,1+\r
296 FSTA BUF / Buffer pointer\r
297 FLDA% #SBASE,1+ / Count\r
298 FSTA CNT\r
299 FLDA% #SBASE,1+ / Carriage control flag\r
300 FSTA SFLAG\r
301 STARTF\r
302 FLDA% CNT\r
303 SETX COUNT\r
304 ATX 0\r
305 FLDA% SFLAG\r
306 ATX 1\r
307 SETX #SXR\r
308 TRAP4 SIX8 /Call the 8-mode output routine\r
309 JA #SRTN\r
310\r
311 FIELD1 SXOUT\r
312 ENTRY SIX8 / Mixed case output routine\r
313\r
314SIX8, 0\r
315 TAD CRFLAG /Suppresss carriage control?\r
316 RAR /Low bit suppresses lead LF\r
317 SZL CLA\r
318 JMP .+4 /No leading LF\r
319 CDF 10 / My field\r
320 TAD LF /Linefeed\r
321 JMS% TTYPTR+1 /Output it\r
322 TAD CRFLAG\r
323 AND K4 /Start in lower case?\r
324 SZA CLA\r
325 TAD K40 /Yes\r
326 TAD HUN /Reset conversion factor\r
327 DCA SHIFT\r
328 TAD BUF /Buffer field\r
329 AND K7 /Just the field bits\r
330 CLL RAL\r
331 RTL /Into place\r
332 TAD CDF0 /Into CDF instruction\r
333 DCA CDF1\r
334 TAD CDF1\r
335 DCA CDF2\r
336 TAD COUNT /Get buffer length\r
337 SNA\r
338 JMP NOTRIM /Zero means it has a terminating "@"\r
339/\r
340/ Find the end of the string\r
341/\r
342 CLA CMA /End is start + len - 1\r
343 TAD COUNT /String len in words\r
344 TAD BUF+1 /End of the string\r
345 DCA PTR /Pointer to end\r
346 TAD COUNT /Invert count\r
347 CMA IAC\r
348 DCA COUNT\r
349CDF1, HLT\r
350FNDEND, TAD% PTR\r
351 TAD K3740 / - ' ' (two spaces)\r
352 SZA CLA / Skip if blank\r
353 JMP NONBLK\r
354 ISZ COUNT /Count another\r
355 SKP\r
356 JMP NONBLK /If empty, done\r
357 CLA CMA / -1\r
358 TAD PTR\r
359 DCA PTR /Back pointer up\r
360 JMP FNDEND /Keep looking\r
361\r
362NONBLK, TAD COUNT\r
363 SNA CLA /Skip if output left\r
364 JMP DONE /Nothing if count zero already\r
365NOTRIM, TAD BUF+1 /Reset pointer to start\r
366 DCA PTR\r
367CDF2, HLT\r
368 TAD% PTR /Get word\r
369 DCA STEMP /Save\r
370 TAD STEMP\r
371 RTR\r
372 RTR\r
373 RTR /First sixbit\r
374 JMS OUTONE /Convert and output it\r
375 TAD STEMP /Second sixbit\r
376 JMS OUTONE\r
377 ISZ PTR /Bump pointer\r
378 SKP /OK if no skip\r
379 JMP NEWFLD /Next field otherwise\r
380INCCNT, ISZ COUNT\r
381 JMP CDF2 /Keep outputting\r
382DONE, CLA\r
383 TAD CRFLAG /Suppress trailing CR?\r
384 RTR /2 bit suppresses trailing CR\r
385 SZL CLA /If zero, write it.\r
386 JMP OUT /Yes, leave now\r
387 CDF 10 /My field\r
388 TAD CRTN\r
389 JMS% TTYPTR+1\r
390OUT, CIF CDF 0\r
391 JMP% SIX8\r
392\r
393NEWFLD, TAD CDF1\r
394 TAD K10 /Next field\r
395 DCA CDF1\r
396 TAD CDF1\r
397 DCA CDF2\r
398 JMP INCCNT\r
399\r
400OUTONE, 0\r
401 AND K77 /Mask\r
402 SNA\r
403 JMP DONE / End of string\r
404 TAD K7743 / minus '['\r
405 SNA\r
406 JMP SETLWR /Set to lowercase shift\r
407 TAD K2 / ok, ']'?\r
408 SNA\r
409 JMP SETUPR /Set to uppercase\r
410 TAD K7773 /Restore\r
411 SPA\r
412 TAD SHIFT /For positive, shift it\r
413 TAD K40 /Else it's not alphabetic\r
414 CDF 10 /My field\r
415 JMS% TTYPTR+1 /Output it\r
416 JMP% OUTONE /Done\r
417\r
418SETLWR, TAD K40 /Reset shift\r
419SETUPR, TAD HUN /For upper/lower\r
420 DCA SHIFT\r
421 JMP% OUTONE\r
422\r
423TTYPTR, ADDR TTY\r
424SHIFT, 140 /Shift value\r
425/ COUNT and CRFLAG must stay together\r
426COUNT, 0 /Num words to output. \r
427CRFLAG, 0 /1 - no leading LF, 2 no trailing CR\r
428PTR, 0\r
429CRTN, 15\r
430LF, 12\r
431K3740, 3740 /minus blank\r
432BUF, 0;0;0 /Buffer 15-bit address\r
433STEMP, 0\r
434K77, 77 /sixbit mask\r
435K7, 7\r
436K4, 4\r
437K40, 40\r
438CDF0, CDF\r
439HUN, 100\r
440K7743, 7743\r
441K7773, 7773\r
442K10, 10 /Field increment\r
443K2, 2\r
444\r
445 SECT SPEAK\r
446/C\r
447/ SUBROUTINE SPEAK(N)\r
448/C\r
449/C PRINT THE MESSAGE IN RECORD N OF THE RANDOM ACCESS MESSAGE FILE.\r
450/C\r
451/ IMPLICIT INTEGER (A-Z)\r
452/ COMMON /TXTCOM/ RTEXT,LINES,ASCVAR\r
453/ COMMON /ALPHAS/ BLANK,EOF\r
454/ DIMENSION RTEXT(205),LINES(36)\r
455/C\r
456 EXTERN IO\r
457 EXTERN #HANG\r
458 JA #ST\r
459#XR, ORG .+10\r
460 TEXT +SPEAK+\r
461#RET, SETX #XR\r
462 SETB #BASE\r
463 JA .+3\r
464#BASE, ORG .+6\r
465N, ORG .+3\r
466#DOTMP, ORG .+3\r
467BLANK, TEXT + +\r
468EOF, TEXT +>$< +\r
469ONE, F 1.0\r
470FOUR, F 4.0\r
471 ORG #BASE+30\r
472 FNOP\r
473 JA #RET\r
474 FNOP\r
475#GOBAK, 0;0\r
476I, ORG .+0003\r
477L, ORG .+0003\r
478OLDLOC, ORG .+0003\r
479 #LBL=.\r
480 COMMON TXTCOM\r
481RTEXT, ORG .+1147\r
482LINES, ORG .+0044\r
483ASCVAR, ORG .+0003\r
484TXTLOC, ORG .+0003\r
485DATA, ORG .+0352\r
486 ORG #LBL\r
487#RTN, BASE #BASE\r
488 JA #GOBAK\r
489#ST, STARTD\r
490 0210\r
491 FSTA #GOBAK,0\r
492 0200\r
493 SETX #XR\r
494 SETB #BASE\r
495 LDX 0,1\r
496 FSTA #BASE\r
497 FLDA% #BASE,1+\r
498 FSTA N\r
499 STARTF\r
500/ IF(N.EQ.0)RETURN\r
501 FLDA% N\r
502 JEQ #RTN\r
503/ READ(2'N) LOC,LINES\r
504 FLDA N\r
505 STARTD\r
506 FSTA #G0002\r
507 STARTF\r
508 JSR IO\r
509 JA .+0004\r
510#G0002, JA .\r
511/ IF(LINES(1).EQ.EOF)RETURN\r
512 FLDA ONE\r
513 ATX 7\r
514 FLDA LINES-0003,7\r
515 FSUB EOF\r
516 JEQ #RTN\r
517/1 OLDLOC = LOC\r
518#1, FLDA TXTLOC\r
519 FSTA OLDLOC\r
520 FLDA ONE\r
521 FSTA I\r
522\r
523/ DO 3 I=36,1,-1\r
524/ Set COUNT to the number of words (36 or 44 octal)\r
525 SETX COUNT\r
526 LDX 44,0 /44 words\r
527 LDX 0,1 /With carriage control\r
528 SETX #XR\r
529/ L=I\r
530/3 CONTINUE\r
531/5 TYPE 2,(LINES(I),I=1,L)\r
532#5, FLDA LINEPT\r
533 FSTA BUF /Set buffer pointer\r
534 TRAP4 SIX8\r
535\r
536 FLDA% N\r
537 FADD ONE\r
538 FSTA% N\r
539 FLDA N\r
540/ READ(2'ASCVAR) LOC,LINES\r
541 STARTD\r
542 FSTA #G0006\r
543 STARTF\r
544 JSR IO\r
545 JA .+0004\r
546#G0006, JA .\r
547/ IF(LOC .EQ. OLDLOC) GO TO 1\r
548 FLDA TXTLOC\r
549 FSUB OLDLOC\r
550 JEQ #1\r
551 EXTERN #WRITO\r
552 TRAP3 #WRITO\r
553 JA FOUR\r
554 JA #10+2\r
555 EXTERN #RENDO\r
556 TRAP3 #RENDO\r
557\r
558/10 RETURN\r
559#10, JA #RTN\r
560/ (1X)\r
561 5061\r
562 3051\r
563/2 FORMAT(' ',36A2) PDP/8: (' ',12A6)\r
564LINEPT, ADDR LINES\r
565 0\r
566 END\r