.FUNCT INT-NO-INSERT,RTN,E,C,INT=0 ADD C-TABLE,C-TABLELEN >E ADD C-TABLE,C-INTS >C ?PRG1: EQUAL? C,E /FALSE GET C,C-RTN EQUAL? STACK,RTN \?CND3 RETURN C ?CND3: ADD C,C-INTLEN >C JUMP ?PRG1 .FUNCT QUEUED?,RTN,C CALL2 INT-NO-INSERT,RTN >C ZERO? C /FALSE GET C,C-TICK ZERO? STACK /FALSE RETURN C .FUNCT RUNNING?,RTN,C,TICK CALL2 INT-NO-INSERT,RTN >C ZERO? C /FALSE GET C,C-TICK >TICK ZERO? TICK /FALSE GRTR? TICK,1 /FALSE RETURN C .FUNCT PICK-ONE,FROB,L,CNT,RND,MSG,RFROB GET FROB,0 >L GET FROB,1 >CNT DEC 'L ADD FROB,2 >FROB MUL CNT,2 ADD FROB,STACK >RFROB SUB L,CNT RANDOM STACK >RND GET RFROB,RND >MSG GET RFROB,1 PUT RFROB,RND,STACK PUT RFROB,1,MSG INC 'CNT EQUAL? CNT,L \?CND1 SET 'CNT,0 ?CND1: PUT FROB,0,CNT RETURN MSG .FUNCT SPRINT,OBJ LESS? OBJ,10 \?ELS3 PRINTI " " JUMP ?CND1 ?ELS3: LESS? OBJ,100 \?ELS7 PRINTI " " JUMP ?CND1 ?ELS7: LESS? OBJ,1000 \?CND1 PRINTI " " ?CND1: PRINTN OBJ RTRUE .FUNCT DPRINT,OBJ GETP OBJ,P?MDESC ZERO? STACK /?ELS5 PRINTI "MESSAGE." GETP OBJ,P?MDESC GET STACK,0 PRINTN STACK PRINTI "/" GETP OBJ,P?MDESC GET STACK,1 PRINTN STACK PRINTI "/" GETP OBJ,P?MDESC GET STACK,2 PRINTN STACK PRINTI "." GETP OBJ,P?MDESC GET STACK,3 CALL2 TIME-PRINT,STACK RSTACK ?ELS5: GETP OBJ,P?SDESC ZERO? STACK /?ELS9 GETP OBJ,P?SDESC PRINT STACK RTRUE ?ELS9: PRINTD OBJ RTRUE .FUNCT GO START:: ?FCN: SUB TIME,1 >LAST-ABE-TIME CALL QUEUE,I-PERELMAN,-1 CALL QUEUE,I-MESSAGE-C,28 CALL QUEUE,I-MESSAGE-Y,1373 PUTB P-LEXV,0,59 SET 'WINNER,PLAYER SET 'HERE,COMM-ROOM SET 'MODE,COMM-MODE SET 'FEED-BUFFER,NEWS-BUFFER CALL2 NAME-MESSAGE,MESSAGE-B CALL2 CHAPTER-PRINT,1 CRLF CRLF CRLF CRLF CALL2 PRINT-SPACES,22 PRINTI """Tomorrow never yet" CRLF CALL2 PRINT-SPACES,23 PRINTI "On any human being rose or set.""" CRLF CALL2 PRINT-SPACES,39 PRINTI "-- William Marsden" CRLF CRLF CRLF CRLF CRLF CALL1 CONTINUE CALL2 INIT-STATUS-LINE,2 CALL1 STATUS-LINE PRINTI "You ""hear"" a message coming in on the official message line: " GETP MESSAGE-B,P?TEXT PRINT STACK CRLF CRLF CALL1 V-VERSION CRLF CALL1 V-LOOK CALL1 MAIN-LOOP JUMP ?FCN .FUNCT MAIN-LOOP,TRASH ?PRG1: CALL1 MAIN-LOOP-1 >TRASH JUMP ?PRG1 .FUNCT MAIN-LOOP-1,ICNT,OCNT,NUM,CNT,OBJ,TBL,V,PTBL,OBJ1,TMP,NOT-HERE,?TMP1 SET 'ELAPSED-TIME,1 SET 'INCREMENT-WAIT,FALSE-VALUE SET 'STOP-WAIT,FALSE-VALUE SET 'CNT,0 SET 'OBJ,FALSE-VALUE SET 'PTBL,TRUE-VALUE CALL1 PARSER >P-WON ZERO? P-WON /?ELS3 GET P-PRSI,P-MATCHLEN >ICNT GET P-PRSO,P-MATCHLEN >OCNT ZERO? P-IT-OBJECT /?CND4 CALL2 ACCESSIBLE?,P-IT-OBJECT ZERO? STACK /?CND4 SET 'TMP,FALSE-VALUE ?PRG9: IGRTR? 'CNT,ICNT \?ELS13 JUMP ?REP10 ?ELS13: GET P-PRSI,CNT EQUAL? STACK,IT \?PRG9 PUT P-PRSI,CNT,P-IT-OBJECT SET 'TMP,TRUE-VALUE ?REP10: ZERO? TMP \?CND19 SET 'CNT,0 ?PRG22: IGRTR? 'CNT,OCNT \?ELS26 JUMP ?CND19 ?ELS26: GET P-PRSO,CNT EQUAL? STACK,IT \?PRG22 PUT P-PRSO,CNT,P-IT-OBJECT ?CND19: SET 'CNT,0 ?CND4: ZERO? OCNT \?ELS36 PUSH OCNT JUMP ?CND32 ?ELS36: GRTR? OCNT,1 \?ELS38 SET 'TBL,P-PRSO ZERO? ICNT \?ELS41 SET 'OBJ,FALSE-VALUE JUMP ?CND39 ?ELS41: GET P-PRSI,1 >OBJ ?CND39: PUSH OCNT JUMP ?CND32 ?ELS38: GRTR? ICNT,1 \?ELS45 SET 'PTBL,FALSE-VALUE SET 'TBL,P-PRSI GET P-PRSO,1 >OBJ PUSH ICNT JUMP ?CND32 ?ELS45: PUSH 1 ?CND32: SET 'NUM,STACK ZERO? OBJ \?CND48 EQUAL? ICNT,1 \?CND48 GET P-PRSI,1 >OBJ ?CND48: EQUAL? PRSA,V?WALK \?ELS55 PRINTI "[Calling PERFORM, PRSA = V-WALK.]" CRLF CALL PERFORM,PRSA,PRSO >V JUMP ?CND53 ?ELS55: ZERO? NUM \?ELS57 GETB P-SYNTAX,P-SBITS BAND STACK,P-SONUMS ZERO? STACK \?ELS60 CALL2 PERFORM,PRSA >V SET 'PRSO,FALSE-VALUE JUMP ?CND53 ?ELS60: PRINTI "There isn't anything to " GET P-ITBL,P-VERBN >TMP EQUAL? PRSA,V?TELL \?ELS67 PRINTI "talk to" JUMP ?CND65 ?ELS67: ZERO? P-OFLAG \?THN72 ZERO? P-MERGED /?ELS71 ?THN72: GET TMP,0 PRINTB STACK JUMP ?CND65 ?ELS71: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK ?CND65: PRINTI "!" CRLF SET 'V,FALSE-VALUE CALL1 CLEAR-BUF JUMP ?CND53 ?ELS57: SET 'NOT-HERE,0 SET 'TMP,FALSE-VALUE ?PRG80: IGRTR? 'CNT,NUM \?ELS84 GRTR? NOT-HERE,0 \?ELS87 PRINTI "[The " EQUAL? NOT-HERE,NUM /?CND90 PRINTI "other " ?CND90: PRINTI "object" EQUAL? NOT-HERE,1 /?CND97 PRINTI "s" ?CND97: PRINTI " that you mentioned " EQUAL? NOT-HERE,1 /?ELS106 PRINTI "are" JUMP ?CND104 ?ELS106: PRINTI "is" ?CND104: PRINTI "n't here.]" CRLF JUMP ?REP81 ?ELS87: ZERO? TMP \?REP81 PRINT REFERRING CRLF JUMP ?REP81 ?ELS84: ZERO? PTBL /?ELS123 GET P-PRSO,CNT >OBJ1 SET 'PRSO,OBJ1 SET 'PRSI,OBJ JUMP ?CND121 ?ELS123: GET P-PRSI,CNT >OBJ1 SET 'PRSO,OBJ SET 'PRSI,OBJ1 ?CND121: GRTR? NUM,1 /?THN130 GET P-ITBL,P-NC1 GET STACK,0 EQUAL? STACK,W?ALL \?CND127 ?THN130: EQUAL? OBJ1,NOT-HERE-OBJECT \?ELS134 INC 'NOT-HERE JUMP ?PRG80 ?ELS134: EQUAL? P-GETFLAGS,P-ALL \?ELS136 CALL DONT-ALL?,PRSO,PRSI,PTBL ZERO? STACK /?ELS136 JUMP ?PRG80 ?ELS136: EQUAL? PRSA,V?TAKE \?ELS140 ZERO? PRSI /?ELS140 IN? PRSO,PRSI /?ELS140 JUMP ?PRG80 ?ELS140: CALL2 ACCESSIBLE?,OBJ1 ZERO? STACK \?ELS144 JUMP ?PRG80 ?ELS144: EQUAL? OBJ1,BUZZERS,BOOKS /?CND127 EQUAL? OBJ1,IT \?ELS149 PRINTD P-IT-OBJECT JUMP ?CND147 ?ELS149: PRINTD OBJ1 ?CND147: PRINTI ": " ?CND127: SET 'TMP,TRUE-VALUE CALL PERFORM,PRSA,PRSO,PRSI >V EQUAL? V,M-FATAL \?PRG80 JUMP ?CND53 ?REP81: ?CND53: PRINTI "[About to enter M-FATAL/NEWS predicate.]" CRLF EQUAL? V,M-FATAL \?THN160 EQUAL? HERE,NEWS \?CND157 ?THN160: PRINTI "[About to check whether ELAPSED-TIME is 0]" CRLF ZERO? ELAPSED-TIME /?CND157 GETP HERE,P?ACTION CALL STACK,M-END >V ?CND157: PRINTI "[About to check whether CLOCK-WAIT is false.]" CRLF ZERO? CLOCK-WAIT \?CND165 PRINTI "[About to call INCREMENT-TIME.]" CRLF CALL2 INCREMENT-TIME,ELAPSED-TIME PRINTI "[Returned from INCREMENT-TIME.]" CRLF ?CND165: EQUAL? V,M-FATAL \?CND1 SET 'P-CONT,FALSE-VALUE JUMP ?CND1 ?ELS3: SET 'P-CONT,FALSE-VALUE ?CND1: PRINTI "[About to check whether P-WON is true.]" CRLF ZERO? P-WON /FALSE ZERO? ELAPSED-TIME /?CND179 PRINTI "[About to call CLOCKER.]" CRLF CALL1 CLOCKER >V PRINTI "[Returning from CLOCKER.]" CRLF ?CND179: "[About to call STATUS-LINE.]" CRLF CALL1 STATUS-LINE SET 'PRSA,FALSE-VALUE SET 'PRSO,FALSE-VALUE SET 'PRSI,FALSE-VALUE RETURN PRSI .FUNCT DONT-ALL?,O,I,ALL-O?,LOCATION LOC O >LOCATION EQUAL? O,I /TRUE EQUAL? PRSA,V?TAKE \?ELS7 EQUAL? LOCATION,PLAYER,WINNER /TRUE FSET? O,TAKEBIT /?ELS14 FSET? O,TRYTAKEBIT \TRUE ?ELS14: ZERO? I /?ELS18 EQUAL? LOCATION,I \TRUE CALL2 SEE-INSIDE?,I ZERO? STACK /TRUE RFALSE ?ELS18: EQUAL? LOCATION,HERE,SHOWER /FALSE FSET? LOCATION,SURFACEBIT /FALSE FSET? LOCATION,ACTORBIT \TRUE RFALSE ?ELS7: EQUAL? PRSA,V?PUT-ON,V?PUT,V?DROP /?THN39 EQUAL? PRSA,V?THROW \?ELS38 ?THN39: EQUAL? LOCATION,PLAYER,WINNER \TRUE RFALSE ?ELS38: EQUAL? PRSA,V?SHUT-OFF,V?TURN-ON \FALSE EQUAL? HERE,INTERFACE-ROOM \FALSE EQUAL? WINNER,HVAC-CONTROLLER \?ELS56 EQUAL? I,ALPHA-SECTOR,BETA-SECTOR /FALSE EQUAL? I,GAMMA-SECTOR,DELTA-SECTOR \TRUE RFALSE ?ELS56: EQUAL? I,ALPHA-SECTOR \TRUE RFALSE .FUNCT FAKE-ORPHAN,TMP,?TMP1 CALL ORPHAN,P-SYNTAX,FALSE-VALUE PRINTI "[Be specific: what object do you want to " GET P-OTBL,P-VERBN >TMP ZERO? TMP \?ELS5 PRINTI "tell" JUMP ?CND3 ?ELS5: GETB P-VTBL,2 ZERO? STACK \?ELS9 GET TMP,0 PRINTB STACK JUMP ?CND3 ?ELS9: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK PUTB P-VTBL,2,0 ?CND3: SET 'P-OFLAG,TRUE-VALUE SET 'P-WON,FALSE-VALUE GETB P-SYNTAX,P-SPREP1 CALL2 PREP-PRINT,STACK PRINTR "?]" .FUNCT PERFORM,A,O=0,I=0,V=0,OA,OO,OI SET 'OA,PRSA SET 'OO,PRSO SET 'OI,PRSI SET 'PRSA,A EQUAL? IT,I,O \?CND1 ZERO? I \?ELS6 CALL1 FAKE-ORPHAN RETURN 2 ?ELS6: PRINT REFERRING CRLF RETURN 2 ?CND1: SET 'PRSO,O ZERO? PRSO /?CND13 EQUAL? PRSO,INTNUM /?CND13 EQUAL? PRSA,V?WALK /?CND13 EQUAL? PRSO,NOT-HERE-OBJECT /?CND13 SET 'P-IT-OBJECT,PRSO ?CND13: SET 'PRSI,I EQUAL? A,V?WALK /?ELS20 EQUAL? NOT-HERE-OBJECT,PRSO,PRSI \?ELS20 CALL D-APPLY,STR?1,NOT-HERE-OBJECT-F >V ZERO? V /?ELS20 SET 'P-WON,FALSE-VALUE JUMP ?CND18 ?ELS20: SET 'O,PRSO SET 'I,PRSI GETP WINNER,P?ACTION CALL D-APPLY,STR?2,STACK >V ZERO? V /?ELS27 JUMP ?CND18 ?ELS27: GETP HERE,P?ACTION CALL D-APPLY,STR?3,STACK,M-BEG >V ZERO? V /?ELS29 JUMP ?CND18 ?ELS29: GET PREACTIONS,A CALL D-APPLY,STR?4,STACK >V ZERO? V /?ELS31 JUMP ?CND18 ?ELS31: ZERO? I /?ELS33 GETP I,P?ACTION CALL D-APPLY,STR?5,STACK >V ZERO? V /?ELS33 JUMP ?CND18 ?ELS33: ZERO? O /?ELS37 EQUAL? A,V?WALK /?ELS37 GETP O,P?ACTION CALL D-APPLY,STR?6,STACK >V ZERO? V /?ELS37 JUMP ?CND18 ?ELS37: GET ACTIONS,A CALL D-APPLY,FALSE-VALUE,STACK >V ZERO? V /?CND18 ?CND18: SET 'PRSA,OA SET 'PRSO,OO SET 'PRSI,OI RETURN V .FUNCT D-APPLY,STR,FCN,FOO=0,RES ZERO? FCN /FALSE ZERO? FOO /?ELS12 CALL FCN,FOO JUMP ?CND8 ?ELS12: CALL FCN ?CND8: SET 'RES,STACK RETURN RES .FUNCT QUEUE,INTERRUPT-ROUTINE,TICK-NUMBER,CLOCKER-INT CALL2 INT,INTERRUPT-ROUTINE >CLOCKER-INT PUT CLOCKER-INT,C-TICK,TICK-NUMBER RETURN CLOCKER-INT .FUNCT INT,RTN,E,C,INT=0 ADD C-TABLE,C-TABLELEN >E ADD C-TABLE,C-INTS >C ?PRG1: EQUAL? C,E \?ELS5 ZERO? INT \?CND6 LESS? C-INTS,C-INTLEN \?CND9 PRINTI "Bug #25I" CRLF ?CND9: SUB C-INTS,C-INTLEN >C-INTS ADD C-TABLE,C-INTS >INT ?CND6: PUT INT,C-RTN,RTN RETURN INT ?ELS5: GET C,C-RTN EQUAL? STACK,RTN \?ELS15 RETURN C ?ELS15: ZERO? INT \?CND3 GET C,C-RTN ZERO? STACK \?CND3 SET 'INT,C ?CND3: ADD C,C-INTLEN >C JUMP ?PRG1 .FUNCT CLOCKER,C,E,TICK,RTN,FLG=0 ZERO? CLOCK-WAIT /?CND1 SET 'CLOCK-WAIT,FALSE-VALUE RFALSE ?CND1: ADD C-TABLE,C-INTS >C ADD C-TABLE,C-TABLELEN >E ?PRG5: EQUAL? C,E \?CND7 RETURN FLG ?CND7: GET C,C-RTN >RTN ZERO? RTN /?CND10 GET C,C-TICK >TICK EQUAL? TICK,-1 \?ELS18 CALL RTN ZERO? STACK /?CND10 SET 'FLG,TRUE-VALUE JUMP ?CND10 ?ELS18: SUB TICK,ELAPSED-TIME >TICK GRTR? TICK,0 \?ELS26 PUT C,C-TICK,TICK JUMP ?CND10 ?ELS26: PUT C,C-RTN,0 CALL RTN ZERO? STACK /?CND13 SET 'FLG,TRUE-VALUE ?CND13: ?CND10: ADD C,C-INTLEN >C JUMP ?PRG5 .FUNCT INCREMENT-TIME,X,TMP,?TMP1 ADD TIME,X >TIME GRTR? TIME,1439 \?CND1 SUB TIME,1440 >TIME INC 'DATE EQUAL? DATE,18 \?ELS6 SET 'FEED-BUFFER,REPORT-BUFFER JUMP ?CND4 ?ELS6: SET 'FEED-BUFFER,NEWS-BUFFER ?CND4: GRTR? DATE,28 \?CND9 EQUAL? DATE,32 /?THN19 EQUAL? MONTH,2 /?THN19 EQUAL? DATE,31 \?CND9 EQUAL? MONTH,4,6,9 /?THN19 EQUAL? MONTH,11 \?CND9 ?THN19: SET 'DATE,1 INC 'MONTH ?CND9: EQUAL? HERE,ROOF \?CND1 EQUAL? TIME,348 \?ELS26 CRLF PRINTI "The first glow of dawn appears on the horizon." CRLF JUMP ?CND21 ?ELS26: EQUAL? TIME,378 \?ELS30 CRLF PRINTI "The sun is now well above the horizon; day has begun." CRLF JUMP ?CND21 ?ELS30: EQUAL? TIME,1073 \?ELS34 CRLF PRINTI "The sky begins to darken as the sun sinks into the western sky." CRLF JUMP ?CND21 ?ELS34: EQUAL? TIME,1103 \?CND21 CRLF PRINTI "The last glow of dusk fades as nighttime falls across the rooftop." CRLF ?CND21: ?CND1: ZERO? SIMULATING /?CND41 SET 'TMP,STIME ADD STIME,X >STIME GRTR? STIME,1439 \?CND45 SUB STIME,1440 >STIME INC 'SDATE GRTR? SDATE,28 \?CND45 EQUAL? SDATE,32 /?THN58 EQUAL? SMONTH,2 /?THN58 EQUAL? SDATE,31 \?CND48 EQUAL? SMONTH,4,6,9 /?THN58 EQUAL? SMONTH,11 \?CND48 ?THN58: SET 'SDATE,1 INC 'SMONTH ?CND48: ?CND45: CALL1 CONVERT-SYEAR-TO-NUM >?TMP1 CALL1 CONVERT-SYEAR-TO-NUM GET SIM-LEVEL-TABLE,STACK ADD X,STACK PUT SIM-LEVEL-TABLE,?TMP1,STACK CALL1 TUBES-CLOSE? ZERO? STACK /?ELS62 CRLF PRINTI "A surly cop warns that curfew is approaching and hustles you out of the " PRINTD TUBE-STATION PRINTI "." CRLF CRLF EQUAL? HERE,RED-TUBECAR,BROWN-TUBECAR \?CND67 GET RED-TABLE,RED-POINTER MOVE PLAYER,STACK GET RED-TABLE,RED-POINTER >HERE ?CND67: CALL2 DO-WALK,P?UP JUMP ?CND60 ?ELS62: EQUAL? HERE,ROCKVIL-STADIUM \?CND60 EQUAL? SYEAR,2061,2071 \?CND60 GRTR? STIME,1154 \?ELS76 LESS? STIME,1200 \?ELS76 ZERO? INCREMENT-WAIT \?ELS76 SET 'INCREMENT-WAIT,TRUE-VALUE CRLF PRINTI "As the day's executions wind to a conclusion, the people in the stands begin heading toward the exits." CRLF JUMP ?CND60 ?ELS76: EQUAL? STIME,480 \?CND60 SET 'STOP-WAIT,TRUE-VALUE CRLF PRINTI "People begin gathering in the stands as the day's executions begin." CRLF ?CND60: EQUAL? SYEAR,2041,2081 /?CND41 GRTR? STIME,1260 \?ELS90 GRTR? TMP,1260 /?ELS90 CALL QUEUE,I-CURFEW,15 SET 'STOP-WAIT,TRUE-VALUE CALL2 SCORE,116 CRLF PRINTI "A surge of adrenal fear passes through you as sirens all around begin wailing, an audio sine wave announcing the beginning of curfew." CRLF JUMP ?CND85 ?ELS90: GRTR? STIME,420 \?CND85 GRTR? TMP,420 /?CND85 EQUAL? PRSA,V?SLEEP /?CND85 SET 'STOP-WAIT,TRUE-VALUE CRLF PRINTI "T" CALL1 END-CURFEW CRLF ?CND85: ?CND41: ZERO? RECORDING /FALSE EQUAL? HERE,LIVING-ROOM,KITCHEN /?THN110 EQUAL? HERE,BEDROOM,BATHROOM \?ELS109 ?THN110: PUT RECORDING-TABLE,16,1 JUMP ?CND107 ?ELS109: EQUAL? HERE,COURTHOUSE \?ELS113 PUT RECORDING-TABLE,10,1 JUMP ?CND107 ?ELS113: EQUAL? HERE,POWER-STATION \?CND107 PUT RECORDING-TABLE,4,1 ?CND107: EQUAL? SYEAR,2051 \?ELS118 SET '2051-RECORDED,TRUE-VALUE JUMP ?CND116 ?ELS118: EQUAL? SYEAR,2061 \?ELS120 SET '2061-RECORDED,TRUE-VALUE JUMP ?CND116 ?ELS120: EQUAL? SYEAR,2071 \?ELS122 SET '2071-RECORDED,TRUE-VALUE JUMP ?CND116 ?ELS122: EQUAL? SYEAR,2081 \?CND116 SET '2081-RECORDED,TRUE-VALUE ?CND116: GETP RECORD-BUFFER,P?SIZE >TMP ADD TMP,X PUTP RECORD-BUFFER,P?SIZE,STACK ZERO? SIMULATING /?CND125 SET 'RECORDINGS-INCLUDE-SIMULATION,TRUE-VALUE ?CND125: GETP RECORD-BUFFER,P?SIZE GRTR? STACK,45 \?ELS133 GRTR? TMP,45 /?ELS133 SOUND 1 CRLF PRINTR "WARNING: Record buffer is now half-full." ?ELS133: GETP RECORD-BUFFER,P?SIZE GRTR? STACK,90 \FALSE SET 'RECORDING,FALSE-VALUE PUTP RECORD-BUFFER,P?SIZE,90 SOUND 1 CRLF PRINTR "WARNING: Record buffer full. Auto-deactivation of record feature." .FUNCT TUBES-CLOSE? EQUAL? SYEAR,2041 /FALSE LESS? STIME,1250 /FALSE FSET? HERE,TUBEBIT /TRUE EQUAL? HERE,RED-TUBECAR \?ELS11 ZERO? RED-TUBECAR-IN-STATION \TRUE ?ELS11: EQUAL? HERE,BROWN-TUBECAR \FALSE ZERO? BROWN-TUBECAR-IN-STATION /FALSE RTRUE .FUNCT ITALICIZE,STR,NO-CAPS?=0,LEN,PTR=2,CHAR,SCRIPTING-ON=0 BUFOUT FALSE-VALUE BUFOUT TRUE-VALUE GET 0,8 BTST STACK,1 \?CND1 SET 'SCRIPTING-ON,TRUE-VALUE ?CND1: ZERO? SCRIPTING-ON /?CND4 DIROUT D-PRINTER-OFF ?CND4: DIROUT D-SCREEN-OFF DIROUT D-TABLE-ON,SL-BUFFER PRINT STR DIROUT D-TABLE-OFF ZERO? SCRIPTING-ON /?CND10 DIROUT D-PRINTER-ON ?CND10: EQUAL? PRSA,V?UNSCRIPT,V?SCRIPT /?CND14 DIROUT D-SCREEN-ON ?CND14: GET SL-BUFFER,0 ADD STACK,1 >LEN EQUAL? LEN,1 /TRUE GETB 0,18 ZERO? STACK /?THN24 GETB 0,1 BAND STACK,8 ZERO? STACK /?ELS23 ?THN24: HLIGHT H-ITALIC ?PRG26: GETB SL-BUFFER,PTR >CHAR EQUAL? CHAR,32 \?ELS30 HLIGHT H-NORMAL PRINTC 32 HLIGHT H-ITALIC JUMP ?CND28 ?ELS30: PRINTC CHAR ?CND28: EQUAL? PTR,LEN \?ELS35 JUMP ?REP27 ?ELS35: INC 'PTR JUMP ?PRG26 ?REP27: HLIGHT H-NORMAL RTRUE ?ELS23: ZERO? NO-CAPS? /?ELS39 PRINT STR RTRUE ?ELS39: ?PRG45: GETB SL-BUFFER,PTR >CHAR GRTR? CHAR,96 \?CND47 LESS? CHAR,123 \?CND47 SUB CHAR,32 >CHAR ?CND47: PRINTC CHAR EQUAL? PTR,LEN /TRUE INC 'PTR JUMP ?PRG45 .FUNCT CONVERT-SYEAR-TO-NUM SUB SYEAR,2041 DIV STACK,10 RSTACK .ENDI