sw/adventure/0906/SPEAK.RA

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