sw/adventure/src/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     INCH
 148         TAD     LWRA            / Is it lowercase?
 149         SPA CLA
 150         JMP     UPPER           / No, store it
 151         TAD     INCH
 152         TAD     LWRZ
 153         SMA CLA
 154         JMP     UPPER           / More than lowercase z
 155         TAD     INCH
 156         TAD     AMINA           / Adjust to uppercase
 157         DCA     INCH
 158
 159 UPPER,  TAD     OFFSET
 160         TAD     BUFSIZ          / Room left?
 161         SMA CLA
 162         JMP     BELL            / Bell if not
 163         TAD     INCH
 164         JMS%    PTTY+1          / Echo it
 165         JMS     STORE           / Store this character
 166         JMP     GETNXT          / Get more
 167 / Store a character in the output buffer
 168 / using the current offset
 169 /
 170
 171 STORE,  0
 172         TAD     OFFSET
 173         TAD     OFFSET
 174         TAD     OFFSET          / Count FPP words
 175         TAD%    BUFPTR+1        / Pointer to exponent word
 176         DCA     BPT
 177         TAD     K27             / Exponent 27 for integer
 178         JMS     STO
 179         JMS     STO             / Zero high word
 180         TAD     INCH            / Char value
 181         AND     SIXMSK          / Convert to sixbit
 182         JMS     STO             / Store in buffer
 183         CDF     10              / Back to my field
 184         ISZ     OFFSET          / One more in the buffer
 185 /       NOP                     / Really shouldn't overflow
 186         JMP%    STORE           / Return
 187 STO,    0
 188 BUFCDF, HLT                     / Gets CDF for buffer field
 189         DCA%    BPT
 190         ISZ     BPT             / Next word
 191         JMP%    STO             / Return if no skip
 192         TAD     BUFCDF
 193         TAD     BS              / Next field
 194         DCA     BUFCDF
 195         JMP%    STO
 196
 197 BELL,   TAD     BEL             / Warn the user
 198         JMS%    PTTY+1
 199         JMP     GETNXT
 200
 201 DELETE, TAD     OFFSET          / How far into the buffer are we?
 202         SNA CLA
 203         JMP     BELL            / Ignore extra deletes
 204         TAD     SCOPE
 205         SNA CLA
 206         JMP     DUMBDL          / Simple fortran-format delete
 207         TAD     BS
 208         JMS%    PTTY+1
 209         TAD     SPC
 210         JMS%    PTTY+1
 211         TAD     BS
 212         JMS%    PTTY+1
 213         JMP     FIXOFF          / Fix the offset
 214 DUMBDL, TAD     K334            / Backslash
 215         JMS%    PTTY+1
 216 FIXOFF, CLA CMA
 217         TAD     OFFSET
 218         DCA     OFFSET
 219         JMP     GETNXT
 220
 221 ENTER,  TAD     CR              / Send a RETURN
 222         JMS%    PTTY+1
 223 CLRLP,  TAD     OFFSET          / Is there space available?
 224         TAD     BUFSIZ
 225         SMA CLA
 226         JMP     CLRDN
 227         TAD     SPC
 228         DCA     INCH
 229         JMS     STORE
 230         JMP     CLRLP
 231 CLRDN,  CIF CDF 0
 232         JMP%    GETLIN
 233
 234 BUFSIZ, 0
 235 SCOPT,  7726                    / Scope flag in OS/8
 236 K200,   200
 237 MDEL,   -377                    / Delete
 238 MCR,    -215
 239 CR,     215
 240 MSPC,   -240
 241 BEL,    207
 242 LWRA,   -341
 243 LWRZ,   -373
 244 AMINA,  -40                     / Add to "a" to make "A"
 245 BPT,
 246 BUFFLD, ADDR BUFPT+1
 247 SCOPE,
 248 BUFPTR, ADDR    BUFPT+2
 249 OFFSET,
 250 PTTY,   ADDR    TTY
 251 BS,     10
 252 SPC,    240
 253 K334,   334
 254 CDFG,   CDF 0
 255 K27,    27
 256 SIXMSK, 77
 257 FLDMSK, 7
 258 INCH,   0
 259 /
 260 / Fortran-callable message printer
 261 / Put here to avoid wasting the rest of the page.
 262 /
 263         ENTRY   SIXOUT
 264 SIXOUT, JA      #STRT
 265 #SXR,   ORG     .+10
 266         TEXT    +SIXOUT+
 267 #SRET,  SETX    #SXR
 268         SETB    #SBASE
 269         JA      .+3
 270 #SBASE, ORG     .+6
 271 CNT,    ORG     .+3
 272 SFLAG,  ORG     .+3
 273
 274         ORG     #SBASE+30
 275         FNOP
 276         JA      #SRET
 277         FNOP
 278 #SGOBK, 0;0
 279 #SRTN,  BASE    #SBASE
 280         JA      #SGOBK
 281 #STRT,  STARTD
 282         0210
 283         FSTA    #SGOBK,0
 284         0200
 285         SETX    #SXR
 286         SETB    #SBASE
 287         LDX     0,1
 288         FSTA    #SBASE
 289         FLDA%   #SBASE,1+
 290         FSTA    BUF             / Buffer pointer
 291         FLDA%   #SBASE,1+       / Count
 292         FSTA    CNT
 293         FLDA%   #SBASE,1+       / Carriage control flag
 294         FSTA    SFLAG
 295         STARTF
 296         FLDA%   CNT
 297         SETX    COUNT
 298         ATX     0
 299         FLDA%   SFLAG
 300         ATX     1
 301         SETX    #SXR
 302         TRAP4   SIX8            /Call the 8-mode output routine
 303         JA      #SRTN
 304
 305         FIELD1  SXOUT
 306         ENTRY   SIX8            / Mixed case output routine
 307
 308 SIX8,   0
 309         TAD     CRFLAG          /Suppresss carriage control?
 310         RAR                     /Low bit suppresses lead LF
 311         SZL CLA
 312         JMP     .+4             /No leading LF
 313         CDF     10              / My field
 314         TAD     LF              /Linefeed
 315         JMS%    TTYPTR+1        /Output it
 316         TAD     HUN             /Reset conversion factor
 317         DCA     SHIFT
 318         TAD     BUF             /Buffer field
 319         AND     K7              /Just the field bits
 320         CLL RAL
 321         RTL                     /Into place
 322         TAD     CDF0            /Into CDF instruction
 323         DCA     CDF1
 324         TAD     CDF1
 325         DCA     CDF2
 326         TAD     COUNT           /Get buffer length
 327         SNA
 328         JMP     NOTRIM          /Zero means it has a terminating "@"
 329 /
 330 / Find the end of the string
 331 /
 332         CLA CMA                 /End is start + len - 1
 333         TAD     COUNT           /String len in words
 334         TAD     BUF+1           /End of the string
 335         DCA     PTR             /Pointer to end
 336         TAD     COUNT           /Invert count
 337         CMA IAC
 338         DCA     COUNT
 339 CDF1,   HLT
 340 FNDEND, TAD%    PTR
 341         TAD     K3740           / - '  ' (two spaces)
 342         SZA CLA                 / Skip if blank
 343         JMP     NONBLK
 344         ISZ     COUNT           /Count another
 345         SKP
 346         JMP     NONBLK          /If empty, done
 347         CLA CMA                 / -1
 348         TAD     PTR
 349         DCA     PTR             /Back pointer up
 350         JMP     FNDEND          /Keep looking
 351
 352 NONBLK, TAD     COUNT
 353         SNA CLA                 /Skip if output left
 354         JMP     DONE            /Nothing if count zero already
 355 NOTRIM, TAD     BUF+1           /Reset pointer to start
 356         DCA     PTR
 357 CDF2,   HLT
 358         TAD%    PTR             /Get word
 359         DCA     STEMP           /Save
 360         TAD     STEMP
 361         RTR
 362         RTR
 363         RTR                     /First sixbit
 364         JMS     OUTONE          /Convert and output it
 365         TAD     STEMP           /Second sixbit
 366         JMS     OUTONE
 367         ISZ     PTR             /Bump pointer
 368         SKP                     /OK if no skip
 369         JMP     NEWFLD          /Next field otherwise
 370 INCCNT, ISZ     COUNT
 371         JMP     CDF2            /Keep outputting
 372 DONE,   CLA
 373         TAD     CRFLAG          /Suppress trailing CR?
 374         RTR                     /2 bit suppresses trailing CR
 375         SZL CLA                 /If zero, write it.
 376         JMP     OUT             /Yes, leave now
 377         CDF     10              /My field
 378         TAD     CRTN
 379         JMS%    TTYPTR+1
 380 OUT,    CIF CDF 0
 381         JMP%    SIX8
 382
 383 NEWFLD, TAD     CDF1
 384         TAD     K10             /Next field
 385         DCA     CDF1
 386         TAD     CDF1
 387         DCA     CDF2
 388         JMP     INCCNT
 389
 390 OUTONE, 0
 391         AND     K77             /Mask
 392         SNA
 393         JMP     DONE            / End of string
 394         TAD     K7743           / minus '['
 395         SNA
 396         JMP     SETLWR          /Set to lowercase shift
 397         TAD     K2              / ok, ']'?
 398         SNA
 399         JMP     SETUPR          /Set to uppercase
 400         TAD     K7773           /Restore
 401         SPA
 402         TAD     SHIFT           /For positive, shift it
 403         TAD     K40             /Else it's not alphabetic
 404         CDF     10              /My field
 405         JMS%    TTYPTR+1        /Output it
 406         JMP%    OUTONE          /Done
 407
 408 SETLWR, TAD     K40             /Reset shift
 409 SETUPR, TAD     HUN             /For upper/lower
 410         DCA     SHIFT
 411         JMP%    OUTONE
 412
 413 TTYPTR, ADDR TTY
 414 SHIFT,  140             /Shift value
 415 / COUNT and CRFLAG must stay together
 416 COUNT,  0               /Num words to output.
 417 CRFLAG, 0               /1 - no leading LF, 2 no trailing CR
 418 PTR,    0
 419 CRTN,   15
 420 LF,     12
 421 K3740,  3740                    /minus blank
 422 BUF,    0;0;0                   /Buffer 15-bit address
 423 STEMP,  0
 424 K77,    77                      /sixbit mask
 425 K7,     7
 426 K40,    40
 427 CDF0,   CDF
 428 HUN,    100
 429 K7743,  7743
 430 K7773,  7773
 431 K10,    10                      /Field increment
 432 K2,     2
 433
 434         SECT    SPEAK
 435 /C
 436 /       SUBROUTINE SPEAK(N)
 437 /C
 438 /C PRINT THE MESSAGE IN RECORD N OF THE RANDOM ACCESS MESSAGE FILE.
 439 /C
 440 /       IMPLICIT INTEGER (A-Z)
 441 /       COMMON /TXTCOM/ RTEXT,LINES,ASCVAR
 442 /       COMMON /ALPHAS/ BLANK,EOF
 443 /       DIMENSION RTEXT(205),LINES(36)
 444 /C
 445         EXTERN  IO
 446         EXTERN  #HANG
 447         JA      #ST
 448 #XR,    ORG     .+10
 449         TEXT    +SPEAK+
 450 #RET,   SETX    #XR
 451         SETB    #BASE
 452         JA      .+3
 453 #BASE,  ORG     .+6
 454 N,      ORG     .+3
 455 #DOTMP, ORG     .+3
 456 BLANK,  TEXT +      +
 457 EOF,    TEXT +>$<   +
 458 ONE,    F 1.0
 459 FOUR,   F 4.0
 460         ORG     #BASE+30
 461         FNOP
 462         JA      #RET
 463         FNOP
 464 #GOBAK, 0;0
 465 I,      ORG     .+0003
 466 L,      ORG     .+0003
 467 OLDLOC, ORG     .+0003
 468         #LBL=.
 469         COMMON  TXTCOM
 470 RTEXT,  ORG     .+1147
 471 LINES,  ORG     .+0044
 472 ASCVAR, ORG     .+0003
 473 TXTLOC, ORG     .+0003
 474 DATA,   ORG     .+0352
 475         ORG     #LBL
 476 #RTN,   BASE    #BASE
 477         JA      #GOBAK
 478 #ST,    STARTD
 479         0210
 480         FSTA    #GOBAK,0
 481         0200
 482         SETX    #XR
 483         SETB    #BASE
 484         LDX     0,1
 485         FSTA    #BASE
 486         FLDA%   #BASE,1+
 487         FSTA    N
 488         STARTF
 489 /        IF(N.EQ.0)RETURN
 490         FLDA%   N
 491         JEQ     #RTN
 492 /        READ(2'N) LOC,LINES
 493         FLDA    N
 494         STARTD
 495         FSTA    #G0002
 496         STARTF
 497         JSR     IO
 498         JA      .+0004
 499 #G0002, JA      .
 500 /        IF(LINES(1).EQ.EOF)RETURN
 501         FLDA    ONE
 502         ATX     7
 503         FLDA    LINES-0003,7
 504         FSUB    EOF
 505         JEQ     #RTN
 506 /1       OLDLOC = LOC
 507 #1,     FLDA    TXTLOC
 508         FSTA    OLDLOC
 509         FLDA    ONE
 510         FSTA    I
 511
 512 /        DO 3 I=36,1,-1
 513 /       Set COUNT to the number of words (36 or 44 octal)
 514         SETX    COUNT
 515         LDX     44,0            /44 words
 516         LDX     0,1             /With carriage control
 517         SETX    #XR
 518 /        L=I
 519 /3       CONTINUE
 520 /5       TYPE 2,(LINES(I),I=1,L)
 521 #5,     FLDA    LINEPT
 522         FSTA    BUF             /Set buffer pointer
 523         TRAP4   SIX8
 524
 525         FLDA%   N
 526         FADD    ONE
 527         FSTA%   N
 528         FLDA    N
 529 /        READ(2'ASCVAR) LOC,LINES
 530         STARTD
 531         FSTA    #G0006
 532         STARTF
 533         JSR     IO
 534         JA      .+0004
 535 #G0006, JA      .
 536 /        IF(LOC .EQ. OLDLOC) GO TO 1
 537         FLDA    TXTLOC
 538         FSUB    OLDLOC
 539         JEQ     #1
 540         EXTERN  #WRITO
 541         TRAP3   #WRITO
 542         JA      FOUR
 543         JA      #10+2
 544         EXTERN  #RENDO
 545         TRAP3   #RENDO
 546
 547 /10      RETURN
 548 #10,    JA      #RTN
 549 /        (1X)
 550         5061
 551         3051
 552 /2       FORMAT(' ',36A2) PDP/8: (' ',12A6)
 553 LINEPT, ADDR    LINES
 554         0
 555         END