X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fadventure%2FSPEAK.RA;fp=sw%2Fadventure%2FSPEAK.RA;h=0000000000000000000000000000000000000000;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=a89e095b384e098be4bb7c9276d8fb09915096be;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/adventure/SPEAK.RA b/sw/adventure/SPEAK.RA deleted file mode 100644 index a89e095..0000000 --- a/sw/adventure/SPEAK.RA +++ /dev/null @@ -1,566 +0,0 @@ -/ SPEAK - Types out messages from the database -/ Also includes TTY output routines that unpack -/ packed sixbit into mixed case ASCII. -/ - FIELD1 ADVTTY - -TTY, 0 / TTY Output routine, dupe of FRTS - IOF / Protect from race conditions - SNA / Input or output? - JMP KBD / Input - read character - DCA HANGPT / Output - save char - RDF - TAD CDIF00 - DCA CDFX - CDF 0 - TAD% TOCHR / Output character status in FRTS - SMA SZA CLA / If gt 0, char backed up - JMP BUSY / Else must wait -LOOP, TAD% TOCHR / Get the status - CLL RAL /Busy flag in link - CLA CML RAR /Complement of busy in sign - TAD HANGPT - SPA /If tty not busy, - TLS /Send it - DCA% TOCHR /Store pos or neg, backed up or busy -TTYRET, ION /Interrupts back on -CDFX, HLT /Caller's field - JMP% TTY /Return - -CDIF00, CIF CDF - -BUSY, CDF 10 /Busy, must wait. Call Field 0 HANG routine - CIF 0 - JMS% HANGPT+1 - 0451 / TTUHNG - CDF 0 - JMP LOOP / Try output again - -KBD, RDF - TAD CDIF00 - DCA CDFX - CDF 0 - TAD% TICHR / Any input? - SNA CLA - JMP WAIT / No, wait -GETIN, TAD% TICHR / Get character - DCA HANGPT / Save - DCA% TICHR / Clear buffer - TAD HANGPT - JMP TTYRET / Return - -WAIT, CDF 10 - CIF 0 - JMS% HANGPT+1 /Hang - 465 /KBUHNG - CDF 0 - JMP GETIN /Get input -TOCHR, 4 -TICHR, 5 -HANGPT, ADDR #HANG -/ -/ Terminal line input routine. Used because the FRTS input is quite limited. -/ This one handles scope rubouts and allows lower case input. -/ Inputs: Array Returned characters, stored one sixbit per array word -/ (The FORTRAN input routine is set up this way to unpack) -/ Size Number of characters to allow -/ Prompt Prompt string - FIELD1 RDLIN -/ - ENTRY RDLINE -RDLINE, JA #RLST -#RLXR, ORG .+10 - TEXT +RDLINE+ -#RLRET, SETX #RLXR - SETB #RLBAS - JA .+3 -#RLBAS, ORG .+6 -BUFPT, ORG .+3 -BUFLEN, ORG .+3 - - ORG #RLBAS+30 - FNOP - JA #RLRET - FNOP -#RGOBK, 0;0 -#RLRTN, BASE #RLBAS - JA #RGOBK -#RLST, STARTD - 0210 - FSTA #RGOBK,0 - 0200 - SETX #RLXR - SETB #RLBAS - LDX 0,1 - FSTA #RLBAS - FLDA% #RLBAS,1+ - FSTA BUFPT - FLDA% #RLBAS,1+ - FSTA BUFLEN - STARTF -/ -/ Pass down size to '8' code -/ - SETX BUFSIZ - FLDA% BUFLEN - FNEG / Make it negative - ATX 0 / Pass buffer len - SETX #RLXR - TRAP4 GETLIN / Get input line - JA #RLRTN / And return -/ Input reader - - FIELD1 GETLN - -GETLIN, 0 - CLA - DCA OFFSET / Start at offset zero - TAD% SCOPT - AND K200 - DCA SCOPE - TAD% BUFFLD+1 / Get CDF for buffer - AND FLDMSK - CLL RTL - RAL - TAD CDFG - DCA BUFCDF -/ -/ Go get an input character -/ -GETNXT, JMS% PTTY+1 / Called with zero to get char - DCA INCH / Save input -/ -/ Specials? -/ - TAD INCH - TAD MDEL / Delete? - SNA CLA - JMP DELETE / Handle that - TAD INCH - TAD MCR / CR? - SNA CLA - JMP ENTER / End of line, let's go. - TAD INCH - TAD MSPC / Less than space? - SPA CLA - JMP BELL / Nope, ignore - TAD OFFSET - TAD BUFSIZ / Room left? - SMA CLA - JMP BELL / Bell if not - TAD INCH - JMS% PTTY+1 / Echo it - TAD INCH - TAD LWRA / Is it lowercase? - SPA CLA - JMP UPPER / No, store it - TAD INCH - TAD LWRZ - SMA CLA - JMP UPPER / More than lowercase z - TAD INCH - TAD AMINA / Adjust to uppercase - DCA INCH -UPPER, JMS STORE / Store this character - JMP GETNXT / Get more -/ Store a character in the output buffer -/ using the current offset -/ - -STORE, 0 - TAD OFFSET - TAD OFFSET - TAD OFFSET / Count FPP words - TAD% BUFPTR+1 / Pointer to exponent word - DCA BPT - TAD K27 / Exponent 27 for integer - JMS STO - JMS STO / Zero high word - TAD INCH / Char value - AND SIXMSK / Convert to sixbit - JMS STO / Store in buffer - CDF 10 / Back to my field - ISZ OFFSET / One more in the buffer -SPC, 240 / Really shouldn't overflow; harmless AND - JMP% STORE / Return -STO, 0 -BUFCDF, HLT / Gets CDF for buffer field - DCA% BPT - ISZ BPT / Next word - JMP% STO / Return if no skip - TAD BUFCDF - TAD BS / Next field - DCA BUFCDF - JMP% STO - -BELL, TAD BEL / Warn the user - JMS% PTTY+1 - JMP GETNXT - -DELETE, TAD OFFSET / How far into the buffer are we? - SNA CLA - JMP BELL / Ignore extra deletes - TAD SCOPE - SNA CLA - JMP DUMBDL / Simple fortran-format delete - TAD BS - JMS% PTTY+1 - TAD SPC - JMS% PTTY+1 - TAD BS - JMS% PTTY+1 - JMP FIXOFF / Fix the offset -DUMBDL, TAD K334 / Backslash - JMS% PTTY+1 -FIXOFF, CLA CMA - TAD OFFSET - DCA OFFSET - JMP GETNXT - -ENTER, TAD CR / Send a RETURN - JMS% PTTY+1 -CLRLP, TAD OFFSET / Is there space available? - TAD BUFSIZ - SMA CLA - JMP CLRDN - TAD SPC - DCA INCH - JMS STORE - JMP CLRLP -CLRDN, CIF CDF 0 - JMP% GETLIN - -BUFSIZ, 0 -SCOPT, 7726 / Scope flag in OS/8 -K200, 200 -MDEL, -377 / Delete -MCR, -215 -CR, 215 -MSPC, -240 -BEL, 207 -LWRA, -341 -LWRZ, -373 -AMINA, -40 / Add to "a" to make "A" -BPT, -BUFFLD, ADDR BUFPT+1 -SCOPE, -BUFPTR, ADDR BUFPT+2 -OFFSET, -PTTY, ADDR TTY -BS, 10 -K334, 334 -CDFG, CDF 0 -K27, 27 -SIXMSK, 77 -FLDMSK, 7 -INCH, 0 - -/ -/ Fortran-callable message printer -/ Put here to avoid wasting the rest of the page. -/ Arguments: -/ BUF Buffer pointer -/ COUNT Number of characters to write, zero to look for end -/ CRFLAG Carriage return flags. -/ Bit 11 (1) = no lead LF -/ Bit 10 (2) = no trail CR -/ Bit 9 (4) = start lowercase -/ - ENTRY SIXOUT -SIXOUT, JA #STRT -#SXR, ORG .+10 - TEXT +SIXOUT+ -#SRET, SETX #SXR - SETB #SBASE - JA .+3 -#SBASE, ORG .+6 -CNT, ORG .+3 -SFLAG, ORG .+3 - - ORG #SBASE+30 - FNOP - JA #SRET - FNOP -#SGOBK, 0;0 -#SRTN, BASE #SBASE - JA #SGOBK -#STRT, STARTD - 0210 - FSTA #SGOBK,0 - 0200 - SETX #SXR - SETB #SBASE - LDX 0,1 - FSTA #SBASE - FLDA% #SBASE,1+ - FSTA BUF / Buffer pointer - FLDA% #SBASE,1+ / Count - FSTA CNT - FLDA% #SBASE,1+ / Carriage control flag - FSTA SFLAG - STARTF - FLDA% CNT - SETX COUNT - ATX 0 - FLDA% SFLAG - ATX 1 - SETX #SXR - TRAP4 SIX8 /Call the 8-mode output routine - JA #SRTN - - FIELD1 SXOUT - ENTRY SIX8 / Mixed case output routine - -SIX8, 0 - TAD CRFLAG /Suppresss carriage control? - RAR /Low bit suppresses lead LF - SZL CLA - JMP .+4 /No leading LF - CDF 10 / My field - TAD LF /Linefeed - JMS% TTYPTR+1 /Output it - TAD CRFLAG - AND K4 /Start in lower case? - SZA CLA - TAD K40 /Yes - TAD HUN /Reset conversion factor - DCA SHIFT - TAD BUF /Buffer field - AND K7 /Just the field bits - CLL RAL - RTL /Into place - TAD CDF0 /Into CDF instruction - DCA CDF1 - TAD CDF1 - DCA CDF2 - TAD COUNT /Get buffer length - SNA - JMP NOTRIM /Zero means it has a terminating "@" -/ -/ Find the end of the string -/ - CLA CMA /End is start + len - 1 - TAD COUNT /String len in words - TAD BUF+1 /End of the string - DCA PTR /Pointer to end - TAD COUNT /Invert count - CMA IAC - DCA COUNT -CDF1, HLT -FNDEND, TAD% PTR - TAD K3740 / - ' ' (two spaces) - SZA CLA / Skip if blank - JMP NONBLK - ISZ COUNT /Count another - SKP - JMP NONBLK /If empty, done - CLA CMA / -1 - TAD PTR - DCA PTR /Back pointer up - JMP FNDEND /Keep looking - -NONBLK, TAD COUNT - SNA CLA /Skip if output left - JMP DONE /Nothing if count zero already -NOTRIM, TAD BUF+1 /Reset pointer to start - DCA PTR -CDF2, HLT - TAD% PTR /Get word - DCA STEMP /Save - TAD STEMP - RTR - RTR - RTR /First sixbit - JMS OUTONE /Convert and output it - TAD STEMP /Second sixbit - JMS OUTONE - ISZ PTR /Bump pointer - SKP /OK if no skip - JMP NEWFLD /Next field otherwise -INCCNT, ISZ COUNT - JMP CDF2 /Keep outputting -DONE, CLA - TAD CRFLAG /Suppress trailing CR? - RTR /2 bit suppresses trailing CR - SZL CLA /If zero, write it. - JMP OUT /Yes, leave now - CDF 10 /My field - TAD CRTN - JMS% TTYPTR+1 -OUT, CIF CDF 0 - JMP% SIX8 - -NEWFLD, TAD CDF1 - TAD K10 /Next field - DCA CDF1 - TAD CDF1 - DCA CDF2 - JMP INCCNT - -OUTONE, 0 - AND K77 /Mask - SNA - JMP DONE / End of string - TAD K7743 / minus '[' - SNA - JMP SETLWR /Set to lowercase shift - TAD K2 / ok, ']'? - SNA - JMP SETUPR /Set to uppercase - TAD K7773 /Restore - SPA - TAD SHIFT /For positive, shift it - TAD K40 /Else it's not alphabetic - CDF 10 /My field - JMS% TTYPTR+1 /Output it - JMP% OUTONE /Done - -SETLWR, TAD K40 /Reset shift -SETUPR, TAD HUN /For upper/lower - DCA SHIFT - JMP% OUTONE - -TTYPTR, ADDR TTY -SHIFT, 140 /Shift value -/ COUNT and CRFLAG must stay together -COUNT, 0 /Num words to output. -CRFLAG, 0 /1 - no leading LF, 2 no trailing CR -PTR, 0 -CRTN, 15 -LF, 12 -K3740, 3740 /minus blank -BUF, 0;0;0 /Buffer 15-bit address -STEMP, 0 -K77, 77 /sixbit mask -K7, 7 -K4, 4 -K40, 40 -CDF0, CDF -HUN, 100 -K7743, 7743 -K7773, 7773 -K10, 10 /Field increment -K2, 2 - - SECT SPEAK -/C -/ SUBROUTINE SPEAK(N) -/C -/C PRINT THE MESSAGE IN RECORD N OF THE RANDOM ACCESS MESSAGE FILE. -/C -/ IMPLICIT INTEGER (A-Z) -/ COMMON /TXTCOM/ RTEXT,LINES,ASCVAR -/ COMMON /ALPHAS/ BLANK,EOF -/ DIMENSION RTEXT(205),LINES(36) -/C - EXTERN IO - EXTERN #HANG - JA #ST -#XR, ORG .+10 - TEXT +SPEAK+ -#RET, SETX #XR - SETB #BASE - JA .+3 -#BASE, ORG .+6 -N, ORG .+3 -#DOTMP, ORG .+3 -BLANK, TEXT + + -EOF, TEXT +>$< + -ONE, F 1.0 -FOUR, F 4.0 - ORG #BASE+30 - FNOP - JA #RET - FNOP -#GOBAK, 0;0 -I, ORG .+0003 -L, ORG .+0003 -OLDLOC, ORG .+0003 - #LBL=. - COMMON TXTCOM -RTEXT, ORG .+1147 -LINES, ORG .+0044 -ASCVAR, ORG .+0003 -TXTLOC, ORG .+0003 -DATA, ORG .+0352 - ORG #LBL -#RTN, BASE #BASE - JA #GOBAK -#ST, STARTD - 0210 - FSTA #GOBAK,0 - 0200 - SETX #XR - SETB #BASE - LDX 0,1 - FSTA #BASE - FLDA% #BASE,1+ - FSTA N - STARTF -/ IF(N.EQ.0)RETURN - FLDA% N - JEQ #RTN -/ READ(2'N) LOC,LINES - FLDA N - STARTD - FSTA #G0002 - STARTF - JSR IO - JA .+0004 -#G0002, JA . -/ IF(LINES(1).EQ.EOF)RETURN - FLDA ONE - ATX 7 - FLDA LINES-0003,7 - FSUB EOF - JEQ #RTN -/1 OLDLOC = LOC -#1, FLDA TXTLOC - FSTA OLDLOC - FLDA ONE - FSTA I - -/ DO 3 I=36,1,-1 -/ Set COUNT to the number of words (36 or 44 octal) - SETX COUNT - LDX 44,0 /44 words - LDX 0,1 /With carriage control - SETX #XR -/ L=I -/3 CONTINUE -/5 TYPE 2,(LINES(I),I=1,L) -#5, FLDA LINEPT - FSTA BUF /Set buffer pointer - TRAP4 SIX8 - - FLDA% N - FADD ONE - FSTA% N - FLDA N -/ READ(2'ASCVAR) LOC,LINES - STARTD - FSTA #G0006 - STARTF - JSR IO - JA .+0004 -#G0006, JA . -/ IF(LOC .EQ. OLDLOC) GO TO 1 - FLDA TXTLOC - FSUB OLDLOC - JEQ #1 - EXTERN #WRITO - TRAP3 #WRITO - JA FOUR - JA #10+2 - EXTERN #RENDO - TRAP3 #RENDO - -/10 RETURN -#10, JA #RTN -/ (1X) - 5061 - 3051 -/2 FORMAT(' ',36A2) PDP/8: (' ',12A6) -LINEPT, ADDR LINES - 0 - END