Path: uunet!zephyr.ens.tek.com!tekred!saab!billr From: billr@saab.CNA.TEK.COM (Bill Randle) Newsgroups: comp.sources.games Subject: v09i093: adven - original adventure game in FORTRAN, Part05/08 Message-ID: <5632@tekred.CNA.TEK.COM> Date: 18 May 90 18:21:13 GMT Sender: news@tekred.CNA.TEK.COM Lines: 1794 Approved: billr@saab.CNA.TEK.COM Submitted-by: Chris Rende Posting-number: Volume 9, Issue 93 Archive-name: adven/Part05 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh 'bug.f' <<'END_OF_FILE' XC*** BUG X X SUBROUTINE BUG(NUM) X IMPLICIT INTEGER(A-Z) X XC THE FOLLOWING CONDITIONS ARE CURRENTLY CONSIDERED FATAL BUGS. NUMBERS < 20 XC ARE DETECTED WHILE READING THE DATABASE; THE OTHERS OCCUR AT "RUN TIME". XC 0 MESSAGE LINE > 70 CHARACTERS XC 1 NULL LINE IN MESSAGE XC 2 TOO MANY WORDS OF MESSAGES XC 3 TOO MANY TRAVEL OPTIONS XC 4 TOO MANY VOCABULARY WORDS XC 5 REQUIRED VOCABULARY WORD NOT FOUND XC 6 TOO MANY RTEXT OR MTEXT MESSAGES XC 7 TOO MANY HINTS XC 8 LOCATION HAS COND BIT BEING SET TWICE XC 9 INVALID SECTION NUMBER IN DATABASE XC 10 OUT OF ORDER LOCS OR RSPEAK ENTRIES. XC 11 ILLEGAL MOTION WORD IN TRAVEL TABLE XC 12 ** UNUSED **. XC 13 UNKNOWN OR ILLEGAL WORD IN ADJECTIVE TABLE. XC 14 ILLEGAL WORD IN PREP/OBJ TABLE XC 15 TOO MANY ENTRIES IN PREP/OBJ TABLE XC 16 OBJECT HAS CONDITION BIT SET TWICE XC 17 OBJECT NUMBER TOO LARGE XC 18 TOO MANY ENTRIES IN ADJECTIVE/NOUN TABLE. XC 20 SPECIAL TRAVEL (500>L>300) EXCEEDS GOTO LIST XC 21 RAN OFF END OF VOCABULARY TABLE XC 22 VERB CLASS (N/1000) NOT BETWEEN 1 AND 3 XC 23 INTRANSITIVE ACTION VERB EXCEEDS GOTO LIST XC 24 TRANSITIVE ACTION VERB EXCEEDS GOTO LIST XC 25 CONDITIONAL TRAVEL ENTRY WITH NO ALTERNATIVE XC 26 LOCATION HAS NO TRAVEL ENTRIES XC 27 HINT NUMBER EXCEEDS GOTO LIST XC 28 INVALID MONTH RETURNED BY DATE FUNCTION XC 29 ACTION VERB 'LEAVE' HAS NO OBJECT. XC 30 PREPOSITION FOUND IN UNEXPECTED TABLE XC 31 RECEIVED AN UNEXPECTED WORD TERMINATOR FROM A1TOA5 XC 32 TRYING TO PUT A CONTAINER INTO ITSELF (TRICKY!) XC 33 UNKNOWN WORD CLASS IN GETWDS XC 35 TRYING TO CARRY A NON-EXISTENT OBJECT X X PRINT 1, NUM X1 FORMAT (' FATAL ERROR, SEE SOURCE CODE FOR INTERPRETATION.'/ X 1 ' PROBABLE CAUSE: ERRONEOUS INFO IN DATABASE.'/ X 2 ' ERROR CODE =',I2/) X STOP X END END_OF_FILE if test 2133 -ne `wc -c <'bug.f'`; then echo shar: \"'bug.f'\" unpacked with wrong size! fi # end of 'bug.f' fi if test -f 'getlin.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'getlin.f'\" else echo shar: Extracting \"'getlin.f'\" \(1932 characters\) sed "s/^X//" >'getlin.f' <<'END_OF_FILE' XC*** GETLIN X X SUBROUTINE GETLIN X XC SUCKS UP A LINE FROM THE TTY, THEN CALLS A1TOA5 TO SEPARATE XC OUT EACH WORD (AND MAKE SURE IT'S ALL UPPER CASE). THE TEXT OF XC EACH WORD IS MOVED INTO AN ARRAY (TXT(I,J), FOR HIGHER XC LEVEL ANALYSIS. A LINE IS TERMINATED XC WHEN A WORD=ZERO IS RETURNED. INTRA-LINE CLAUSE TERMINATORS, LIKE XC COMMA, PERIOD AND 'AND', ARE MOVED INTO THE TXT VECTOR AS 'AND'. XC AN UNEXPECTED TERMINATOR IS CAUSE FOR ALARM. XC THE ONLY OTHER PRE-PROCESSING THAT IS DONE IS TO FLUSH ALL XC OCCURRENCES OF "THE", "AN" AND "A". IF THE LINE ENDS WITH ANY XC OF THESE, AN ERROR MESSAGE IS PRINTED AND THE WHOLE LINE IS FLUSHED. X X IMPLICIT INTEGER(A-Z) X LOGICAL BLKLIN X COMMON /BLKCOM/ BLKLIN X REAL*8 TXT,WDS,KK X LOGICAL ACTIVE X INTEGER*4 MESSGS X COMMON/LNKCOM/ACTIVE(32),USER(15,32),MESSGS(32),MONITO(32), X 1 TEXT(70,32) X COMMON/WRUCOM/ME X COMMON /UTXCOM/ TXT(35,2),WDX X DIMENSION CHRS(70),WDS(2) X X10 DO 15 I=1,35 X DO 15 J=1,2 X15 TXT(I,J)=' ' X X20 IF(BLKLIN)PRINT 1 X1 FORMAT() X X X30 READ (1,50)CHRS X50 FORMAT(70A1) X IF(MONITO(ME).EQ.0)GOTO 40 X CALL SEM$WT(MONITO(ME),CODE) X DO 31 I=1,70 X31 TEXT(I,ME)=CHRS(I) X MESSGS(ME)=-1 X40 CINDEX=1 X WDX=0 X100 CALL A1TOA5(CHRS,CINDEX,WDS,TERM) X IF((TERM.EQ.'; '.OR.TERM.EQ.0).AND.WDX.EQ.0)GOTO 20 X KK=WDS(1) X IF(KK.NE.'THE '.AND.KK.NE.'AN '.AND.KK.NE.'A ') X 1 GOTO 110 X IF(TERM.EQ.' ')GOTO 100 X LL=CONFUZ(0) X CALL RSPEAK(LL) X GOTO 10 X X110 IF(WDS(1).EQ.' ')GOTO 120 X WDX=WDX+1 X TXT(WDX,1)=WDS(1) X TXT(WDX,2)=WDS(2) X120 IF(TERM.EQ.' ')GOTO 100 X IF(TERM.EQ.0.OR.TERM.EQ.'; ')RETURN X IF(TERM.NE.', '.AND.TERM.NE.'. ')CALL BUG(31) X WDX=WDX+1 X TXT(WDX,1)='AND ' X TXT(WDX,2)=0 X GOTO 100 X X END END_OF_FILE if test 1932 -ne `wc -c <'getlin.f'`; then echo shar: \"'getlin.f'\" unpacked with wrong size! fi # end of 'getlin.f' fi if test -f 'log.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'log.f'\" else echo shar: Extracting \"'log.f'\" \(1253 characters\) sed "s/^X//" >'log.f' <<'END_OF_FILE' XC*** LOG X X SUBROUTINE LOG(SCORE,TURNS,NUMDIE) X IMPLICIT INTEGER(A-Z) X$INSERT SYSCOM>A$KEYS X DIMENSION DDD(8),TTT(4),VEC(15) X LOGICAL ACTIVE X INTEGER*4 MESSGS X COMMON/LNKCOM/ACTIVE(32),USER(15,32),MESSGS(32),MONITO(32), X 1 TEXT(70,32) X COMMON/WRUCOM/ME X X DIMENSION FILE(11),PART1(3),PART2(3) X DATA FILE/'GRIPE GAME.LOG '/ X DATA PART1/:157763,:177755,:173777/,PART2/:166755,:163763, X 1 :165676/ X ERCNT=0 X CALL DATE$A(DDD) X CALL TIME$A(TTT) X CALL TIMDAT(VEC,15) X100 FILE(4)=AND(PART1(1),PART2(1)) X FILE(5)=AND(PART1(2),PART2(2)) X FILE(6)=AND(PART1(3),PART2(3)) X IF(.NOT.OPEN$A(A$WRIT,'ADVENTURE>GAME.LOG',18,10))GOTO 200 X CALL GEND$A(10) X X WRITE (14,102)(VEC(I),I=13,15),DDD,TTT,SCORE,TURNS,NUMDIE X102 FORMAT(/1X,3A2,' finished his tour at ',8A2,' ',4A2, X 2/8X,I3,' points; ',I4,' Turns; ',I1,' Reincarnations.') X CALL CLOS$A(10) X1001 ACTIVE(ME)=.FALSE. X DO 1002 I=4,6 X1002 FILE(I)=' ' X CALL BREAK$(.FALSE.) X RETURN X X200 ERCNT=ERCNT+1 X IF(ERCNT.GT.2)GOTO 1001 X PRINT 202,ERCNT X202 FORMAT(/' LOG FILE BLOCKED. WAIT...(',I1,')') X CALL SLEEP$(0002000) X GOTO 100 X X END END_OF_FILE if test 1253 -ne `wc -c <'log.f'`; then echo shar: \"'log.f'\" unpacked with wrong size! fi # end of 'log.f' fi if test -f 'main.f.2' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'main.f.2'\" else echo shar: Extracting \"'main.f.2'\" \(36906 characters\) sed "s/^X//" >'main.f.2' <<'END_OF_FILE' XC NOW WE KNOW WHAT'S HAPPENING. LET'S TELL THE POOR SUCKER ABOUT IT. X X IF(DTOTAL.EQ.0)GOTO 2000 X IF(DTOTAL.EQ.1)GOTO 75 X PRINT 67,DTOTAL X67 FORMAT(/' There are ',I1,' threatening little dwarves in the' X 1 ,' room with you!') X GOTO 77 X75 CALL RSPEAK(4) X77 IF(ATTACK.EQ.0)GOTO 2000 X IF(DFLAG.EQ.2)DFLAG=3 XC IF SAVED NOT = -1, HE BYPASSED THE "START" CALL. DWARVES GET *VERY* MAD! X IF(SAVED.NE.-1)DFLAG=20 X IF(ATTACK.EQ.1)GOTO 79 X PRINT 78,ATTACK X78 FORMAT(/' ',I1,' of them throw knives at you!') X K=6 X82 IF(STICK.GT.1)GOTO 83 X CALL RSPEAK(K+STICK) X IF(STICK.EQ.0)GOTO 2000 X GOTO 84 X83 PRINT 68,STICK X68 FORMAT(/' ',I1,' of them get you!') X84 OLDLC2=LOC X GOTO 94100 X X79 CALL RSPEAK(5) X K=52 X GOTO 82 XC DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND. X XC PRINT TEXT FOR CURRENT LOC. X X2000 IF(LOC.EQ.0)GOTO 94100 X JKK=STEXT(LOC) X IF(VERB.EQ.LOOK.OR.JKK.EQ.0.OR. X 1 (.NOT.TERSE.AND.MOD(ABB(LOC),ABBNUM).EQ.0) )JKK=LTEXT(LOC) X IF((FORCED(LOC).OR..NOT.DARK(0)).AND.LOC.NE.200)GOTO 2001 X IF(LOC.NE.200.AND. (DARK(0).OR.PROP(LAMP).EQ.0 X 1 .OR..NOT.ATHAND(LAMP)) )GOTO 2003 X IF(PROP(LAMP).EQ.0.OR..NOT.ATHAND(LAMP))GOTO 2020 X IF(PCT(35))GOTO 94000 X JKK=RTEXT(294) X GOTO 2020 X X2003 IF(WZDARK.AND.PCT(35))GOTO 94000 X JKK=RTEXT(16) X2001 IF(HOLDNG(BEAR).AND..NOT.DARK(0))CALL RSPEAK(141) X2020 CALL SPEAK(JKK) X K=1 X ABB(LOC)=ABB(LOC)+1 X IF(.NOT.FORCED(LOC))GOTO 2022 X CALL TRAVL(K) X IF(KILLED)GOTO 94100 X GOTO 2 X X2022 ABB(LOC)=ABB(LOC)-1 X IF(LOC.EQ.Y2.AND.PCT(25).AND..NOT.CLOSNG)CALL RSPEAK(8) X IF(LOC.EQ.147.AND.ABB(LOC).EQ.1)CALL RSPEAK(216) X XC SEE IF HE IS WASTING HIS BATTERIES OUT IN THE OPEN. X K=0 X IF(.NOT.OUTSID(LOC).OR.PROP(LAMP).EQ.0)GOTO 2030 X K=WASTE+1 X IF(K.LE.12)GOTO 2030 X CALL RSPEAK(324) X K=0 X2030 WASTE=K X XC IF WUMPUS IS CHASING STOOGE, SEE IF WUMPUS GETS HIM. X IF(CHASE.EQ.0)GOTO 2040 X CHASE=CHASE+1 X KK=CHASE/2 X PROP(WUMPUS)=KK X CALL MOVE(WUMPUS,LOC) X IF(KK.LT.5)GOTO 2040 X IF(DARK(0))CALL RSPEAK(270) X CALL PSPEAK(WUMPUS,5) X GOTO 94100 X XC CHECK FOR RADIATION POISONING. X2040 K=1 X IF(OUTSID(LOC))K=3 X HEALTH=MIN0(HEALTH+1,100) X IF(.NOT.HERE(RADIUM).OR. X 1 (PLACE(RADIUM).EQ.-SHIELD.AND..NOT.AJAR(SHIELD)) )GOTO 2045 X HEALTH=HEALTH-K-7 X IF(HEALTH.GE.60)GOTO 2045 X CALL RSPEAK(391+(60-HEALTH)/10) X IF(HEALTH.LE.0)GOTO 94100 XC PRINT OUT DESCRIPTIONS OF OBJECTS AT THIS LOCATION. IF NOT CLOSING AND XC PROPERTY VALUE IS NEGATIVE, TALLY OFF ANOTHER TREASURE. RUG IS SPECIAL XC CASE; ONCE SEEN, ITS PROP IS 1 (DRAGON ON IT) TILL DRAGON IS KILLED. XC SIMILARLY FOR CHAIN; PROP IS INITIALLY 1 (LOCKED TO BEAR). XC LIKEWISE, FOR SWORD (MUST PROVE ELFIN ROYALTY). X X2045 IF(OLDLOC.NE.188.OR.LOC.EQ.189.OR.LOC.EQ.188 X 1 .OR.PROP(BOOTH).NE.1)GOTO 2021 X CALL MOVE(GNOME,0) X PROP(BOOTH)=0 X2021 IF(BLIND(0))GOTO 2100 X ABB(LOC)=ABB(LOC)+1 X I=ATLOC(LOC) X2004 IF(I.EQ.0)GOTO 2100 X OBJ=I X IF(OBJ.GT.MAXOBJ)OBJ=OBJ-MAXOBJ X IF(OBJ.EQ.STEPS.AND.TOTING(NUGGET))GOTO 2008 X IF(PROP(OBJ).GE.0)GOTO 2006 X IF(CLOSED)GOTO 2008 X PROP(OBJ)=0 X IF(OBJ.EQ.RUG.OR.OBJ.EQ.CHAIN.OR.OBJ.EQ.SWORD X 1 .OR.OBJ.EQ.CASK)PROP(OBJ)=1 X IF(OBJ.EQ.CLOAK.OR.OBJ.EQ.RING)PROP(OBJ)=2 X TALLY=TALLY-1 XC IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP. X IF(TALLY.EQ.TALLY2.AND.TALLY.NE.0)LIMIT=MIN0(35,LIMIT) X2006 KK=PROP(OBJ) X IF(OBJ.EQ.STEPS.AND.LOC.EQ.FIXED(STEPS))KK=1 X CALL PSPEAK(OBJ,INTS(KK)) X CALL LOOKIN(OBJ) X2008 I=LINK(I) X GOTO 2004 X XC "I DON'T UNDERSTAND THAT!" X2060 SPK=CONFUZ(0) X GOTO 2011 X XC "YOU CAN'T DO THAT!" (AN IMPOSSIBLE ACT, E.G., "OPEN SWORD", "FEED BOAT", ET X2070 SPK=NOWAY(0) X GOTO 2011 X X2009 SPK=54 X2011 IF(OBJ.EQ.0.OR.(OBJS(2).EQ.0.AND.IOBJS(2).EQ.0))GOTO 2015 X CALL PSPEAK(OBJ,-1) X CALL TNOUA(' ',5) X BLKLIN=.FALSE. X2015 CALL RSPEAK(SPK) X BLKLIN=.TRUE. X X2100 RDFLAG=.FALSE. X IF(OBJX.EQ.0)GOTO 2110 X OBJX=OBJX+1 X IF(OBJS(OBJX).EQ.0)OBJX=0 X2110 IF(OBJX.GT.0.AND.OBJS(OBJX).NE.0)GOTO 2120 X IF(IOBX.EQ.0)GOTO 2120 X IOBX=IOBX+1 X IF(IOBJS(IOBX).EQ.0)IOBX=0 X IF(IOBX.NE.0.AND.OBJS(1).NE.0)OBJX=1 X X2120 IF(OBJX.GT.0.OR.IOBX.GT.0)GOTO 2600 X IF(OBJS(1).NE.0)OBJX=1 X IF(IOBJS(1).NE.0)IOBX=1 X VRBX=VRBX+1 X IF(VERBS(VRBX).NE.0)GOTO 2600 X CALL CLRLIN X RDFLAG=.TRUE. X XC CHECK IF THIS LOC IS ELIGIBLE FOR ANY HINTS. IF BEEN HERE LONG ENOUGH, XC BRANCH TO HELP SECTION (ON LATER PAGE). HINTS ALL COME BACK HERE EVENTUALLY XC TO FINISH THE LOOP. IGNORE "HINTS" < HNTMIN (SPECIAL STUFF, SEE DATABASE XC NOTES). X X2600 DO 2602 HINT=HNTMIN,HNTMAX X IF(HINTED(HINT))GOTO 2602 X IF(AND(LOCCON(LOC),BITS(HINT)).EQ.0)HINTLC(HINT)=-1 X HINTLC(HINT)=HINTLC(HINT)+1 X IF(HINTLC(HINT).GE.HINTS(HINT,1))GOTO 40000 X2602 CONTINUE XC gotta add 2603 as we want to "GO TO" here, but compiler XC doesn't like it when we try to goto 2602 as it is part of a loop. X2603 CONTINUE X XC KICK THE RANDOM NUMBER GENERATOR JUST TO ADD VARIETY TO THE CHASE. ALSO, XC IF CLOSING TIME, CHECK FOR ANY OBJECTS BEING TOTED WITH PROP < 0 AND SET XC THE PROP TO -1-PROP. THIS WAY OBJECTS WON'T BE DESCRIBED UNTIL THEY'VE XC BEEN PICKED UP AND PUT DOWN SEPARATE FROM THEIR RESPECTIVE PILES. DON'T XC TICK CLOCK1 UNLESS WELL INTO CAVE (AND NOT AT Y2). X X IF(.NOT.CLOSED)GOTO 2605 X IF(PROP(OYSTER).LT.0.AND.TOTING(OYSTER)) X 1 CALL PSPEAK(OYSTER,1) X DO 2604 I=1,MAXOBJ X2604 IF(TOTING(I).AND.PROP(I).LT.0)PROP(I)=-1-PROP(I) X2605 WZDARK=DARK(0) X IF(KNFLOC.GT.0.AND.KNFLOC.NE.LOC)KNFLOC=0 X I=RAN(1) X IF(.NOT.RDFLAG)GOTO 2608 X XC GET A NEW INPUT CLAUSE, OR FINISH GETTING CURRENT ONE. X X CALL GETWDS X VRBX=1 X OBJX=0 X IF(OBJS(1).NE.0)OBJX=1 X IOBX=0 X IF(IOBJS(1).NE.0)IOBX=1 X RDFLAG=.TRUE. X XC EVERY INPUT, CHECK "FOOBAR" FLAG. IF ZERO, NOTHING'S GOING ON. IF POS, XC MAKE NEG. IF NEG, HE SKIPPED A WORD, SO MAKE IT ZERO. X X2608 FOOBAR=MIN0(0,-FOOBAR) X COMBO=MIN0(0,-COMBO) X TURNS=TURNS+1 X IF(DEMO.AND.TURNS.GE.SHORT)GOTO 92800 X IF(LOGOUT(0))GOTO 92800 XC IF(TURNS.EQ.3)CALL DATIME(XXD,XXT) XC IF(TURNS.NE.45)GOTO 2609 XC SEE IF TIMER UUO HAS BEEN ZAPPED; IF SO, HE'S CHEATING. XC FLUSHING THIS FOR NOW. EATS CPU IN PA1050. [D. LONG] XC CALL DATIME(YYD,YYT) XC IF(XXD.EQ.YYD.AND.XXT.EQ.YYT)SAVED=0 X2609 IF(TURNS.EQ.310.AND.ABBNUM.NE.10000.AND..NOT.TERSE) X 1 CALL RSPEAK(273) X XC BUMP ALL THE RIGHT CLOCKS FOR RECONNING BATTERY LIFE AND CLOSING. X X IF(CLOSED)CLOCK3=CLOCK3-1 X IF(CLOCK3.EQ.-7)GOTO 93300 X IF(CLOCK3.NE.0)GOTO 2621 X PROP(PHONE)=0 X PROP(BOOTH)=0 X CALL RSPEAK(284) X2621 IF(TALLY.EQ.0.AND.INSIDE(LOC).AND.LOC.NE.Y2)CLOCK1=CLOCK1-1 X IF(CLOCK1.EQ.0)GOTO 90000 X IF(CLOCK1.LT.0)CLOCK2=CLOCK2-1 X IF(CLOCK2.EQ.0)GOTO 91000 XC IF(PROP(LAMP).EQ.1)LIMIT=LIMIT-1 X IF(LIMIT.EQ.0)GOTO 92400 X IF(LIMIT.LT.0.AND.OUTSID(LOC))GOTO 92600 X IF(LIMIT.LE.40)GOTO 92000 X X19999 VERB=VAL(VERBS(VRBX)) X OBJ=0 X IF(OBJX.NE.0)OBJ=OBJS(OBJX) X IOBJ=0 X IF(IOBX.NE.0)IOBJ=IOBJS(IOBX) X IF(KNFLOC.NE.LOC.OR.(OBJ.NE.KNIFE.AND.IOBJ.NE.KNIFE))GOTO 19998 X KNFLOC=-1 X SPK=116 X GOTO 2011 X X19998 GOTO (2750,2700,4000,2710), CLASS(VERBS(VRBX)) X2700 CALL BUG(22) X X2710 SPK=VERB X GOTO 2011 X XC IT IS A MOTION VERB. ANALYZE IT & LOOP TO 2, IF NOT DEAD. X2750 CALL TRAVL(VERB) X IF(KILLED)GOTO 94100 X GOTO 2 X XC ACTION VERB 'LEAVE' (DROP) HAS NO OBJECT. X3100 CALL BUG(29) X XC VERB 'SAY' OR 'YELL' SLIPPED THROUGH WITH AN OBJECT. X3200 CALL BUG(34) X XC ANALYSE A VERB. X4000 SPK=ACTSPK(VERB) X IF(OBJ.NE.0.OR.IOBJ.NE.0)GOTO 4090 X XC ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET). X X GOTO( X 9 10100,10000,10000,10400, 2009,10400,20700,20800,10000,10000, X 9 2011,21200,11300,11400,11500,10000,10000,11800,10000,12000, X 9 10000,12200,12300,12400,12500,12600,10000,10000,10000,13000, X 9 13100,10100,10000,10000,13500,23600, 3100,13800,10000,10000, X 9 10000,10000,10000,10100,10100,10100,10100,14800,10400,10400, X 9 25100,25200,25300,25400,25500,25600,25700,25800,25900),VERB XC 01-10 TAKE DROP SAY OPEN NOTH CLOSE ON OFF WAVE CALM XC 11-20 WALK KILL POUR EAT DRINK RUB THROW QUIT FIND INVEN XC 21-30 FEED FILL BLAST SCORE FOO BRIEF READ BREAK WAKE SUSPD XC 31-40 HOUR YANK WEAR HIT ANSWR BLOW LEAVE YELL DIAL PLAY XC 41-50 PICK PUT TURN GET INSRT REMOV BURN GRIPE LOCK UNLOK XC 51-60 HEALTH LOOK COMBO SWEEP TERSE WIZ MAP GATE PIRLOC X CALL BUG(23) X XC ANALYSE A TRANSITIVE VERB. X X4090 GOTO( X 9 20100,20200, 3200,20400, 2009,20600,20700,20800,20900, 2011, X 9 2011,21200,21300,21400,21500,21600,21700, 2011,21900,21900, X 9 22100,22200,12300, 2011, 2011,22600,22700,22800,22900, 2011, X 9 2011,23200,23300,23400,23500,23600,20200, 3200,23900,24000, X 9 24100,24200,24300,24400,24500,24600,24700, 2060,24900,25000, X 9 2060,25200, 2070,25400, 2060, 2060, 2060, 2060, 2060),VERB XC 01-10 TAKE DROP SAY OPEN NOTH CLOSE ON OFF WAVE CALM XC 11-20 WALK KILL POUR EAT DRINK RUB THROW QUIT FIND INVEN XC 21-30 FEED FILL BLAST SCORE FOO BRIEF READ BREAK WAKE SUSPD XC 31-40 HOUR YANK WEAR HIT ANSWR BLOW LEAVE YELL DIAL PLAY XC 41-50 PICK PUT TURN GET INSRT REMOV BURN GRIPE LOCK UNLOK XC 51-60 HEALTH LOOK COMBO SWEEP TERSE WIZ MAP GATE PIRLOC X CALL BUG(24) XC ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS X XC STATEMENT NUMBERS IN THIS SECTION ARE 10000 FOR INTRANSITIVE VERBS, 20000 FOR XC TRANSITIVE, PLUS 100 TIMES THE VERB NUMBER. MANY INTRANSITIVE VERBS USE THE XC TRANSITIVE CODE, AND SOME VERBS USE CODE FOR OTHER VERBS, AS NOTED BELOW. X XC RANDOM INTRANSITIVE VERBS COME HERE. CLEAR OBJ JUST IN CASE (SEE "ATTACK"). X X10000 CALL A5TOA1(VTXT(VRBX,1),VTXT(VRBX,2),'WHAT?',TK,K) X PRINT 10002,(TK(I),I=1,K) X10002 FORMAT(/' ',20A1) X OBJS(1)=0 X OBJX=0 X GOTO 2600 X X X10010 CALL A5TOA1(VTXT(VRBX,1),VTXT(VRBX,2),'it?',TK,K) X PRINT 10012,(TK(I),I=1,K) X10012 FORMAT(/' Where do you want to ',20A1) X GOTO 2600 X X XC CONSTRUCT MSG: "I DON'T KNOW HOW TO [VERB] THE [OBJ]", AND VARIANTS. X XC CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT. X X10100 IF(ATLOC(LOC).EQ.0.OR.LINK(ATLOC(LOC)).NE.0.OR.BLIND(0)) X 1 GOTO 10000 X L1=DWFMAX-1 X DO 10110 I=1,L1 X IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 10000 X10110 CONTINUE X OBJ=ATLOC(LOC) X IF(VERB.EQ.YANK)GOTO 23200 X IF(VERB.EQ.WEAR)GOTO 23300 X XC CARRY AN OBJECT. SPECIAL CASES FOR BIRD AND CAGE (IF BIRD IN CAGE, CAN'T XC TAKE ONE WITHOUT THE OTHER. LIQUIDS ALSO SPECIAL, SINCE THEY DEPEND ON XC STATUS OF BOTTLE. ALSO VARIOUS SIDE EFFECTS, ETC. XC "YANK" AND "WEAR" ALSO WEAVE INTO THIS CODE, SINCE THEY ARE MOSTLY XC JUST RESTRICTED CARRY'S. X X20100 IF(OBJ.EQ.BOAT)SPK=281 X IF(PLURAL(OBJ))SPK=297 X IF(PREP.NE.PREPOF)GOTO 20104 X IF(OBJ.NE.0.AND.IOBJ.NE.0)GOTO 2060 X IF(OBJ.EQ.0)OBJ=IOBJ X IOBJ=0 X GOTO 20200 X X20104 IF(HOLDNG(OBJ))GOTO 2011 X ASSIGN 20106 TO RETN X GOTO 20190 X X20106 IF(PREP.EQ.PREPIN)GOTO 24500 X IF(PREP.EQ.PREPFR.OR.ENCLSD(OBJ))GOTO 24600 X XC THE NEXT LINES ARE FOR 'TAKING' LIQUIDS (WATER, OIL & WINE). XC IF WE ARE HOLDING A CONTAINER (BOTTLE OR CASK), WE CAN TAKE THE XC THE LIQUID BY FILLING THE CONTAINER. IF THERE IS A CONTAINER NEARBY XC HOLDING THE REQUESTED LIQUID, WE WILL PICK UP THE CONTAINER. X X IF(IOBJ.EQ.0)GOTO 20110 X SPK=313 X IF(OBJ.NE.CASK.AND.OBJ.NE.BOTTLE)GOTO 2011 X K=0 X IF(OBJ.EQ.CASK)K=1 X IOBJ=IOBJ+K X IF(LIQ(OBJ).EQ.IOBJ)GOTO 20116 X SPK=302+K X IF(PROP(OBJ).NE.1)GOTO 2011 X GOTO 20118 X X20110 IF(OBJ.NE.WATER.AND.OBJ.NE.OIL.AND.OBJ.NE.WINE)GOTO 20120 X IOBJ=OBJ X K=0 X OBJ=BOTTLE X IF(.NOT.HERE(BOTTLE))GOTO 20114 X IF(PROP(BOTTLE).NE.1)GOTO 20112 X IF(.NOT.HERE(CASK).OR.(HERE(CASK).AND.PROP(CASK).EQ.1)) X 1 GOTO 20118 X OBJ=0 X CALL RSPEAK(304) X GOTO 2600 X X20112 IF(LIQ(BOTTLE).EQ.IOBJ)GOTO 20116 X20114 SPK=312 X IF(.NOT.HERE(CASK))GOTO 2011 X OBJ=CASK X K=1 X IF(PROP(CASK).EQ.1)GOTO 20118 X IF(LIQ(CASK).EQ.IOBJ)GOTO 20116 X SPK=315 X IF(.NOT.ATHAND(BOTTLE))SPK=303 X GOTO 2011 X X20116 IF(.NOT.HOLDNG(OBJ))GOTO 20120 X SPK=302+K X GOTO 2011 X X20118 IF(HOLDNG(OBJ))GOTO 22200 X GOTO 20120 XC *** END OF LIQUID STUFF X XC 'WEAR' AND 'YANK' WEAVE IN HERE. X X20120 SPK=343 X IF(OBJ.EQ.BEAR .OR. BURDEN(0)+BURDEN(OBJ).LE.15 )GOTO 20125 X SPK=92 X IF(.NOT.WEARNG(OBJ))GOTO 2011 X PROP(OBJ)=0 X CALL BITOFF(OBJ,WEARBT) X GOTO 2011 X XC CLOAK. BIG TROUBLE AHEAD. CAN ONLY GET HERE VIA 'YANK'. X20125 IF(OBJ.NE.CLOAK.OR.PROP(CLOAK).NE.2)GOTO 20130 X PROP(ROCKS)=1 X PROP(CLOAK)=0 X FIXED(CLOAK)=0 X CALL CARRY(CLOAK,LOC) X CALL RSPEAK(241) X IF(AT(WUMPUS).AND.PROP(WUMPUS).EQ.0)GOTO 22900 X GOTO 2100 X XC POSTER: HIDES WALL SAFE. X20130 IF(OBJ.NE.POSTER.OR.PLACE(SAFE).NE.0)GOTO 20160 X PROP(POSTER)=1 X SPK=362 XC MOVE SAFE AND WALL CONTAINING SAFE INTO VIEW. X CALL DROP(SAFE,LOC) X CALL DROP(WALL2,LOC) X GOTO 20180 X XC BOAT: NEED THE POLE TO PUSH IT X20160 IF(OBJ.NE.BOAT)GOTO 20165 X SPK=218 X IF(.NOT.TOTING(POLE).AND.PLACE(POLE).NE.-BOAT)GOTO 2011 X PROP(BOAT)=1 X SPK=221 X GOTO 20180 X XC BIRD: GOT TO HAVE CAGE, BUT ROD CAN'T BE AROUND TO TAKE BIRD X20165 IF(OBJ.NE.BIRD.OR.PROP(BIRD).NE.0)GOTO 20170 X SPK=26 X IF(ATHAND(ROD))GOTO 2011 X SPK=27 X IF(.NOT.HOLDNG(CAGE))GOTO 2011 X CALL INSERT(BIRD,CAGE) X CALL BITOFF(CAGE,OPENBT) X GOTO 2009 X XC SWORD: IF IN ANVIL, NEEDS CROWN & MUST YANK. X20170 IF(OBJ.NE.SWORD.OR.PROP(SWORD).EQ.0)GOTO 20180 X IF(IOBJ.NE.0.AND.IOBJ.NE.ANVIL)GOTO 2070 X IF(VERB.EQ.YANK)GOTO 20175 X XC HE WANTS THE SWORD, BUT HASN'T ESTABLISHED HIS ROYAL BLOOD, OR HE XC HASN'T PULLED HARD ENOUGH. OR NEITHER. X X IF(.NOT.YES(215,0,0))GOTO 2009 X20175 IF(WEARNG(CROWN))GOTO 20180 X CALL PSPEAK(SWORD,2) X IF(CLOSED)GOTO 93000 X FIXED(SWORD)=-1 X PROP(SWORD)=3 X GOTO 2100 X X20180 CALL CARRY(OBJ,LOC) X IF(OBJ.EQ.POLE.OR.OBJ.EQ.SKEY.OR.OBJ.EQ.SWORD X 1 .OR.((OBJ.EQ.CLOAK.OR.OBJ.EQ.RING) X 2 .AND..NOT.WEARNG(OBJ)) )PROP(OBJ)=0 X IF(VERB.NE.YANK.OR.OBJ.EQ.SWORD)GOTO 2011 X SPK=204 X GOTO 2011 X X XC THIS IS A QUASI-SUBROUTINE, CALLED FROM 'TAKE' AND FROM 'INSERT', WHEN XC THE ITEM IS NOT CURRENTLY BEING TOTED. 'RETN' IS A VARIABLE DEFINED XC TO BE THE RETURN ADDRESS. X X20190 SPK=NOWAY(0) X IF(OBJ.EQ.PLANT.AND.PROP(PLANT).LE.0)SPK=115 X IF(OBJ.EQ.BEAR.AND.PROP(BEAR).EQ.1)SPK=169 X IF(OBJ.EQ.CHAIN.AND.PROP(BEAR).NE.0)SPK=170 X IF(OBJ.EQ.SWORD.AND.PROP(SWORD).EQ.5)SPK=208 X IF(OBJ.EQ.CLOAK.AND.PROP(CLOAK).EQ.2)SPK=242 X IF(OBJ.EQ.AXE.AND.PROP(AXE).EQ.2)SPK=246 X IF(OBJ.EQ.PHONE)SPK=251 X IF(OBJ.EQ.BEES.OR.OBJ.EQ.HIVE)SPK=295 X IF(OBJ.EQ.STICKS)SPK=296 X IF(FIXED(OBJ).NE.0)GOTO 2011 X GOTO RETN XC DROP/DISCARD OBJECT. "THROW" ALSO COMES HERE FOR MOST OBJECTS. XC SPECIAL CASES FOR BIRD (MIGHT ATTACK SNAKE OR DRAGON) AND CAGE (MIGHT XC CONTAIN BIRD) AND VASE. XC DROP COINS IN VENDING MACHINE FOR EXTRA BATTERIES. X X20200 IF(HOLDNG(ROD2).AND.OBJ.EQ.ROD.AND..NOT.HOLDNG(ROD))OBJ=ROD2 X IF(PLURAL(OBJ))SPK=105 X K=LIQ(BOTTLE) X IF(K.EQ.OBJ)OBJ=BOTTLE X IF(OBJ.NE.BOTTLE)K=LIQ(CASK) X IF(OBJ.NE.BOTTLE.AND.K.EQ.OBJ)OBJ=CASK X IF(.NOT.TOTING(OBJ))GOTO 2011 X IF(PREP.EQ.PREPIN)GOTO 24500 X IF(OBJ.NE.BIRD.OR..NOT.HERE(SNAKE))GOTO 20220 X CALL RSPEAK(30) X IF(CLOSED)GOTO 93000 X CALL REMOVE(BIRD) X CALL DSTROY(SNAKE) XC SET SNAKE PROP FOR USE BY TRAVEL OPTIONS X PROP(SNAKE)=1 X CALL DROP(BIRD,LOC) X GOTO 2100 X X20220 SPK=344 X IF(VERB.EQ.LEAVE)SPK=353 X IF(VERB.EQ.THROW)SPK=352 X IF(VERB.EQ.TAKE)SPK=54 X IF(OBJ.NE.POLE.OR..NOT.HOLDNG(BOAT))GOTO 20240 X SPK=280 X GOTO 2011 X X20240 IF(OBJ.NE.BIRD.OR..NOT.AT(DRAGON).OR.PROP(DRAGON).NE.0) X 1 GOTO 20260 X CALL RSPEAK(154) X CALL REMOVE(BIRD) X CALL DSTROY(BIRD) X IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1 X GOTO 2100 X X20260 IF(OBJ.NE.BEAR.OR..NOT.AT(TROLL))GOTO 20270 X SPK=163 X CALL DSTROY(TROLL) X CALL DSTROY(TROLL+MAXOBJ) X CALL MOVE(TROLL2,PLAC(TROLL)) X CALL MOVE(TROLL2+MAXOBJ,FIXD(TROLL)) X CALL JUGGLE(CHASM) X PROP(TROLL)=2 X GOTO 20290 X X20270 IF(OBJ.NE.VASE.OR.LOC.EQ.PLAC(PILLOW))GOTO 20275 X PROP(VASE)=2 X IF(AT(PILLOW))PROP(VASE)=0 X CALL PSPEAK(VASE,PROP(VASE)+1) X IF(PROP(VASE).NE.0)FIXED(VASE)=-1 X GOTO 20290 X X20275 IF(OBJ.NE.FLY.OR..NOT.AT(SPIDER)) GOTO 20280 X PROP(FLY)=1 X PROP(SPIDER)=1 X SPK=379 X CALL DSTROY(FLY) X GOTO 2011 X20280 IF(WORN(OBJ).OR.OBJ.EQ.POLE.OR.OBJ.EQ.BOAT)PROP(OBJ)=0 X IF(WORN(OBJ))CALL BITOFF(OBJ,WEARBT) X IF(OBJ.EQ.POLE)PROP(BOAT)=0 X20290 IF(ENCLSD(OBJ))CALL REMOVE(OBJ) X CALL DROP(OBJ,LOC) X GOTO 2011 XC OPEN/CLOSE/LOCK/UNLOCK: NO OBJECT GIVEN. XC ASSUME VARIOUS THINGS IF PRESENT. X X10400 SPK=28 X K=0 X DO 10410 I=1,MAXOBJ X IF(.NOT.(HERE(I).AND.HINGED(I)))GOTO 10410 X OBJ=I X K=K+1 X10410 CONTINUE X IF(K.GT.1)GOTO 10000 X IF(OBJ.NE.0)GOTO 10420 X IF(VERB.EQ.LOCK.OR.VERB.EQ.UNLOCK)GOTO 2011 X GOTO 10000 X X10420 IF(VERB.EQ.LOCK)GOTO 24900 X IF(VERB.EQ.UNLOCK)GOTO 25000 X IF(VERB.EQ.SHUT)GOTO 20600 X XC OPEN. SPECIAL STUFF FOR OPENING CLAM/OYSTER. XC THE FOLLOWING CAN BE OPENED WITHOUT A KEY: XC CLAM/OYSTER, DOOR, PDOOR, BOTTLE, CASK, CAGE X X20400 IF(.NOT.HINGED(OBJ))GOTO 2070 X SPK=253 X IF(OBJ.EQ.PDOOR.AND.PROP(PDOOR).EQ.1)GOTO 2011 X SPK=336 X IF(AJAR(OBJ))GOTO 2011 X IF(LOCKS(OBJ).OR.IOBJ.EQ.KEYS.OR.IOBJ.EQ.SKEY)GOTO 25000 X SPK=337 X IF(OBJ.EQ.DOOR)SPK=111 X IF(LOCKED(OBJ))GOTO 2011 X IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)GOTO 20410 X CALL BITON(OBJ,OPENBT) X GOTO 2009 X XC CLAM/OYSTER. X20410 K=0 X IF(OBJ.EQ.OYSTER)K=1 X SPK=124+K X IF(HOLDNG(OBJ))SPK=120+K X IF(.NOT.ATHAND(TRIDNT))SPK=122+K X IF(IOBJ.NE.0.AND.IOBJ.NE.TRIDNT)SPK=376+K X IF(SPK.NE.124)GOTO 2011 X CALL DSTROY(CLAM) X CALL DROP(OYSTER,LOC) X CALL DROP(PEARL,105) X GOTO 2011 X X XC CLOSE. SHUT. XC THE FOLLOWING CAN BE CLOSED WITHOUT KEYS: XC DOOR, PDOOR, BOTTLE, CASK, CAGE X X20600 IF(.NOT.HINGED(OBJ))GOTO 2070 X SPK=338 X IF(.NOT.AJAR(OBJ))GOTO 2011 X IF(LOCKS(OBJ))GOTO 24900 X CALL BITOFF(OBJ,OPENBT) X GOTO 2009 XC LIGHT LAMP X X20700 IF(.NOT.ATHAND(LAMP))GOTO 2011 X SPK=184 X IF(LIMIT.LT.0)GOTO 2011 X SPK=321 X IF(PROP(LAMP).EQ.1)GOTO 2011 X PROP(LAMP)=1 X K=39 X IF(LOC.EQ.200)K=108 X CALL RSPEAK(K) X IF(WZDARK)GOTO 2000 X GOTO 2100 X XC LAMP OFF X X20800 IF(.NOT.ATHAND(LAMP))GOTO 2011 X SPK=322 X IF(PROP(LAMP).EQ.0)GOTO 2011 X PROP(LAMP)=0 X CALL RSPEAK(40) X IF(DARK(0))CALL RSPEAK(16) X GOTO 2100 X XC WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE. X X20900 IF((.NOT.HOLDNG(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.HOLDNG(ROD2))) X 1 SPK=29 X IF(OBJ.NE.ROD.OR..NOT.AT(FISSUR).OR..NOT.HOLDNG(OBJ) X 1 .OR.CLOSNG)GOTO 2011 X IF(IOBJ.NE.0.AND.IOBJ.NE.FISSUR)GOTO 2011 X PROP(FISSUR)=1-PROP(FISSUR) X CALL PSPEAK(FISSUR,2-PROP(FISSUR)) X IF(CHASE.EQ.0.OR.PROP(FISSUR).NE.0)GOTO 2100 X XC DEMISE OF THE WUMPUS. CHAMP MUST HAVE JUST CROSSED BRIDGE. X X IF((LOC.EQ.17.AND.OLDLOC.NE.27) X 1 .OR.(LOC.EQ.27.AND.OLDLOC.NE.17))GOTO 2100 X CALL RSPEAK(244) X CHASE=0 X CALL DROP(RING,209) X CALL MOVE(WUMPUS,209) X PROP(WUMPUS)=6 X CALL BITON(WUMPUS,DEADBT) X IF(PLACE(AXE).NE.PLAC(WUMPUS))GOTO 2100 X FIXED(AXE)=0 X PROP(AXE)=0 X GOTO 2100 X XC ATTACK. ASSUME TARGET IF UNAMBIGUOUS. "THROW" ALSO LINKS HERE. ATTACKABLE XC OBJECTS FALL INTO TWO CATEGORIES: ENEMIES (SNAKE, DWARF, ETC.) AND OTHERS XC (BIRD, CLAM). AMBIGUOUS IF TWO ENEMIES, OR IF NO ENEMIES BUT TWO OTHERS. X XC KILL OBJ WITH IOBJ. X X21200 L1=DWFMAX-1 X DO 21210 DWARFN=1,L1 X IF(DLOC(DWARFN).EQ.LOC.AND.DFLAG.GE.2)GOTO 21220 X21210 CONTINUE X DWARFN=0 X21220 IF(OBJ.NE.0)GOTO 21240 X IF(DWARFN.NE.0)OBJ=DWARF X IF(HERE(SNAKE))OBJ=OBJ*MAXOBJ+SNAKE X IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)OBJ=OBJ*MAXOBJ+DRAGON X IF(AT(TROLL))OBJ=OBJ*MAXOBJ+TROLL X IF(HERE(GNOME))OBJ=OBJ*MAXOBJ+GNOME X IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)OBJ=OBJ*MAXOBJ+BEAR X IF(HERE(WUMPUS).AND.PROP(WUMPUS).EQ.0)OBJ=OBJ*MAXOBJ+WUMPUS X IF(OBJ.GT.MAXOBJ)GOTO 10000 X IF(OBJ.NE.0)GOTO 21240 XC CAN'T ATTACK BIRD BY THROWING AXE. X IF(HERE(BIRD).AND.VERB.NE.THROW)OBJ=BIRD XC CLAM AND OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE CASE; NO HARM DONE. X IF(HERE(CLAM).OR.HERE(OYSTER))OBJ=MAXOBJ*OBJ+CLAM X IF(OBJ.GT.MAXOBJ)GOTO 10000 X21240 IF(OBJ.NE.BIRD)GOTO 21245 X SPK=137 X IF(CLOSED)GOTO 2011 X CALL DSTROY(BIRD) X PROP(BIRD)=0 X IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1 X SPK=45 X21245 IF(OBJ.NE.FLY)GOTO 21250 X PROP(FLY)=2 X SPK=398 X CALL DSTROY(FLY) X GOTO 2011 X21250 IF(OBJ.EQ.DWARF)GOTO 21270 X IF(OBJ.EQ.0)SPK=44 X IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)SPK=150 X IF(AT(DOG).AND.PROP(DOG).EQ.1)SPK=291 X IF(OBJ.EQ.SNAKE)SPK=46 X IF(OBJ.EQ.DRAGON.OR.(OBJ.EQ.WUMPUS.AND.PROP(WUMPUS).EQ.6))SPK=167 X IF(OBJ.EQ.TROLL)SPK=157 X IF(OBJ.EQ.BEAR)SPK=165+(PROP(BEAR)+1)/2 X IF(OBJ.EQ.GNOME)SPK=320 X IF(IOBJ.NE.AXE.OR.VERB.EQ.THROW.OR. X 1 (OBJ.NE.DOG.AND.OBJ.NE.WUMPUS.AND.OBJ.NE.DRAGON X 2 .AND.OBJ.NE.TROLL))GOTO 21253 X IOBJ=OBJ X OBJ=IOBJS(IOBX) X SPK=110 X GOTO 21700 X X21253 IF(IOBJ.NE.0.AND.IOBJ.NE.AXE)GOTO 2070 X IF(OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0)GOTO 2011 X XC FUN STUFF FOR DRAGON. IF HE INSISTS ON ATTACKING IT, WIN! SET PROP TO DEAD, XC MOVE DRAGON TO CENTRAL LOC (STILL FIXED), MOVE RUG THERE (NOT FIXED), AND XC MOVE HIM THERE, TOO. THEN DO A NULL MOTION TO GET NEW DESCRIPTION. XC THERE IS SOME AMOUNT OF PAIN HERE, TO FORCE GETWDS TO DO THE RIGHT THING. X X CALL RSPEAK(49) X CALL GETLIN X WDX=0 X CALL CLRLIN X IF(TXT(1,1).EQ.'Y'.OR.TXT(1,1).EQ.'YES')GOTO 21255 X WORDS(1)=-2 X RDFLAG=.TRUE. X GOTO 2600 X X21255 CALL PSPEAK(DRAGON,1) X CALL BITON(DRAGON,DEADBT) X PROP(DRAGON)=2 X PROP(RUG)=0 X K=(PLAC(DRAGON)+FIXD(DRAGON))/2 X CALL MOVE(DRAGON+MAXOBJ,-1) X CALL MOVE(RUG+MAXOBJ,0) X CALL MOVE(DRAGON,K) X CALL MOVE(RUG,K) X DO 21260 OBJ=1,MAXOBJ X IF(PLACE(OBJ).EQ.PLAC(DRAGON).OR.PLACE(OBJ).EQ.FIXD(DRAGON)) X 1 CALL MOVE(OBJ,K) X21260 CONTINUE X WORDS(1)=0 X LOC=K X NEWLOC=K X GOTO 2 X XC HE IS ATTACKING A DWARF. IF USING SOMETHING OTHER THAN AXE OR SWORD, XC GOODBYE CHARLIE. IF USING NOTHING, DON'T LET HIM. IF USING AXE OR XC SWORD, THE FOLLOWING ODDS PREVAIL (IF I CALCULATED THIS MESS RIGHT!) XC (THE END OF LINE FIGURE IS THE CULULATIVE PROBABILITY OF THE EVENT): XC .25 - HERO KILLS DWARF (.25) XC .75 - HERO MISSES XC .25 - HERO GETS KNIFE IN (HIS) RIBS. DIES. (.1875) XC .75 - HERO CAN'T MAKE A CLEAN THRUST XC .36 - STANDOFF (.2) XC .64 - DWARF SLASHES XC .61 - DWARF MISSES! (.22) XC .39 - DWARF KILLS HERO (.14) XC ADVENTURER HAS 1/3 CHANCE OF GETTING NAILED, 1/4 CHANCE OF NAILING XC DWARF. ALL BY WAY OF ENCOURAGING HIM TO THROW THE AXE. X X21270 IF(OBJ.EQ.DWARF.AND.CLOSED)GOTO 93000 X SPK=49 X IF(IOBJ.EQ.0)GOTO 2011 X SPK=355 X IF(IOBJ.NE.AXE.AND.IOBJ.NE.SWORD)GOTO 21275 X IF(PCT(25))GOTO 21753 X IF(PCT(25))GOTO 21275 X CALL RSPEAK(354) X IF(PCT(36))GOTO 2100 X CALL RSPEAK(356) X SPK=52 X IF(PCT(61))GOTO 2011 X SPK=53 X XC HERO IS GONZO. X21275 CALL RSPEAK(SPK) X OLDLC2=LOC X GOTO 94100 XC POUR. IF NO OBJECT, ASSUME LIQ IN CONTAINER, IF HOLDING ONLY ONE. XC SPECIAL TESTS FOR POURING WATER OR OIL ON PLANT OR RUSTY DOOR. X X11300 IF(.NOT.HOLDNG(BOTTLE).AND..NOT.HOLDNG(CASK))GOTO 10000 X K=LIQ(BOTTLE) X KK=LIQ(CASK) X IF(HOLDNG(BOTTLE).AND.K.NE.0.AND.HOLDNG(CASK) X 1 .AND.KK.NE.0)GOTO 10000 X IF(KK.NE.0.AND.HOLDNG(CASK))OBJ=CASK X IF(K.NE.0.AND.HOLDNG(BOTTLE))OBJ=BOTTLE X IF(OBJ.EQ.0)GOTO 10000 X XC POUR OBJ FROM IOBJ. X21300 SPK=78 X IF(OBJ.NE.BOTTLE.AND.OBJ.NE.CASK)GOTO 21310 X IOBJ=OBJ X OBJ=LIQ(IOBJ) X SPK=316 X IF(OBJ.EQ.0)GOTO 2011 X GOTO 21320 X X21310 IF(OBJ.LT.WATER.OR.OBJ.GT.WINE+1)GOTO 2011 X SPK=29 X IF(.NOT.HOLDNG(BOTTLE).AND..NOT.HOLDNG(CASK))GOTO 2011 X IF(HOLDNG(BOTTLE).AND.LIQ(BOTTLE).EQ.OBJ)IOBJ=BOTTLE X IF(HOLDNG(CASK).AND.LIQ(CASK).EQ.OBJ)IOBJ=CASK X IF(IOBJ.EQ.0)GOTO 2011 X21320 SPK=335 X IF(.NOT.AJAR(IOBJ))GOTO 2011 X IF(IOBJ.EQ.CASK)OBJ=OBJ+1 X PROP(IOBJ)=1 X CALL REMOVE(OBJ) X PLACE(OBJ)=0 X SPK=77 X IF(IOBJ.NE.CASK)GOTO 21330 X OBJ=OBJ-1 X SPK=104 X21330 IF(.NOT.(AT(PLANT).OR.AT(DOOR).OR.AT(SWORD)).OR. X 1 AT(SWORD).AND.PROP(SWORD).EQ.0)GOTO 2011 X X IF(AT(DOOR))GOTO 21340 X IF(AT(SWORD))GOTO 21350 X SPK=112 X IF(OBJ.NE.WATER)GOTO 2011 X CALL PSPEAK(PLANT,PROP(PLANT)+1) X PROP(PLANT)=MOD(PROP(PLANT)+2,6) X PROP(PLANT2)=PROP(PLANT)/2 X NEWLOC=LOC X GOTO 2 X X21340 PROP(DOOR)=0 X IF(OBJ.NE.OIL)GOTO 21341 X PROP(DOOR)=1 X CALL BITOFF(DOOR,LOCKBT) X CALL BITON(DOOR,OPENBT) X21341 SPK=113+PROP(DOOR) X GOTO 2011 X XC IF SWORD IS ALREADY OILY, DON'T LET HIM CLEAN IT. NO SOAP. X X21350 IF(PROP(SWORD).EQ.5)GOTO 21360 X PROP(SWORD)=4 X IF(OBJ.NE.OIL)GOTO 21360 X PROP(SWORD)=5 X FIXED(SWORD)=-1 X21360 SPK=206+PROP(SWORD)-4 X GOTO 2011 XC EAT. INTRANSITIVE: ASSUME EDIBLE IF PRESENT, ELSE ASK WHAT. TRANSITIVE: XC FOOD/MUSHROOMS/CAKES OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS. XC IF HE HAS MORE THAN ONE EDIBLE, OR NONE, 'EAT' IS AMBIGUOUS WITHOUT XC AN EXPLICIT OBJECT. X X11400 K=0 X DO 11410 I=1,MAXOBJ X IF(.NOT.(HERE(I).AND.EDIBLE(I))) GOTO 11410 X K=K+1 X KK=I X11410 CONTINUE X IF(K.NE.1)GOTO 10000 X OBJ=KK X IF(OBJ.NE.FOOD.AND.OBJ.NE.HONEY)GOTO 21400 X11420 IF(OBJ.EQ.HONEY)TALLY2=TALLY2+1 X CALL DSTROY(OBJ) X SPK=72 X GOTO 2011 X XC IF HE ATE THE RIGHT THING AND IS IN THE RIGHT PLACE, MOVE HIM TO XC THE OTHER PLACE WITH ALL HIS JUNK. OTHERWISE, NARKY MESSAGE. X21400 IF(OBJ.EQ.FOOD.OR.OBJ.EQ.HONEY)GOTO 11420 X IF(OBJ.EQ.BIRD.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER X 1 .OR.OBJ.EQ.FLOWER.OR.OBJ.EQ.FLY)SPK=301 X IF(OBJ.EQ.DWARF.OR.OBJ.EQ.DRAGON.OR.OBJ.EQ.TROLL X 1 .OR.OBJ.EQ.DOG.OR.OBJ.EQ.WUMPUS.OR.OBJ.EQ.BEAR X 2 .OR.OBJ.EQ.GNOME)SPK=250 X IF(OBJ.NE.MUSHRM.AND.OBJ.NE.CAKES)GOTO 2011 X X K=OBJ-MUSHRM X LL=229+K X K=159-K X KK=SKEY X IF(OBJ.EQ.MUSHRM)KK=TDOOR X IF(OBJ.EQ.MUSHRM.AND.LOC.NE.158)TALLY2=TALLY2+1 X CALL DSTROY(OBJ) X SPK=228 X IF(.NOT. (HERE(INTS(KK)).OR.FIXED(KK).EQ.LOC) )GOTO 2011 X CALL RSPEAK(LL) XC IF HE HASN'T TAKEN TINY KEY OFF SHELF, DON'T LET HIM GET IT FOR FREE! X DO 21440 OBJ=1,MAXOBJ X IF(OBJ.EQ.SKEY.AND.PROP(SKEY).EQ.1)GOTO 21440 X IF(PLACE(OBJ).EQ.PLAC(KK).AND.FIXED(OBJ).EQ.0)CALL MOVE(OBJ,K) X21440 CONTINUE X IF(LOC.EQ.PLAC(SKEY).AND.PLACE(SKEY).EQ.PLAC(SKEY)) X 1 TALLY2=TALLY2+1 X LOC=K X NEWLOC=K X GOTO 2 XC DRINK. IF NO OBJECT, ASSUME WATER OR WINE AND LOOK FOR THEM HERE. XC IF POTABLE IS IN BOTTLE OR CASK, DRINK THAT. IF NOT, SEE IF THERE XC IS SOMETHING DRINKABLE NEARBY (STREAM, LAKE, WINE FOUNTAIN, ETC.), XC AND DRINK THAT. IF HE HAS STUFF IN BOTH CONTAINERS, ASK WHICH. X XC DRINK OBJ FROM IOBJ X11500 LL=LIQLOC(LOC) X IF(.NOT.ATHAND(BOTTLE).AND..NOT.ATHAND(CASK) X 1 .AND.LL.NE.WINE.AND.LL.NE.WATER)GOTO 10000 X K=LIQ(BOTTLE) X KK=LIQ(CASK) X IF(.NOT.ATHAND(BOTTLE).OR.K.EQ.0)GOTO 11520 X IF(ATHAND(CASK).AND.KK.NE.0.AND.KK.NE.K)GOTO 10000 X OBJ=K X IOBJ=BOTTLE X GOTO 21560 X X11520 IF(.NOT.ATHAND(CASK).OR.KK.EQ.0)GOTO 11540 X OBJ=KK X IOBJ=CASK X GOTO 21560 X X11540 IF(LL.EQ.0)GOTO 10000 X OBJ=LL X IOBJ=-1 X GOTO 21560 X X21500 IF(OBJ.EQ.0.AND.(IOBJ.EQ.BOTTLE.OR.IOBJ.EQ.CASK))OBJ=LIQ(IOBJ) X SPK=110 X IF(OBJ.EQ.OIL)SPK=301 X IF(OBJ.NE.WATER.AND.OBJ.NE.WINE)GOTO 2011 X IF(IOBJ.NE.0)GOTO 21560 X IF(OBJ.EQ.LIQLOC(LOC))IOBJ=-1 X IF(ATHAND(CASK).AND.OBJ.EQ.LIQ(CASK))IOBJ=CASK X IF(ATHAND(BOTTLE).AND.OBJ.EQ.LIQ(BOTTLE))IOBJ=BOTTLE X21560 SPK=73 X IF(IOBJ.EQ.-1)GOTO 21570 X IF(IOBJ.EQ.CASK)OBJ=OBJ+1 X CALL REMOVE(OBJ) X PLACE(OBJ)=0 X PROP(IOBJ)=1 X SPK=74 X IF(IOBJ.EQ.CASK)SPK=299 X21570 IF(OBJ.EQ.WATER.OR.OBJ.EQ.WATER+1)GOTO 2011 X XC UH-OH. HE'S A WINO. LET HIM REAP THE REWARDS OF INCONTINENCE. XC HE'LL WANDER AROUND FOR AWHILE, THEN WAKE UP SOMEWHERE OR OTHER, XC HAVING DROPPED MOST OF HIS STUFF. X X CALL RSPEAK(300) X IF(PROP(LAMP).EQ.1)LIMIT=LIMIT-RAN(LIMIT)/2 X IF(LIMIT.LT.10)LIMIT=25 X K=0 X IF(PCT(15))K=49 X IF(K.EQ.0.AND.PCT(15))K=53 X IF(K.EQ.0.AND.PCT(25))K=132 X IF(K.EQ.0)K=175 X IF(OUTSID(LOC))K=5 X IF(K.EQ.LOC)GOTO 2100 X IF(HOLDNG(AXE))CALL MOVE(AXE,K) X IF(HOLDNG(LAMP))CALL MOVE(LAMP,K) X DO 21580 J=1,MAXOBJ X IF(WEARNG(J))CALL BITOFF(J,WEARBT) X21580 IF(HOLDNG(J))CALL DROP(J,LOC) X LOC=K X NEWLOC=K X GOTO 2 X X X X X XC RUB. YIELDS VARIOUS SNIDE REMARKS. X X21600 IF(OBJ.NE.LAMP)SPK=76 X GOTO 2011 XC THROW OBJ AT IOBJ. XC SAME AS DISCARD UNLESS AXE. THEN SAME AS ATTACK EXCEPT IGNORE BIRD, XC AND IF DWARF IS PRESENT THEN ONE MIGHT BE KILLED. XC AXE ALSO SPECIAL FOR DRAGON, BEAR, DOG, WUMPUS AND TROLL. XC TREASURES SPECIAL FOR TROLL. XC IF THROWING FOOD AT SOMEONE WHO MIGHT BE HUNGRY, GO FEED HIM. X X21700 IF(PREP.EQ.PREPDN)GOTO 24200 X IF(HOLDNG(ROD2).AND.OBJ.EQ.ROD.AND..NOT.HOLDNG(ROD))OBJ=ROD2 X IF(.NOT.HOLDNG(OBJ))GOTO 2011 X IF(OBJ.EQ.BOAT.OR.OBJ.EQ.BEAR)GOTO 2070 X DWARFN=0 X IF(IOBJ.NE.0)GOTO 21750 X XC NO INDIRECT OBJ WAS SPECIFIED. IF A DWARF IS PRESENT, ASSUME IT XC IS THE IOBJ. IF NOT, LOOK FOR ANY OTHER LIVING THING. IF NO LIVING XC THINGS PRESENT, TREAT 'THROW' AS 'DROP'. X X L1=DWFMAX-1 X DO 21710 DWARFN=1,L1 X IF(DLOC(DWARFN).EQ.LOC.AND.DFLAG.GE.2)GOTO 21718 X21710 CONTINUE X DWARFN=0 X XC NO DWARVES PRESENT; FIGURE OUT PLAUSIBLE OBJECT. X X K=0 X DO 21715 I=1,MAXOBJ X IF(.NOT. (AT(I).AND.LIVING(I)) )GOTO 21715 X IOBJ=I X K=K+1 X21715 CONTINUE X IF(K.EQ.0)GOTO 20200 X XC IT IS A BEASTIE OF SOME SORT. IS THERE MORE THAN ONE? XC DON'T KILL THE BIRD BY DEFAULT. X X21717 IF(K.EQ.1)GOTO 21718 X CALL RSPEAK(43) X GOTO 2600 X X21718 IF(IOBJ.EQ.BIRD)GOTO 20200 X IF(TREASR(OBJ).AND.AT(TROLL))IOBJ=TROLL X X21750 IF(TREASR(OBJ).AND.IOBJ.EQ.TROLL)GOTO 21790 X IF(OBJ.EQ.SWORD.OR.OBJ.EQ.BOTTLE)GOTO 22800 X IF(DWARFN.NE.0)IOBJ=DWARF X IF(EDIBLE(OBJ).AND.LIVING(IOBJ))GOTO 22100 X IF(OBJ.NE.AXE)GOTO 20200 X SPK=152 X IF(IOBJ.EQ.DRAGON.AND.PROP(DRAGON).EQ.0)GOTO 21755 X SPK=158 X IF(IOBJ.EQ.TROLL)GOTO 21755 X IF(IOBJ.NE.DWARF)GOTO 21760 X SPK=48 XC IF SAVED NOT = -1, HE BYPASSED THE "START" CALL. X IF(RAN(3).EQ.0.OR.SAVED.NE.-1)GOTO 21755 X IF(DWARFN.NE.0)GOTO 21753 X L1=DWFMAX-1 X DO 21752 DWARFN=1,L1 X IF(DLOC(DWARFN).EQ.LOC.AND.DFLAG.GE.2)GOTO 21753 X21752 CONTINUE XC 'ATTACK' WITH AXE OR SWORD LINKS IN HERE. X21753 DSEEN(DWARFN)=.FALSE. X DLOC(DWARFN)=0 X SPK=47 X DKILL=DKILL+1 X IF(DKILL.EQ.1)SPK=149 X21755 CALL RSPEAK(SPK) X CALL DROP(AXE,LOC) X NEWLOC=LOC X GOTO 2 X XC THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR! X21760 IF(IOBJ.NE.BEAR.OR.PROP(BEAR).NE.0)GOTO 21765 X SPK=164 X CALL DROP(AXE,LOC) X FIXED(AXE)=-1 X PROP(AXE)=1 X CALL JUGGLE(BEAR) X GOTO 2011 X XC OR THE WUMPUS! X21765 IF(IOBJ.NE.WUMPUS.OR.PROP(WUMPUS).EQ.6)GOTO 21770 X IF(PROP(WUMPUS).EQ.6)GOTO 20200 X SPK=245 X PROP(AXE)=2 X IF(PROP(WUMPUS).EQ.0)GOTO 21780 X SPK=243 X CALL DSTROY(AXE) X GOTO 2011 X XC OR THE NICE DOGGIE! X21770 IF(IOBJ.NE.DOG.OR.PROP(DOG).EQ.1)GOTO 21790 X SPK=248 X PROP(AXE)=3 X21780 CALL DROP(AXE,LOC) X FIXED(AXE)=-1 X CALL JUGGLE(IOBJ) X GOTO 2011 X XC SNARF A TREASURE FOR THE TROLL. X21790 IF(IOBJ.NE.TROLL)GOTO 21795 X PREP=0 X IF(OBJ.EQ.CASK.AND.LIQ(CASK).NE.WINE)GOTO 20200 X SPK=159 X CALL DROP(OBJ,0) X IF(OBJ.EQ.CASK)PLACE(WINE+1)=0 X CALL MOVE(TROLL,0) X CALL MOVE(TROLL+MAXOBJ,0) X CALL DROP(TROLL2,PLAC(TROLL)) X CALL DROP(TROLL2+MAXOBJ,FIXD(TROLL)) X CALL JUGGLE(CHASM) X GOTO 2011 X XC THROWING AXE AT NONE OF THE ABOVE. ASSUME 'ATTACK'. X21795 OBJ=IOBJ X IOBJ=OBJS(OBJX) X GOTO 21200 XC QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS. X X11800 GAVEUP=YES(22,54,54) X11850 IF(GAVEUP)GOTO 95000 X GOTO 2100 X XC FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT. X X21900 IF(AT(OBJ).OR.(LIQ(BOTTLE).EQ.OBJ.AND.AT(BOTTLE)) X 1 .OR.K.EQ.LIQLOC(LOC))SPK=94 X L1=DWFMAX-1 X DO 21920 I=1,L1 X21920 IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF)SPK=94 X IF(CLOSED)SPK=138 X IF(ATHAND(OBJ))SPK=24 X GOTO 2011 X X X XC INVENTORY. IF OBJECT, TREAT SAME AS FIND. ELSE REPORT ON CURRENT BURDEN. XC THERE ARE SOME FUNNY CASES, LIKE THE WEARABLE THINGS. ALSO, BOAT XC AND BEAR, WHICH AREN'T REALLY CARRIED. LIST OUTER-LEVEL CONTAINERS XC AND CONTENTS, IF CONTAINER IS OPEN OR TRANSPARENT. X X12000 SPK=98 X DO 12050 I=1,MAXOBJ X IF(I.EQ.BEAR.OR.I.EQ.BOAT.OR..NOT.HOLDNG(I))GOTO 12050 X IF(WEARNG(I))GOTO 12050 X IF(SPK.EQ.98)CALL RSPEAK(99) X BLKLIN=.FALSE. X CALL PSPEAK(I,-1) X SPK=0 X IF(I.NE.BOAT)CALL LOOKIN(I) X12050 CONTINUE X XC TELL HIM WHAT HE IS WEARING. X X K=0 X DO 12060 I=1,MAXOBJ X IF(.NOT.WEARNG(I))GOTO 12060 X IF(K.EQ.0)PRINT 12052 X12052 FORMAT(1H ,'You are wearing:') X CALL TNOUA(' ',5) X CALL PSPEAK(I,-1) X K=-1 X12060 CONTINUE X X IF(.NOT.HOLDNG(BOAT))GOTO 12090 X CALL RSPEAK(221) X CALL LOOKIN(BOAT) X12090 IF(HOLDNG(BEAR))SPK=141 X GOTO 2011 XC FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM XC MAD. BEAR, SPECIAL. X XC CASE 1: FEED CRITTER. *OR* XC CASE 2: FEED CRITTER EDIBLE. XC [** THIS CASE TRANSFORMED BY PARSER INTO CASE 3 **] XC CASE 3: FEED EDIBLE TO CRITTER. X X22100 IF(IOBJ.NE.0.AND.LIVING(IOBJ))GOTO 22120 X SPK=100 X IF(OBJ.EQ.BIRD)GOTO 2011 X IF(.NOT.LIVING(OBJ))GOTO 2070 X XC SEE IF THERE IS ANYTHING EDIBLE AROUND HERE. X KK=0 X K=0 X DO 22110 I=1,MAXOBJ X IF(.NOT.HERE(I).OR..NOT.EDIBLE(I))GOTO 22110 X K=K+1 X KK=I X22110 CONTINUE X IOBJ=OBJ X OBJ=KK X IF(K.EQ.1.OR.DEAD(IOBJ))GOTO 22120 X CALL A5TOA1(OTXT(OBJX,1),OTXT(OBJX,2),'?',TK,K) X PRINT 22112,(TK(I),I=1,K) X22112 FORMAT (/' What do you want to feed the ',20A1) X OBJS(1)=0 X OBJX=0 X GOTO 2600 X XC FEED OBJ TO IOBJ. X22120 IF(IOBJ.NE.SNAKE.AND.IOBJ.NE.DRAGON.AND.IOBJ.NE.TROLL)GOTO 22130 X SPK=102 X IF(IOBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0)SPK=NOWAY(0) X IF(IOBJ.EQ.TROLL)SPK=182 X IF(IOBJ.NE.SNAKE.OR.CLOSED.OR.OBJ.NE.BIRD)GOTO 2011 X SPK=101 X CALL DSTROY(BIRD) X PROP(BIRD)=0 X TALLY2=TALLY2+1 X GOTO 2011 X XC FEED DWARF? X22130 IF(IOBJ.NE.DWARF)GOTO 22140 X SPK=103 X DFLAG=DFLAG+1 X GOTO 2011 END_OF_FILE if test 36906 -ne `wc -c <'main.f.2'`; then echo shar: \"'main.f.2'\" unpacked with wrong size! fi # end of 'main.f.2' fi if test -f 'motd.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'motd.f'\" else echo shar: Extracting \"'motd.f'\" \(1957 characters\) sed "s/^X//" >'motd.f' <<'END_OF_FILE' X SUBROUTINE MOTD(ALTER) XC HANDLES MESSAGE OF THE DAY. IF ALTER IS TRUE, READ A NEW MESSAGE FROM THE XC WIZARD. ELSE PRINT THE CURRENT ONE. XC MS30: Message is initialized to reflect the status of this expermental XC ADVENT X IMPLICIT INTEGER(A-Z) X LOGICAL ALTER X DIMENSION MSG(500),BUF(120),BUF2(60) X DATA MSG/500*-1/ XC MS30: Change standard message of the day XC DATA MSG/9,'This ','is a ','new, ','exper','iment', XC 1 'al AD','VENT!',92*-1/ X CALL DATIME(D,T) X HOUR=T/60 X MIN=T-HOUR*60 X WRITE(1,101)HOUR,MIN X101 FORMAT(/' This is ADVENT. The time is ',B'##',':',B'##'//) X IF(ALTER)GOTO 50 X K=1 X10 IF(MSG(K).LT.0)RETURN X L1=K+1 X L2=MSG(K)-1 X WRITE(1,20)(MSG(I),I=L1,L2) X20 FORMAT(' ',60A2) X K=MSG(K) X GOTO 10 X50 M=1 X CALL MSPEAK(23) XC55 L1=M+1 XC L2=M+35 XC READ(1,56)(MSG(I),I=L1,L2),K XC56 FORMAT(36A2) XC IF(K.EQ.' ')GOTO 60 XC CALL MSPEAK(24) XC GOTO 55 XC60 DO 62 I=1,35 XC K=M+36-I XC IF(MSG(K).NE.' ')GOTO 65 XC62 CONTINUE XC GOTO 90 XC65 MSG(M)=K+1 XC M=K+1 XC IF(M+35.LT.250)GOTO 55 X55 READ(1,102)BUF X DO 1001 I=1,120 X K=121-I X IF(BUF(K).NE.' ') GOTO 1002 X1001 CONTINUE X GOTO 90 X1002 L3=0 X DO 1003 I=1,K X IF(BUF(I).EQ.'_'.OR.BUF(I).EQ.'%') GOTO 1004 X L3=L3+1 X GOTO 1003 X1004 IF(BUF(I).EQ.'_')BUF(I)=1H X IF(BUF(I).EQ.'%')BUF(I)=1H X1003 CONTINUE XC WRITE(1,10001)K X10001 FORMAT('K = ',I10) X ENCODE(120,102,BUF2)BUF XC WRITE(1,20)BUF2 X K=(K+1)/2 X IF(L3.LT.80) GOTO 1005 X1010 CALL MSPEAK(24) X GOTO 55 X102 FORMAT(121A1) X1005 DO 1006 I=1,K X L1=I+M X MSG(L1)=BUF2(I) X1006 CONTINUE X MSG(M)=K+M+1 X M=M+K+1 X IF(M+40.LT.500) GOTO 55 X CALL MSPEAK(25) X90 MSG(M)=-1 X RETURN X END END_OF_FILE if test 1957 -ne `wc -c <'motd.f'`; then echo shar: \"'motd.f'\" unpacked with wrong size! fi # end of 'motd.f' fi if test -f 'start.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'start.f'\" else echo shar: Extracting \"'start.f'\" \(2579 characters\) sed "s/^X//" >'start.f' <<'END_OF_FILE' XC*** START XC WIZARDRY ROUTINES (START, MAINT, WIZARD, HOURS(X), NEWHRS(X), MOTD, POOF, GRI X X LOGICAL FUNCTION START(DUMMY) XC CHECK TO SEE IF THIS IS "PRIME TIME". IF SO, ONLY WIZARDS MAY PLAY, THOUGH XC OTHERS MAY BE ALLOWED A SHORT GAME FOR DEMONSTRATION PURPOSES. IF SETUP<0, XC WE'RE CONTINUING FROM A SAVED GAME, SO CHECK FOR SUITABLE LATENCY. RETURN XC TRUE IF THIS IS A DEMO GAME (VALUE IS IGNORED FOR RESTARTS). X IMPLICIT INTEGER(A-Z) X INTEGER*4 PRIMTM,WKDAY,WKEND,HOLID X LOGICAL PTIME,SOON,YESM,WIZARD,EQV X DIMENSION HNAME(10),VEC(15) X REAL*8 MAGIC X COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME, X 1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP XC FIRST FIND OUT WHETHER IT IS PRIME TIME (SAVE IN PTIME) AND, IF RESTARTING, XC WHETHER IT'S TOO SOON (SAVE IN SOON). PRIME-TIME SPECS ARE IN WKDAY, WKEND, XC AND HOLID; SEE MAINT ROUTINE FOR DETAILS. LATNCY IS REQUIRED DELAY BEFORE XC RESTARTING. WIZARDS MAY CUT THIS TO A THIRD. X CALL DATIME(D,T) X CALL TIMDAT(VEC,15) X PRIMTM=WKDAY X IF(MOD(D,7).LE.1)PRIMTM=WKEND X IF(D.GE.HBEGIN.AND.D.LE.HEND)PRIMTM=HOLID X PTIME=(AND(PRIMTM,LS(000001,(T/60)))).NE.0 X SOON=.FALSE. X IF(SETUP.GE.0)GOTO 20 X DELAY=(D-SAVED)*1440+(T-SAVET) X IF(DELAY.GE.LATNCY)GOTO 20 X WRITE(1,10)DELAY X10 FORMAT(' This adventure was suspended a mere',I3,' minutes ago.') X SOON=.TRUE. X IF(DELAY.GE.LATNCY/3)GOTO 20 X CALL MSPEAK(2) X CALL EXIT XC IF NEITHER TOO SOON NOR PRIME TIME, NO PROBLEM. ELSE SPECIFY WHAT'S WRONG. X20 START=.FALSE. X IF(SOON)GOTO 30 X IF(PTIME)GOTO 25 XC22 IF(EQV('CHEM ',VEC(13))) GOTO 23 XC22 IF(EQV('CHEM ',VEC(13))) CALL EXIT /* DISALLOW CHEM TO ACCESS X22 CONTINUE X SAVED=-1 X23 CALL BREAK$(.TRUE.) X CALL LOGIN X RETURN XC COME HERE IF NOT RESTARTING TOO SOON (MAYBE NOT RESTARTING AT ALL), BUT IT'S XC PRIME TIME. GIVE OUR HOURS AND SEE IF HE'S A WIZARD. IF NOT, THEN CAN'T XC RESTART, BUT IF JUST BEGINNING THEN WE CAN OFFER A SHORT GAME. X25 CALL MSPEAK(3) X CALL HOURS X CALL MSPEAK(4) X IF(WIZARD(.FALSE.))GOTO 22 X IF(SETUP.LT.0)GOTO 33 X START=YESM(5,7,7) X IF(START)GOTO 22 X CALL EXIT XC COME HERE IF RESTARTING TOO SOON. IF HE'S A WIZARD, LET HIM GO (AND NOTE XC THAT IT THEN DOESN'T MATTER WHETHER IT'S PRIME TIME). ELSE, TOUGH BEANS. X30 CALL MSPEAK(8) X IF(WIZARD(.FALSE.))GOTO 22 X33 CALL MSPEAK(9) X CALL EXIT X END END_OF_FILE if test 2579 -ne `wc -c <'start.f'`; then echo shar: \"'start.f'\" unpacked with wrong size! fi # end of 'start.f' fi if test -f 'wizard.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'wizard.f'\" else echo shar: Extracting \"'wizard.f'\" \(2564 characters\) sed "s/^X//" >'wizard.f' <<'END_OF_FILE' X LOGICAL FUNCTION WIZARD(CHECK) XC ASK IF HE'S A WIZARD. IF HE SAYS YES, MAKE HIM PROVE IT. RETURN TRUE IF HE XC REALLY IS A WIZARD. X IMPLICIT INTEGER(A-Z) X INTEGER*4 WKDAY,WKEND,HOLID X REAL*8 MAGIC,WORD,X,Y,Z X LOGICAL YESM,EQV,CHECK,IZZWIZ X DIMENSION HNAME(10),VAL(5) X DIMENSION VEC(15) X COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME, X 1 SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP X DATA IZZWIZ/.FALSE./ X CALL TIMDAT(VEC,15) X WIZARD=.FALSE. X IF(IZZWIZ)WIZARD=.TRUE. X IF(CHECK)IZZWIZ=.FALSE. X IF(EQV('ETTEMA',VEC(13)).OR.EQV('WIZARD',VEC(13)).OR.EQV X +('RUGG ',VEC(13)))WIZARD=.TRUE. X IF(WIZARD) RETURN X WIZARD=YESM(16,0,7) X IF(.NOT.WIZARD)RETURN XC HE SAYS HE IS. FIRST STEP: DOES HE KNOW ANYTHING MAGICAL? X CALL MSPEAK(17) XC echo off XC CALL DUPLX$(:100000) X CALL GETIN(WORD,X,Y,Z) XC echo back on... XC CALL DUPLX$(:0) X IF(WORD.NE.MAGIC)GOTO 99 XCC HE DOES. GIVE HIM A RANDOM CHALLENGE AND CHECK HIS REPLY. XC CALL DATIME(D,T) XC T=T*2+1 XC WORD='@@@@@' XC DO 15 Y=1,5 XC X=79+MOD(D,5) XC D=D/5 XC DO 12 Z=1,X XC12 T=MOD(T*1027,1048576) XC VAL(Y)=(T*26)/1048576+1 XC15 WORD=WORD+SHIFT(VAL(Y),36-7*Y) X IF(YESM(18,0,0))GOTO 99 XC WRITE(1,18)WORD XC18 FORMAT(/1X,A5) XC CALL GETIN(WORD,X,Y,Z) XC CALL DATIME(D,T) XC T=(T/60)*40+(T/10)*10 XC D=MAGNM XC DO 19 Y=1,5 XC Z=MOD(Y,5)+1 XC X=MOD(IABS(VAL(Y)-VAL(Z))*MOD(D,10)+MOD(T,10),26)+1 XC T=T/10 XC D=D/10 XC19 WORD=WORD-SHIFT(X,36-7*Y) XC IF(WORD.NE.'@@@@@')GOTO 99 XC BY GEORGE, HE REALLY *IS* A WIZARD! X IF(EQV(VEC(13),'PHYS ')) GOTO 1001 X CALL DATIME(D,T) X T1=(T/60)*400 X T2=(T/60)*40+(T/10)*10 X T=T1+(T2/10) X CALL MSPEAK(33) XC echo off XC CALL DUPLX$(:100000) X WRITE(1,102) X READ(1,101)INNUM XC echo back on... XC CALL DUPLX$(:0) X NUM=MOD(MAGNM/1000 + T/1000,10)*1000 X DIG2=MOD(MAGNM/100,10) X TDIG2=MOD(T/100,10) X NUM=NUM+MOD(TDIG2+DIG2,10)*100 X DIG2=MOD(MAGNM/10,10) X TDIG2=MOD(T/10,10) X NUM=NUM + MOD(TDIG2+DIG2,10)*10 X DIG2=MOD(MAGNM,10) X TDIG2=MOD(T,10) X NUM =NUM +MOD(TDIG2+DIG2,10) XC IF(NUM.NE.INNUM)GOTO 99 X1001 CALL MSPEAK(19) X IF(.NOT.CHECK)IZZWIZ=.TRUE. X RETURN XC AHA! AN IMPOSTOR! X99 CALL MSPEAK(20) X WIZARD=.FALSE. X RETURN X101 FORMAT(I4) X102 FORMAT(' ') X END END_OF_FILE if test 2564 -ne `wc -c <'wizard.f'`; then echo shar: \"'wizard.f'\" unpacked with wrong size! fi # end of 'wizard.f' fi if test -f 'xmap.f' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'xmap.f'\" else echo shar: Extracting \"'xmap.f'\" \(1897 characters\) sed "s/^X//" >'xmap.f' <<'END_OF_FILE' XC*** XMAP X X X SUBROUTINE XMAP X XC PRINT A CAVE MAP. X X IMPLICIT INTEGER(A-Z) X REAL*8 ATAB,DJJ X COMMON /VOCCOM/ KTAB(600),ATAB(600),TABSIZ X INTEGER*4 LTEXT,STEXT,LL X COMMON /LTXCOM/ LTEXT(250),STEXT(250),KEY(250),ABB(250),LOCSIZ X INTEGER*4 TRAVEL,JJ X COMMON /TRVCOM/ TRAVEL(1600) X INTEGER*4 LOCCON,OBJCON X COMMON /CONCOM/ LOCCON(250),OBJCON(150) X X DIMENSION TK(20),BUF(66),TEMP(10) X X POSN=0 X CALL SRCH$$(2,'MAP.ADV',7,1,FTYPE,FCODE) X DO 107 LOC=1,LOCSIZ X IF(STEXT(LOC).EQ.0.AND.LTEXT(LOC).EQ.0)GOTO 9 X CALL XSPEAK(LOC) X K=0 X IF(MOD(LOCCON(LOC)/8,2).EQ.1) K=34+(MOD(LOCCON(LOC)/2,4)) X CALL MSPEAK(K) X X N=KEY(LOC) X X3 LL=IABS(TRAVEL(N))/1000 XC WRITE (22,10),LL X ENCODE(8,10,TEMP)LL X DO 100 I1=1,4 X POSN=POSN+1 X100 BUF(POSN)=TEMP(I1) X4 K=MOD(IABS(TRAVEL(N)),1000) X IF(K.GT.1)GOTO 6 XC IF(K.EQ.1)WRITE (22,14) X IF(K.NE.1)GOTO 9 X ENCODE(18,14,TEMP) X DO 101 I1=1,9 X POSN=POSN+1 X101 BUF(POSN)=TEMP(I1) X GOTO 9 X X6 DO 7 J=1,TABSIZ X IF(KTAB(J).EQ.-1)GOTO 8 X IF(K.NE.KTAB(J))GOTO 7 X DJJ=ATAB(J) XC IF(KK.NE.1)WRITE (22,11),JJ X ENCODE(8,11,TEMP)DJJ XC IF(KK.EQ.1)WRITE (22,12),DJJ X DO 102 I1=1,4 X POSN=POSN+1 X102 BUF(POSN)=TEMP(I1) X GOTO 8 X7 CONTINUE X X8 N=N+1 XC IF(KK.GT.1)WRITE (22,13) X IF(TRAVEL(N-1).LT.000000)GOTO 9 X JJ=IABS(TRAVEL(N))/0001000 X IF(JJ.EQ.LL)GOTO 4 XC WRITE (22,15) X WRITE(5,104)(BUF(I1),I1=1,POSN) X104 FORMAT(66A2) X POSN=0 X GOTO 3 X X9 WRITE(5,104)(BUF(I1),I1=1,POSN) X POSN=0 X107 CONTINUE X CALL CLOS$A(1) X RETURN X X10 FORMAT(2X,I6) X11 FORMAT(2X,A6) X12 FORMAT(1X,'(',A6) X13 FORMAT(1X,')') X14 FORMAT (' [FORCED LOC]') X15 FORMAT (1H ) X X END END_OF_FILE if test 1897 -ne `wc -c <'xmap.f'`; then echo shar: \"'xmap.f'\" unpacked with wrong size! fi # end of 'xmap.f' fi echo shar: End of archive 5 \(of 8\). cp /dev/null ark5isdone MISSING="" for I in 1 2 3 4 5 6 7 8 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 8 archives. rm -f ark[1-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0