projects / pdp8.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
A large commit.
[pdp8.git] / sw / adventure / work / AMAIN.RA
CommitLineData
84b5715c
PH		 1 EXTERN SAVEGM\r
2 EXTERN RSTRGM\r
3 EXTERN A5TOA1\r
4 SECT AMAIN\r
5 EXTERN BITSET\r
6 EXTERN BUG\r
7 EXTERN CARRY\r
8 EXTERN DROP\r
9 EXTERN DSTROY\r
10 EXTERN GETIN\r
11 EXTERN IABS\r
12 EXTERN JUGGLE\r
13 EXTERN MAX0\r
14 EXTERN MIN0\r
15 EXTERN MOD\r
16 EXTERN MOVE\r
17 EXTERN SPEAK\r
18 EXTERN PSPEAK\r
19 EXTERN PUT\r
20 EXTERN RND\r
21 EXTERN RSPEAK\r
22 EXTERN SPEAK\r
23 EXTERN VOCAB\r
24 EXTERN YES\r
25 EXTERN #FIX\r
26 EXTERN #WRITO\r
27 EXTERN #RENDO\r
28 EXTERN #RSVO\r
29 EXTERN #UE\r
30 EXTERN #EQ\r
31 EXTERN #NE\r
32 EXTERN PCT\r
33 EXTERN GETWRD\r
34 EXTERN PUTWRD\r
35 EXTERN SIXOUT\r
36 JA #ST\r
37#XR, ORG .+10\r
38 TEXT +AMAIN +\r
39#RET, SETX #XR\r
40 SETB #BASE\r
41 JA .+3\r
42#BASE, ORG .+6\r
84b5715c
PH		 43 ORG #BASE+30\r
44 FNOP\r
45 JA #RET\r
46 FNOP\r
47#GOBAK, 0;0\r
48HINT, ORG .+3\r
49KENT, ORG .+3\r
50KQ, ORG .+3\r
51K2, ORG .+3\r
52LL, ORG .+3\r
53N, ORG .+3\r
54PBOTL, ORG .+3\r
55SPK, ORG .+3\r
56WD1, ORG .+3\r
57WD1X, ORG .+3\r
58WD2, ORG .+3\r
59WD2X, ORG .+3\r
60YEA, ORG .+3\r
61#TMP, ORG .+30\r
62\r
81e70d48
PH		 63ZERO, F 0\r
64ONE, F 1\r
65TWO, F 2\r
66THREE, F 3\r
84b5715c
PH		 67#LIT, F 4 / Literals. Too many cause ST overflow\r
68 F 5 /3\r
69 F 6 /6\r
70 F 8 /11\r
71 F 9 /14\r
72 F 10 /17\r
73 F 12 /22\r
74 F 15 /25\r
75 F 16 /30\r
76 F 17 /33\r
77 F 20 /36\r
78 F 22 /41\r
79 F 23 /44\r
80 F 24 /47\r
81 F 25 /52\r
82 F 26 /55\r
83 F 27 /60\r
84 F 30 /63\r
85 F 35 /66\r
86 F 37 /71\r
87 F 39 /74\r
88 F 40 /77\r
89 F 45 /102\r
90 F 49 /105\r
91 F 50 /110\r
92 F 54 /113\r
93 F 57 /116\r
94 F 58 /121\r
95 F 62 /124\r
96 F 65 /127\r
97 F 81 /132\r
81e70d48 98 F 202 /135\r
84b5715c
PH		 99 F 91 /140\r
100 F 92 /143\r
101 F 95 /146\r
102 F 99 /151\r
103 F 100 /154\r
104 F 105 /157\r
105 F 110 /162\r
106 F 115 /165\r
107 F 116 /170\r
108 F 117 /173\r
109 F 127 /176\r
110 F 128 /201\r
111 F 129 /204\r
112 F 130 /207\r
113 F 131 /212\r
114 F 132 /215\r
115 F 136 /220\r
116 F 140 /223\r
117 F 141 /226\r
118 F 143 /231\r
119 F 145 /234\r
120 F 162 /237\r
121 F 163 /242\r
122 F 165 /245\r
123 F 175 /250\r
124 F 184 /253\r
125 F 185 /256\r
126 F 186 /261\r
127 F 188 /264\r
128 F 192 /267\r
129 F 193 /272\r
130 F 197 /275\r
131 F 199 /300\r
132 F 201 /303\r
133 F 300 /306\r
134 F 500 /311\r
135 F 1000 /314\r
136 F 2500 /317\r
137 F 10000 /322\r
81e70d48
PH		 138PCOND, 0 /325\r
139 JA COND-3\r
140PFIXD, 0 /330\r
141 JA FIXD-3\r
142PHINTS, 0 /333\r
143 JA HINTS-77\r
144PABB, 0 /336\r
145 JA ABB-3\r
146PPLAC, 0 /341\r
147 JA PLAC-3\r
148TENTE, TEXT +ENTE + /344\r
149TPOUR, TEXT +POUR + /347\r
150TWEST, TEXT +WEST + /352\r
151TQUES, TEXT +?@ + /355\r
152TQDOT, TEXT +".@ + /360\r
153TYES, TEXT +YES + /363\r
154TYE, TEXT +YE + /366\r
155TY, TEXT +Y + /371\r
156 F 154 /374\r
157 F 60 /377\r
158 F 29 /402\r
159MINUS1, F -1.0\r
160 #LBL=.\r
84b5715c
PH		 161 COMMON ABBCOM\r
162ABB, ORG .+702\r
163 COMMON MISCOM\r
164LINUSE, ORG .+3\r
165TRVS, ORG .+3\r
166CLSSES, ORG .+3\r
167OLDLOC, ORG .+3\r
168LOC, ORG .+3\r
169CVAL, ORG .+44\r
170TK, ORG .+74\r
171NEWLOC, ORG .+3\r
172KEY, ORG .+702\r
173PLAC, ORG .+454\r
174FIXD, ORG .+454\r
175ACTSPK, ORG .+151\r
176COND, ORG .+702\r
177HINTS, ORG .+360\r
178HNTMAX, ORG .+3\r
179PROP, ORG .+454\r
180TALLY, ORG .+3\r
181TALLY2, ORG .+3\r
182HINTLC, ORG .+74\r
183CHLOC, ORG .+3\r
184CHLOC2, ORG .+3\r
185DSEEN, ORG .+22\r
186DFLAG, ORG .+3\r
187DLOC, ORG .+22\r
188DALTLC, ORG .+3\r
189KEYS, ORG .+3\r
190LAMP, ORG .+3\r
191GRATE, ORG .+3\r
192CAGE, ORG .+3\r
193ROD, ORG .+3\r
194ROD2, ORG .+3\r
195STEPS, ORG .+3\r
196BIRD, ORG .+3\r
197DOOR, ORG .+3\r
198PILLOW, ORG .+3\r
199SNAKE, ORG .+3\r
200FISSUR, ORG .+3\r
201TABLET, ORG .+3\r
202CLAM, ORG .+3\r
203OYSTER, ORG .+3\r
204MAGZIN, ORG .+3\r
205DWARF, ORG .+3\r
206KNIFE, ORG .+3\r
207FOOD, ORG .+3\r
208BOTTLE, ORG .+3\r
209WATER, ORG .+3\r
210OIL, ORG .+3\r
211PLANT, ORG .+3\r
212PLANT2, ORG .+3\r
213AXE, ORG .+3\r
214MIRROR, ORG .+3\r
215DRAGON, ORG .+3\r
216CHASM, ORG .+3\r
217TROLL, ORG .+3\r
218TROLL2, ORG .+3\r
219BEAR, ORG .+3\r
220MESSAG, ORG .+3\r
221VEND, ORG .+3\r
222BATTER, ORG .+3\r
223NUGGET, ORG .+3\r
224COINS, ORG .+3\r
225CHEST, ORG .+3\r
226EGGS, ORG .+3\r
227TRIDNT, ORG .+3\r
228VASE, ORG .+3\r
229EMRALD, ORG .+3\r
230PYRAM, ORG .+3\r
231PEARL, ORG .+3\r
232RUG, ORG .+3\r
233CHAIN, ORG .+3\r
234BACK, ORG .+3\r
235LOOK, ORG .+3\r
236CAVE, ORG .+3\r
237NULL, ORG .+3\r
238ENTRNC, ORG .+3\r
239DPRSSN, ORG .+3\r
240SAY, ORG .+3\r
241LOCK, ORG .+3\r
242THROW, ORG .+3\r
243FIND, ORG .+3\r
244INVENT, ORG .+3\r
245TURNS, ORG .+3\r
246LMWARN, ORG .+3\r
247KNFLOC, ORG .+3\r
248DETAIL, ORG .+3\r
249ABBNUM, ORG .+3\r
250NUMDIE, ORG .+3\r
251MAXDIE, ORG .+3\r
252DKILL, ORG .+3\r
253FOOBAR, ORG .+3\r
254BONUS, ORG .+3\r
255CLOCK1, ORG .+3\r
256CLOCK2, ORG .+3\r
257CLOSNG, ORG .+3\r
258PANIC, ORG .+3\r
259CLOSED, ORG .+3\r
260GAVEUP, ORG .+3\r
261SCORNG, ORG .+3\r
262ODLOC, ORG .+22\r
263STREAM, ORG .+3\r
264SPICES, ORG .+3\r
265\r
266 COMMON MISC2\r
267I, ORG .+3\r
268 ORG .+3 /RTXSIZ\r
269 ORG .+3 /CLSMAX\r
270 ORG .+3 /LOCSIZ\r
271CTEXT, ORG .+44\r
272STEXT, ORG .+702\r
273LTEXT, ORG .+702\r
274 ORG .+3 /SECT\r
275TRAVEL, ORG .+1356\r
276TRVCON, ORG .+1356\r
277TRVLOC, ORG .+1356\r
278TRVSIZ, ORG .+3\r
279 ORG .+3 /TABNDX\r
280OBJ, ORG .+3\r
281J, ORG .+3\r
282K, ORG .+3\r
283VERB, ORG .+3\r
284HNTSIZ, ORG .+3\r
285MAXTRS, ORG .+3\r
286HINTED, ORG .+74\r
287 ORG .+3 /HNTLOC\r
288KK, ORG .+3\r
289 COMMON PLACOM\r
290ATLOC, ORG .+702\r
291LINK, ORG .+1130\r
292PLACE, ORG .+454\r
293FIXED, ORG .+454\r
294HOLDNG, ORG .+3\r
295 COMMON PTXCOM\r
296PTEXT, ORG .+454\r
297 COMMON TXTCOM\r
298RTEXT, ORG .+1147\r
299 ORG .+44 /LINES\r
300 ORG .+3 /ASCVAR\r
301 ORG .+3 /TXTLOC\r
302 ORG .+234 /DATA\r
303 COMMON MISC3\r
304ATTACK, ORG .+3\r
305DTOTAL, ORG .+3\r
306OLDLC2, ORG .+3\r
307LIMIT, ORG .+3\r
308MXSCOR, ORG .+3\r
309SCORE, ORG .+3\r
310STICK, ORG .+3\r
311WZDARK, ORG .+3\r
312\f ORG #LBL\r
313#25000,\r
314#RTN, BASE #BASE\r
315 JA #GOBAK\r
316#ST, STARTD\r
317 0210\r
318 FSTA #GOBAK,0\r
319 0200\r
320 SETX #XR\r
321 SETB #BASE\r
322 STARTF\r
323 JA #STRT /#G0001\r
324/\r
325/ Statement functions - called with JSA to save space\r
326/\r
327/ TOTING(OBJ)=PLACE(OBJ).EQ.-1\r
328TOTING, 0;0\r
329 ATX 3\r
330 FLDA PLACE-3,3\r
331 FADD ONE\r
332 JSA #EQ\r
333 JA TOTING\r
334\r
335/ AT(OBJ)=PLACE(OBJ).EQ.LOC.OR.FIXED(OBJ).EQ.LOC\r
336AT, 0;0\r
337 ATX 3\r
338 FLDA PLACE-3,3\r
339 FSUB LOC\r
340 JEQ ISAT\r
341 FLDA FIXED-3,3\r
342 FSUB LOC\r
343ISAT, JSA #EQ\r
344 JA AT\r
345\r
346/ FORCED(LOC)=COND(LOC).EQ.2\r
347FORCED, 0;0\r
348 ATX 3\r
349 FLDA COND-3,3\r
350 FSUB TWO\r
351 JSA #EQ\r
352 JA FORCED\r
353\r
354/ HERE(OBJ) = PLACE(OBJ).EQ.LOC .OR. TOTING(OBJ)\r
355HERE, 0;0\r
356 JSA TOTING\r
357 JNE ISHERE\r
358 FLDA LOC\r
359 FSUB PLACE-3,3\r
360 JEQ ISHERE\r
361 FCLA\r
362 JA HERE\r
363ISHERE, FLDA ONE\r
364 JA HERE\r
365\r
366/ DARK(DUMMY)=MOD(COND(LOC),2).EQ.0.AND.(PROP(LAMP).EQ.0.OR.\r
367/ 1 .NOT.HERE(LAMP))\r
368\r
369DARK, 0;0\r
370/ .OR. .NOT. HERE(LAMP)\r
371 FLDA LAMP\r
372 JSA HERE\r
373 JEQ NOTHR\r
374/ .OR. PROP(LAMP) EQ 0\r
81e70d48
PH		 375 FLDA LAMP\r
376 ATX 4\r
377 FLDA PROP-3,4\r
84b5715c
PH		 378 JNE NOTDRK\r
379/ MOD(COND(LOC),2) .EQ. 0\r
380NOTHR, FLDA LOC / Either prop or not here\r
381 ATX 4\r
382 FLDA COND-3,4 / COND(LOC)\r
383 FDIV TWO / Divided by two\r
384 JSA #FIX\r
385 FMUL TWO\r
386 FSTA #TMP+14\r
387 FLDA COND-3,4 / Get back COND(LOC)\r
388 FSUB #TMP+14 / Now have mod\r
389 JNE NOTDRK / If not zero, not dark\r
390 FLDA ONE\r
391 JA DARK\r
392NOTDRK, FCLA\r
393 JA DARK\r
394\r
395/ LIQ2(PBOTL)=(1-PBOTL)*WATER+(PBOTL/2)*(WATER+OIL)\r
396LIQ2, 0;0\r
397 FLDA ONE\r
398 FSUB PBOTL / 1 - PBOTL\r
399 FMUL WATER / (1-PBOTL)*WATER\r
400 FSTA #TMP+14 / Store first term\r
401 FLDA PBOTL\r
402 FDIV TWO / PBOTL/2\r
403 JSA #FIX\r
404 FSTA #TMP+6\r
405 FLDA WATER\r
406 FADD OIL / WATER+OIL\r
407 FMUL #TMP+6 / (PBOTL/2)*(WATER+OIL)\r
408 FADD #TMP+14\r
409 JA LIQ2 / Done\r
410\r
411/ LIQ(DUMMY)=LIQ2(MAX0(PROP(BOTTLE),-1-PROP(BOTTLE)))\r
412LIQ, 0;0\r
413/PROP(BOTTLE)\r
414 FLDA BOTTLE\r
415 ATX 5\r
416 FLDA PROP-3,5 / PROP(BOTTLE)\r
417 FSTA PBOTL \r
418 FLDA MINUS1\r
419 FSUB PBOTL /-1-PROP(BOTTLE)\r
420 FSTA #TMP+11\r
421 FLDA PBOTL / Find larger\r
422 FSUB #TMP+11\r
423 JGT .+4 / already larger, now PBOTL\r
424 FLDA #TMP+11\r
425 FSTA PBOTL / This is PBOTL\r
426 JSA LIQ2 / Call LIQ2 with this\r
427 JA LIQ / And return\r
428\r
429/ LIQLOC(LOC)=LIQ2((MOD(COND(LOC)/2*2,8)-5)*MOD(COND(LOC)/4,2)+1)\r
430LIQLOC, 0;0\r
431 FLDA LOC / Always called with LOC as arg\r
432 ATX 2\r
433 FLDA COND-3,2 / COND(LOC)\r
434 FSTA #TMP+11 / Save that\r
435 FDIV TWO\r
436 JSA #FIX / COND(LOC)/2\r
437 FMUL TWO / COND(LOC)/2*2\r
438 FSTA #TMP+17\r
439 FDIV #LIT+11 / Modulo 8\r
440 JSA #FIX\r
441 FMUL #LIT+11\r
442 FSTA #TMP+22\r
443 FLDA #TMP+17\r
444 FSUB #TMP+22 / MOD(...)\r
445 FSUB #LIT+3 / -5.\r
446 FSTA #TMP+25 / First Term\r
447 FLDA #TMP+11 / COND(LOC)\r
448 FDIV #LIT / COND(LOC)/4\r
449 JSA #FIX\r
450 FSTA #TMP+17\r
451 FDIV TWO / Mod 2\r
452 JSA #FIX\r
453 FMUL TWO\r
454 FSTA #TMP+22\r
455 FLDA #TMP+17\r
456 FSUB #TMP+22\r
457 FMUL #TMP+25 / Multiply\r
458 FADD ONE / +1\r
459 FSTA PBOTL / Finally got the term\r
460 JSA LIQ2 / Send to LIQ2\r
461 JA LIQLOC\r
84b5715c
PH		 462\f/\r
463/ Main routine entry point\r
464/\r
81e70d48 465#STRT, \r
84b5715c
PH		 466/1 I=RND(1)\r
467#1, JSR RND\r
468 JA .+4\r
469 JA ONE\r
470 FSTA I\r
471/ HINTED(3)=YES(65,1,0)\r
81e70d48 472 LDX 3,7\r
84b5715c
PH		 473 JSR YES\r
474 JA .+10\r
475 JA #LIT+127\r
476 JA ONE\r
477 JA ZERO\r
81e70d48 478 FSTA HINTED-3,7\r
84b5715c
PH		 479/ NEWLOC=1\r
480 FLDA ONE\r
481 FSTA NEWLOC\r
482/ LOC = NEWLOC\r
483 FSTA LOC\r
484/ LIMIT=330\r
81e70d48 485 LDX 512,0 /330\r
84b5715c
PH		 486 XTA 0\r
487 FSTA LIMIT\r
488/ IF(HINTED(3))LIMIT=1000\r
81e70d48 489 FLDA HINTED-3,7\r
84b5715c
PH		 490 JEQ #2\r
491 FLDA #LIT+314\r
492 FSTA LIMIT\r
493/2 IF(NEWLOC.GE.9.OR.NEWLOC.EQ.0.OR..NOT.CLOSNG)GOTO 71\r
494#2, FLDA NEWLOC\r
495 FSUB #LIT+14\r
496 JGE #71\r
497 FLDA NEWLOC\r
498 JEQ #71\r
499 FLDA CLOSNG\r
500 JEQ #71\r
501/ CALL RSPEAK(130)\r
502 JSR RSPEAK\r
503 JA .+4\r
504 JA #LIT+207\r
505/ NEWLOC=LOC\r
506 FLDA LOC\r
507 FSTA NEWLOC\r
508/ IF(.NOT.PANIC)CLOCK2=15\r
509 FLDA PANIC\r
510 JNE .+5\r
511 FLDA #LIT+25\r
512 FSTA CLOCK2\r
513/ PANIC=.TRUE.\r
514 FLDA ONE\r
515 FSTA PANIC\r
516/C\r
517/C SEE IF A DWARF HAS SEEN HIM AND HAS COME FROM WHERE HE WANTS TO GO. IF SO,\r
518/C THE DWARF'S BLOCKING HIS WAY. IF COMING FROM PLACE FORBIDDEN TO PIRATE\r
519/C (DWARVES ROOTED IN PLACE) LET HIM GET OUT (AND ATTACKED).\r
520/C\r
521/71 IF(NEWLOC.EQ.LOC.OR.FORCED(LOC).OR.BITSET(LOC,3))GOTO 74\r
522#71, FLDA NEWLOC\r
523 FSUB LOC\r
524 JEQ #74\r
525 FLDA LOC\r
526 JSA FORCED\r
527 JNE #74\r
528 JSR BITSET\r
529 JA .+6\r
530 JA LOC\r
531 JA THREE\r
532 JNE #74\r
533/ DO 73 I=1,5\r
534 FLDA ONE\r
535 FSTA I\r
536\r
537/ IF(ODLOC(I).NE.NEWLOC.OR..NOT.DSEEN(I))GOTO 73\r
538#G0047, FLDA I\r
539 ATX 7\r
540 FLDA ODLOC-3,7\r
541 FSUB NEWLOC\r
542 JNE #73\r
543 FLDA DSEEN-3,7\r
544 JEQ #73\r
545/ NEWLOC=LOC\r
546 FLDA LOC\r
547 FSTA NEWLOC\r
548/ CALL RSPEAK(2)\r
549 JSR RSPEAK\r
550 JA .+4\r
551 JA TWO\r
552/ GOTO 74\r
553 JA #74\r
554/73 CONTINUE\r
555#73, FLDA I\r
556 FADD ONE\r
557 FSTA I\r
558 FSUB #LIT+3\r
559 JLE #G0047\r
560\r
561#74, FLDA NEWLOC\r
562 FSTA LOC\r
563/C\r
564/C DWARF STUFF. SEE EARLIER COMMENTS FOR DESCRIPTION OF VARIABLES. REMEMBER\r
565/C SIXTH DWARF IS PIRATE AND IS THUS VERY DIFFERENT EXCEPT FOR MOTION RULES.\r
566/C\r
567/C FIRST OFF, DON'T LET THE DWARVES FOLLOW HIM INTO A PIT OR A WALL. ACTIVATE\r
568/C THE WHOLE MESS THE FIRST TIME HE GETS AS FAR AS THE HALL OF MISTS (LOC 15).\r
569/C IF NEWLOC IS FORBIDDEN TO PIRATE (IN PARTICULAR, IF IT'S BEYOND THE TROLL\r
570/C BRIDGE), BYPASS DWARF STUFF. THAT WAY PIRATE CAN'T STEAL RETURN TOLL, AND\r
571/C DWARVES CAN'T MEET THE BEAR. ALSO MEANS DWARVES WON'T FOLLOW HIM INTO DEAD\r
572/C END IN MAZE, BUT C'EST LA VIE. THEY'LL WAIT FOR HIM OUTSIDE THE DEAD END.\r
573/C\r
574/ IF(LOC.EQ.0.OR.FORCED(LOC).OR.BITSET(NEWLOC,3))GOTO 2000\r
84b5715c 575 JEQ #2000\r
81e70d48 576 FLDA LOC\r
84b5715c
PH		 577 JSA FORCED\r
578 JNE #2000\r
579 JSR BITSET\r
580 JA .+6\r
581 JA NEWLOC\r
582 JA THREE\r
583 JNE #2000\r
584/ IF(DFLAG.NE.0)GOTO 6000\r
585 FLDA DFLAG\r
586 JNE #6000\r
587/ IF(LOC.GE.15)DFLAG=1\r
588 FLDA LOC\r
589 FSUB #LIT+25\r
590 JLT #2000\r
591 FLDA ONE\r
592 FSTA DFLAG\r
593/ GOTO 2000\r
594 JA #2000\r
595\r
596/C\r
597/C WHEN WE ENCOUNTER THE FIRST DWARF, WE KILL 0, 1, OR 2 OF THE 5 DWARVES. IF\r
598/C ANY OF THE SURVIVORS IS AT LOC, REPLACE HIM WITH THE ALTERNATE.\r
599/C\r
600/6000 IF(DFLAG.NE.1)GOTO 6010\r
601#6000, FLDA DFLAG\r
602 FSUB ONE\r
603 JNE #6010\r
604/ IF(LOC.LT.15.OR.PCT(95))GOTO 2000\r
605 FLDA LOC\r
606 FSUB #LIT+25\r
607 JLT #2000\r
608 JSR PCT\r
609 JA .+4\r
610 JA #LIT+146\r
611 JNE #2000\r
612/ DFLAG=2\r
613 FLDA TWO\r
614 FSTA DFLAG\r
615/ DO 6001 I=1,2\r
616 FLDA ONE\r
617 FSTA I\r
618\r
619/ J=1+RND(5)\r
620#G0051, JSR RND\r
621 JA .+4\r
622 JA #LIT+3\r
623 FADD ONE\r
624 FSTA J\r
625\r
626/6001 IF(PCT(50))DLOC(J)=0\r
627#6001, JSR PCT\r
628 JA .+4\r
629 JA #LIT+110\r
630 JEQ .+10\r
631 FLDA J\r
632 ATX 7\r
633 FCLA\r
634 FSTA DLOC-3,7\r
635 FLDA I\r
636 FADD ONE\r
637 FSTA I\r
638 FSUB TWO\r
639 JLE #G0051\r
640/ DO 6002 I=1,5\r
641 FLDA ONE\r
642 FSTA I\r
643\r
644/ IF(DLOC(I).EQ.LOC)DLOC(I)=DALTLC\r
645#G0053, FLDA I\r
646 ATX 7\r
647 FLDA DLOC-3,7\r
648 FSUB LOC\r
649 JNE #6002\r
650 FLDA DALTLC\r
651 FSTA DLOC-3,7\r
652/6002 ODLOC(I)=DLOC(I)\r
653#6002, FLDA I\r
654 ATX 7\r
655 FLDA DLOC-3,7\r
656 FSTA ODLOC-3,7\r
657 FLDA I\r
658 FADD ONE\r
659 FSTA I\r
660 FSUB #LIT+3\r
661 JLE #G0053\r
662/ CALL RSPEAK(3)\r
663 JSR RSPEAK\r
664 JA .+4\r
665 JA THREE\r
666/ CALL DROP(AXE,LOC)\r
667 JSR DROP\r
668/ GOTO 2000\r
669 JA #2000\r
670 JA AXE\r
671 JA LOC\r
672\r
673/C\r
674/C THINGS ARE IN FULL SWING. MOVE EACH DWARF AT RANDOM, EXCEPT IF HE'S SEEN US\r
675/C HE STICKS WITH US. DWARVES NEVER GO TO LOCS <15. IF WANDERING AT RANDOM,\r
676/C THEY DON'T BACK UP UNLESS THERE'S NO ALTERNATIVE. IF THEY DON'T HAVE TO\r
677/C MOVE, THEY ATTACK. AND, OF COURSE, DEAD DWARVES DON'T DO MUCH OF ANYTHING.\r
678/C\r
679/6010 DTOTAL=0\r
680#6010, FCLA\r
681 FSTA DTOTAL\r
682/ ATTACK=0\r
683 FSTA ATTACK\r
684/ STICK=0\r
685 FSTA STICK\r
686/ DO 6030 I=1,6\r
687 FLDA ONE\r
688 FSTA I\r
689/ IF (DLOC(I).EQ.0)GOTO 6030\r
690#G0055, FLDA I\r
691 ATX 7\r
692 FLDA DLOC-3,7\r
693 JEQ #6030\r
694/ J=1\r
695 FLDA ONE\r
696 FSTA J\r
697/ KK=DLOC(I)\r
698 FLDA DLOC-3,7\r
699 FSTA KK\r
700/ KK=KEY(KK)\r
701 ATX 7\r
702 FLDA KEY-3,7\r
703 FSTA KK\r
704/ IF(KK.EQ.0)GOTO 6016\r
705 JEQ #6016\r
706\r
707/6012 NEWLOC=TRVLOC(KK)\r
708#6012, JSR GETWRD\r
709 JA .+10\r
710 JA TRVLOC\r
711 JA KK\r
712 JA ZERO\r
713 FSTA NEWLOC\r
714/ IF(NEWLOC.GT.300.OR.NEWLOC.LT.15.OR.NEWLOC.EQ.ODLOC(I)\r
715/ 1 .OR.(J.GT.1.AND.NEWLOC.EQ.TK(J-1)).OR.J.GE.20\r
716/ 2 .OR.NEWLOC.EQ.DLOC(I).OR.FORCED(NEWLOC)\r
717/ 3 .OR.(I.EQ.6.AND.BITSET(NEWLOC,3))\r
718/ 4 .OR.TRVCON(KK).EQ.100)GOTO 6014\r
719 FSUB #LIT+306\r
720 JGT #6014\r
721 FLDA NEWLOC\r
722 FSUB #LIT+25\r
723 JLT #6014\r
724 FLDA I\r
725 ATX 7\r
726 FLDA NEWLOC\r
727 FSUB ODLOC-3,7\r
728 JEQ #6014\r
729 FLDA J\r
730 FSUB ONE\r
731 JLE .+11\r
732 ATX 6\r
733 FLDA NEWLOC\r
734 FSUB TK-3,6\r
735 JEQ #6014\r
736 FLDA J\r
737 FSUB #LIT+36\r
738 JGE #6014\r
739 FLDA I\r
740 ATX 7\r
741 FLDA NEWLOC\r
742 FSUB DLOC-3,7\r
743 JEQ #6014\r
744 FLDA NEWLOC\r
745 JSA FORCED\r
746 JNE #6014\r
747 FLDA I\r
748 FSUB #LIT+6\r
749 JNE .+14\r
750 JSR BITSET\r
751 JA .+6\r
752 JA NEWLOC\r
753 JA THREE\r
754 JNE #6014\r
755 JSR GETWRD\r
756 JA .+10\r
757 JA TRVCON\r
758 JA KK\r
759 JA ZERO\r
760 FSUB #LIT+154\r
761 JEQ #6014\r
762/ TK(J)=NEWLOC\r
763 FLDA J\r
764 ATX 7\r
765 FLDA NEWLOC\r
766 FSTA TK-3,7\r
767/ J=J+1\r
768 FLDA ONE\r
769 FADDM J\r
770\r
771/6014 KK=KK+1\r
772#6014, FLDA KK\r
773 FADD ONE\r
774 FSTA KK\r
775/ IF(TRAVEL(KK-1).GE.0)GOTO 6012\r
776 FSUB ONE\r
777 FSTA #TMP\r
778 JSR GETWRD\r
779 JA .+10\r
780 JA TRAVEL\r
781 JA #TMP\r
782 JA ZERO\r
783 JGE #6012\r
784/6016 TK(J)=ODLOC(I)\r
785#6016, FLDA J\r
786 ATX 6\r
787 FLDA I\r
788 ATX 7\r
789 FLDA ODLOC-3,7\r
790 FSTA TK-3,6\r
791/ IF(J.GE.2)J=J-1\r
792 FLDA J\r
793 FSUB TWO\r
794 JLT .+5\r
795 FLDA MINUS1\r
796 FADDM J\r
797/ J=1+RND(J)\r
798 JSR RND\r
799 JA .+4\r
800 JA J\r
801 FADD ONE\r
802 FSTA J\r
803/ ODLOC(I)=DLOC(I)\r
804 FLDA DLOC-3,7\r
805 FSTA ODLOC-3,7\r
806/ DLOC(I)=TK(J)\r
807 FLDA J\r
808 ATX 6\r
809 FLDA TK-3,6\r
810 FSTA DLOC-3,7\r
811/ DSEEN(I)=(DSEEN(I).AND.LOC.GE.15)\r
812/ 1 .OR.(DLOC(I).EQ.LOC.OR.ODLOC(I).EQ.LOC)\r
813 FLDA LOC\r
814 FSUB #LIT+25\r
815 JLT .+6\r
816 FLDA DSEEN-3,7\r
817 JNE .+21\r
818 FLDA DLOC-3,7\r
819 FSUB LOC\r
820 JEQ .+13\r
821 FLDA ODLOC-3,7\r
822 FSUB LOC\r
823 JEQ .+5\r
824 FCLA\r
825 JA .+3\r
826 FLDA ONE\r
827 FSTA DSEEN-3,7\r
828/ IF(.NOT.DSEEN(I))GOTO 6030\r
829 JEQ #6030\r
830/ DLOC(I)=LOC\r
831 FLDA LOC\r
832 FSTA DLOC-3,7\r
833/ IF(I.NE.6)GOTO 6027\r
834 FLDA I\r
835 FSUB #LIT+6\r
836 JNE #6027\r
837/C\r
838/C THE PIRATE'S SPOTTED HIM. HE LEAVES HIM ALONE ONCE WE'VE FOUND CHEST.\r
839/C K COUNTS IF A TREASURE IS HERE. IF NOT, AND TALLY=TALLY2 PLUS ONE FOR\r
840/C AN UNSEEN CHEST, LET THE PIRATE BE SPOTTED.\r
841/C\r
842/ IF(LOC.EQ.CHLOC.OR.PROP(CHEST).GE.0)GOTO 6030\r
843\r
844 FLDA LOC\r
845 FSUB CHLOC\r
846 JEQ #6030\r
847 FLDA CHEST\r
81e70d48
PH		 848 ATX 7\r
849 FLDA PROP-3,7\r
84b5715c
PH		 850 JGE #6030\r
851/ K=0\r
852 FCLA\r
853 FSTA K\r
854/ DO 6020 J=50,MAXTRS\r
855 FLDA #LIT+110\r
856 FSTA J\r
857/C\r
858/C PIRATE WON'T TAKE PYRAMID FROM PLOVER ROOM OR DARK ROOM (TOO EASY!).\r
859/C\r
860/ IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)\r
861/ 1 .OR.LOC.EQ.PLAC(EMRALD)))GOTO 6020\r
862#G0057, FLDA J\r
863 FSUB PYRAM\r
81e70d48 864 JNE .+13\r
84b5715c
PH		 865 FLDA PYRAM\r
866 ATX 7\r
867 FLDA LOC\r
868 FSUB PLAC-3,7\r
869 JEQ #6020\r
870 FLDA EMRALD\r
871 ATX 6\r
872 FLDA LOC\r
873 FSUB PLAC-3,6\r
874 JEQ #6020\r
875/ IF(TOTING(J))GOTO 6022\r
876 FLDA J\r
877 JSA TOTING\r
878 JNE #6022\r
879\r
880/6020 IF(HERE(J))K=1\r
881#6020, FLDA J\r
882 JSA HERE\r
883 JEQ .+5\r
884 FLDA ONE\r
885 FSTA K\r
886 FLDA J\r
887 FADD ONE\r
888 FSTA J\r
889 FSUB MAXTRS\r
890 JLE #G0057\r
891/ IF(TALLY.EQ.TALLY2+1.AND.K.EQ.0.AND.PLACE(CHEST).EQ.0\r
892/ 1 .AND.HERE(LAMP).AND.PROP(LAMP).EQ.1)GOTO 6025\r
893 FLDA TALLY2\r
894 FADD ONE\r
895 FSUB TALLY\r
896 JNE #M4\r
897 FLDA K\r
898 JNE #M4\r
899 FLDA CHEST\r
900 ATX 7\r
901 FLDA PLACE-3,7\r
902 JNE #M4\r
903 FLDA LAMP\r
904 JSA HERE\r
905 JEQ #M4\r
81e70d48
PH		 906 FLDA LAMP\r
907 ATX 6\r
908 FLDA PROP-3,6\r
84b5715c
PH		 909 FSUB ONE\r
910 JEQ #6025\r
911/ IF(ODLOC(6).NE.DLOC(6).AND.PCT(20))CALL RSPEAK(127)\r
81e70d48
PH		 912#M4, FLDA #LIT+6\r
913 ATX 7\r
914 FLDA ODLOC-3,7\r
915 FSUB DLOC-3,7\r
84b5715c
PH		 916 JEQ #6030\r
917 JSR PCT\r
918 JA .+4\r
919 JA #LIT+36\r
920 JEQ #6030\r
921 JSR RSPEAK\r
922/ GOTO 6030\r
923 JA #6030\r
924 JA #LIT+176\r
925/C\r
926/6022 CALL RSPEAK(128)\r
927#6022, JSR RSPEAK\r
928 JA .+4\r
929 JA #LIT+201\r
930/C\r
931/C DON'T STEAL CHEST BACK FROM TROLL!\r
932/C\r
933/ IF(PLACE(MESSAG).EQ.0)CALL MOVE(CHEST,CHLOC)\r
934 FLDA MESSAG\r
935 ATX 7\r
936 FLDA PLACE-3,7\r
937 JNE .+12\r
938 JSR MOVE\r
939 JA .+6\r
940 JA CHEST\r
941 JA CHLOC\r
942/ CALL MOVE(MESSAG,CHLOC2)\r
943 JSR MOVE\r
944 JA .+6\r
945 JA MESSAG\r
946 JA CHLOC2\r
947/ DO 6023 J=50,MAXTRS\r
948 FLDA #LIT+110\r
949 FSTA J\r
950\r
951/ IF(J.EQ.PYRAM.AND.(LOC.EQ.PLAC(PYRAM)\r
952/ 1 .OR.LOC.EQ.PLAC(EMRALD)))GOTO 6023\r
953#G0063, FLDA J\r
954 FSUB PYRAM\r
81e70d48 955 JNE .+13\r
84b5715c
PH		 956 FLDA PYRAM\r
957 ATX 7\r
958 FLDA LOC\r
959 FSUB PLAC-3,7\r
960 JEQ #6023\r
961 FLDA EMRALD\r
962 ATX 6\r
963 FLDA LOC\r
964 FSUB PLAC-3,6\r
965 JEQ #6023\r
966/ IF(AT(J).AND.FIXED(J).EQ.0)CALL CARRY(J,LOC)\r
967 FLDA J\r
968 JSA AT\r
81e70d48
PH		 969 JEQ .+21\r
970 FLDA J\r
971 ATX 7\r
972 FLDA FIXED-3,7\r
84b5715c
PH		 973 JNE .+12\r
974 JSR CARRY\r
975 JA .+6\r
976 JA J\r
977 JA LOC\r
978/ IF(TOTING(J))CALL DROP(J,CHLOC)\r
979 FLDA J\r
980 JSA TOTING\r
981 JEQ #6023\r
982 JSR DROP\r
983 JA .+6\r
984 JA J\r
985 JA CHLOC\r
986/6023 CONTINUE\r
987#6023, FLDA J\r
988 FADD ONE\r
989 FSTA J\r
990 FSUB MAXTRS\r
991 JLE #G0063\r
992\r
993/6024 DLOC(6)=CHLOC\r
994#6024, FLDA #LIT+6\r
995 ATX 7\r
996 FLDA CHLOC\r
997 FSTA DLOC-3,7\r
998/ ODLOC(6)=CHLOC\r
999 FSTA ODLOC-3,7\r
1000/ DSEEN(6)=.FALSE.\r
1001 FCLA\r
1002 FSTA DSEEN-3,7\r
1003/ GOTO 6030\r
1004 JA #6030\r
1005\r
1006/C\r
1007/6025 CALL RSPEAK(186)\r
1008\r
1009#6025, JSR RSPEAK\r
1010 JA .+4\r
1011 JA #LIT+261\r
1012/ CALL MOVE(CHEST,CHLOC)\r
1013 JSR MOVE\r
1014 JA .+6\r
1015 JA CHEST\r
1016 JA CHLOC\r
1017/ CALL MOVE(MESSAG,CHLOC2)\r
1018 JSR MOVE\r
1019/ GOTO 6024\r
1020 JA #6024\r
1021 JA MESSAG\r
1022 JA CHLOC2\r
1023\r
1024/C\r
1025/C THIS THREATENING LITTLE DWARF IS IN THE ROOM WITH HIM!\r
1026/C\r
1027/6027 DTOTAL=DTOTAL+1\r
1028#6027, FLDA ONE\r
1029 FADDM DTOTAL\r
1030/ IF(ODLOC(I).NE.DLOC(I))GOTO 6030\r
1031 FLDA I\r
1032 ATX 7\r
1033 FLDA ODLOC-3,7\r
1034 FSUB DLOC-3,7\r
1035 JNE #6030\r
1036/ ATTACK=ATTACK+1\r
1037 FLDA ONE\r
1038 FADDM ATTACK\r
1039/ IF(KNFLOC.GE.0)KNFLOC=LOC\r
1040 FLDA KNFLOC\r
1041 JLT .+6\r
1042 FLDA LOC\r
1043 FSTA KNFLOC\r
1044/ IF(RND(1000).LT.95*(DFLAG-2))STICK=STICK+1\r
1045 JSR RND\r
1046 JA .+4\r
1047 JA #LIT+314\r
1048 FSTA #TMP\r
1049 FLDA DFLAG\r
1050 FSUB TWO\r
1051 FMUL #LIT+146\r
1052 FSUB #TMP\r
1053 JLT #6030\r
1054 FLDA ONE\r
1055 FADDM STICK\r
1056/6030 CONTINUE\r
1057#6030, FLDA I\r
1058 FADD ONE\r
1059 FSTA I\r
1060 FSUB #LIT+6\r
1061 JLE #G0055\r
1062/C\r
1063/C NOW WE KNOW WHAT'S HAPPENING. LET'S TELL THE POOR SUCKER ABOUT IT.\r
1064/C\r
1065/ IF(DTOTAL.EQ.0)GOTO 2000\r
1066 FLDA DTOTAL\r
1067 JEQ #2000\r
1068/ IF(DTOTAL.EQ.1)GOTO 75\r
1069 FSUB ONE\r
1070 JEQ #75\r
1071/ TYPE 67,DTOTAL\r
1072/67 FORMAT(' There are ',I1,' threatening little dwarves in the'\r
1073/ 1 ,' room with you.')\r
1074\r
81e70d48
PH		 1075 JSR SIXOUT\r
1076 JA .+10\r
84b5715c 1077 JA #67A\r
81e70d48 1078 JA ZERO\r
84b5715c
PH		 1079 JA TWO\r
1080\r
1081 TRAP3 #WRITO\r
1082 JA #LIT\r
1083 JA #67\r
1084 FLDA DTOTAL\r
1085 TRAP3 #RSVO\r
1086 TRAP3 #RENDO\r
1087\r
81e70d48 1088 JSR SIXOUT\r
84b5715c
PH		 1089/ GOTO 77\r
1090 JA #77\r
81e70d48
PH		 1091\r JA #67B\r
1092 JA ZERO\r
1093 JA ONE\r
84b5715c
PH		 1094\r
1095/75 CALL RSPEAK(4)\r
1096#75, JSR RSPEAK\r
1097 JA .+4\r
1098 JA #LIT\r
1099\r
1100/77 IF(ATTACK.EQ.0)GOTO 2000\r
1101#77, FLDA ATTACK\r
1102 JEQ #2000\r
1103/ IF(DFLAG.EQ.2)DFLAG=3\r
1104 FLDA DFLAG\r
1105 FSUB TWO\r
1106 JNE .+5\r
1107 FLDA THREE\r
1108 FSTA DFLAG\r
1109/ IF(ATTACK.EQ.1)GOTO 79\r
1110 FLDA ATTACK\r
1111 FSUB ONE\r
1112 JEQ #79\r
1113/ TYPE 78,ATTACK\r
1114/78 FORMAT(' ',I1,' of them throw knives at you!')\r
1115 TRAP3 #WRITO\r
1116 JA #LIT\r
1117 JA #78\r
1118 FLDA ATTACK\r
1119 TRAP3 #RSVO\r
1120 TRAP3 #RENDO\r
81e70d48
PH		 1121 JSR SIXOUT\r
1122 JA .+10\r
84b5715c 1123 JA #78B\r
81e70d48 1124 JA ZERO\r
84b5715c
PH		 1125 JA ONE\r
1126/ K=6\r
1127 FLDA #LIT+6\r
1128 FSTA K\r
1129\r
1130/82 IF(STICK.GT.1)GOTO 83\r
1131#82, FLDA STICK\r
1132 FSUB ONE\r
1133 JGT #83\r
1134/ CALL RSPEAK(K+STICK)\r
1135 FLDA K\r
1136 FADD STICK\r
1137 FSTA #TMP\r
1138 JSR RSPEAK\r
1139 JA .+4\r
1140 JA #TMP\r
1141/ IF(STICK.EQ.0)GOTO 2000\r
1142 FLDA STICK\r
1143 JEQ #2000\r
1144/ GOTO 84\r
1145 JA #84\r
1146\r
1147/83 TYPE 68,STICK\r
1148#83, TRAP3 #WRITO\r
1149 JA #LIT\r
1150 JA #68\r
1151 FLDA STICK\r
1152 TRAP3 #RSVO\r
1153 TRAP3 #RENDO\r
1154\r
1155/68 FORMAT(' ',I1,' of them get you!')\r
81e70d48
PH		 1156 JSR SIXOUT\r
1157 JA .+10\r
84b5715c 1158 JA #68B\r
81e70d48 1159 JA ZERO\r
84b5715c
PH		 1160 JA ONE\r
1161/84 OLDLC2=LOC\r
1162#84, FLDA LOC\r
1163 FSTA OLDLC2\r
1164/ GOTO 99\r
1165 JA #99\r
1166\r
1167/C\r
1168/79 CALL RSPEAK(5)\r
1169#79, JSR RSPEAK\r
1170 JA .+4\r
1171 JA #LIT+3\r
1172/ K=52\r
81e70d48 1173 LDX 64,0 /52\r
84b5715c
PH		 1174 XTA 0\r
1175 FSTA K\r
1176/ GOTO 82\r
1177 JA #82\r
1178\r
1179/C DESCRIBE THE CURRENT LOCATION AND (MAYBE) GET NEXT COMMAND.\r
1180/C\r
1181/C PRINT TEXT FOR CURRENT LOC.\r
1182/C\r
1183/2000 IF(LOC.EQ.0)GOTO 99\r
1184#2000, FLDA LOC\r
1185 JEQ #99\r
1186/ KK=STEXT(LOC)\r
1187 FLDA LOC\r
1188 ATX 7\r
1189 FLDA STEXT-3,7\r
1190 FSTA KK\r
1191/ KENT=0\r
1192 FCLA\r
1193 FSTA KENT\r
1194/ IF (ABBNUM.NE.0) KENT=MOD(ABB(LOC),ABBNUM)\r
1195 FLDA ABBNUM\r
81e70d48
PH		 1196 JEQ .+26\r
1197 FLDA LOC\r
1198 ATX 7\r
1199 XTA 7\r
1200 FMUL THREE\r
1201 ALN 0\r
1202 STARTD\r
1203 FADD PABB\r
1204 FSTA .+7\r
1205 STARTF\r
84b5715c
PH		 1206 JSR MOD\r
1207 JA .+6\r
81e70d48 1208 JA .\r
84b5715c
PH		 1209 JA ABBNUM\r
1210 FSTA KENT\r
1211/ IF (KENT.EQ.0.OR.KK.EQ.0) KK=LTEXT(LOC)\r
1212NOMOD, FLDA KENT\r
1213 JEQ .+6\r
1214 FLDA KK\r
1215 JNE .+11\r
1216 FLDA LOC\r
1217 ATX 7\r
1218 FLDA LTEXT-3,7\r
1219 FSTA KK\r
1220/ IF(FORCED(LOC).OR..NOT.DARK(0))GOTO 2001\r
1221 FLDA LOC\r
1222 JSA FORCED\r
1223 JNE #2001\r
1224 JSA DARK\r
1225 JEQ #2001\r
1226/ IF(WZDARK.AND.PCT(35))GOTO 90\r
1227 FLDA WZDARK\r
1228 JEQ .+12\r
1229 JSR PCT\r
1230 JA .+4\r
1231 JA #LIT+66\r
1232 JNE #90\r
1233/ KK=RTEXT(16)\r
1234 FLDA RTEXT+55\r
1235 FSTA KK\r
1236\r
1237/2001 IF(TOTING(BEAR))CALL RSPEAK(141)\r
1238#2001, FLDA BEAR\r
1239 JSA TOTING\r
1240 JEQ .+10\r
1241 JSR RSPEAK\r
1242 JA .+4\r
1243 JA #LIT+226\r
1244/ CALL SPEAK(KK)\r
1245 JSR SPEAK\r
1246 JA .+4\r
1247 JA KK\r
1248/ K=1\r
1249 FLDA ONE\r
1250 FSTA K\r
1251/ IF(FORCED(LOC))GOTO 8\r
1252 FLDA LOC\r
1253 JSA FORCED\r
1254 JNE #8\r
1255/ IF(LOC.EQ.33.AND.PCT(25).AND..NOT.CLOSNG)CALL RSPEAK(8)\r
81e70d48 1256 LDX 41,0 /33\r
84b5715c
PH		 1257 XTA 0\r
1258 FSUB LOC\r
1259 JNE .+24\r
1260 JSR PCT\r
1261 JA .+4\r
1262 JA #LIT+52\r
1263 JEQ .+14\r
1264 FLDA CLOSNG\r
1265 JNE .+10\r
1266 JSR RSPEAK\r
1267 JA .+4\r
1268 JA #LIT+11\r
1269/C\r
1270/C PRINT OUT DESCRIPTIONS OF OBJECTS AT THIS LOCATION. IF NOT CLOSING AND\r
1271/C PROPERTY VALUE IS NEGATIVE, TALLY OFF ANOTHER TREASURE. RUG IS SPECIAL\r
1272/C CASE; ONCE SEEN, ITS PROP IS 1 (DRAGON ON IT) TILL DRAGON IS KILLED.\r
1273/C SIMILARLY FOR CHAIN; PROP IS INITIALLY 1 (LOCKED TO BEAR). THESE HACKS\r
1274/C ARE BECAUSE PROP=0 IS NEEDED TO GET FULL SCORE.\r
1275/C\r
1276/ IF(DARK(0))GOTO 2012\r
1277 JSA DARK\r
1278 JNE #2012\r
1279/ ABB(LOC)=ABB(LOC)+1\r
1280 FLDA LOC\r
81e70d48
PH		 1281 ATX 7\r
1282 FLDA ABB-3,7\r
1283 FADD ONE\r
1284 FSTA ABB-3,7\r
84b5715c
PH		 1285/ I=ATLOC(LOC)\r
1286 FLDA ATLOC-3,7\r
1287 FSTA I\r
1288\r
1289/2004 IF(I.EQ.0)GOTO 2012\r
1290#2004, FLDA I\r
1291 JEQ #2012\r
1292/ OBJ=I\r
1293 FSTA OBJ\r
1294/ IF(OBJ.GT.100)OBJ=OBJ-100\r
1295 FSUB #LIT+154\r
1296 JLE .+4\r
1297/ FLDA OBJ\r
1298/ FSUB #LIT+154\r
1299 FSTA OBJ\r
1300/ IF(OBJ.EQ.STEPS.AND.TOTING(NUGGET))GOTO 2008\r
1301 FLDA OBJ\r
1302 FSUB STEPS\r
1303 JNE .+10\r
1304 FLDA NUGGET\r
1305 JSA TOTING\r
1306 JNE #2008\r
1307/ IF(PROP(OBJ).GE.0)GOTO 2006\r
1308 FLDA OBJ\r
81e70d48
PH		 1309 ATX 7\r
1310 FLDA PROP-3,7\r
84b5715c
PH		 1311 JGE #2006\r
1312/ IF(CLOSED)GOTO 2008\r
1313 FLDA CLOSED\r
1314 JNE #2008\r
1315/ PROP(OBJ)=0\r
1316 FCLA\r
1317 FSTA PROP-3,7\r
1318/ IF(OBJ.EQ.RUG.OR.OBJ.EQ.CHAIN)PROP(OBJ)=1\r
1319 FLDA OBJ\r
1320 FSUB RUG\r
1321 JEQ .+10\r
1322 FLDA OBJ\r
1323 FSUB CHAIN\r
1324 JNE .+5\r
1325 FLDA ONE\r
1326 FSTA PROP-3,7\r
1327/ TALLY=TALLY-1\r
1328 FLDA TALLY\r
1329 FADD MINUS1\r
1330 FSTA TALLY\r
1331/C IF REMAINING TREASURES TOO ELUSIVE, ZAP HIS LAMP.\r
1332/ IF(TALLY.EQ.TALLY2.AND.TALLY.NE.0)LIMIT=MIN0(35,LIMIT)\r
1333 JEQ #2006\r
1334 FSUB TALLY2\r
1335 JNE #2006\r
1336 JSR MIN0\r
1337 JA .+6\r
1338 JA #LIT+66\r
1339 JA LIMIT\r
1340 FSTA LIMIT\r
1341/2006 KK=PROP(OBJ)\r
1342#2006, FLDA OBJ\r
81e70d48
PH		 1343 ATX 7\r
1344 FLDA PROP-3,7\r
84b5715c
PH		 1345 FSTA KK\r
1346/ IF(OBJ.EQ.STEPS.AND.LOC.EQ.FIXED(STEPS))KK=1\r
1347 FLDA OBJ\r
1348 FSUB STEPS\r
1349 JNE .+16\r
1350 FLDA STEPS\r
1351 ATX 7\r
1352 FLDA LOC\r
1353 FSUB FIXED-3,7\r
1354 JNE .+5\r
1355 FLDA ONE\r
1356 FSTA KK\r
1357/ CALL PSPEAK(OBJ,KK)\r
1358 JSR PSPEAK\r
1359 JA .+6\r
1360 JA OBJ\r
1361 JA KK\r
1362\r
1363/2008 I=LINK(I)\r
1364#2008, FLDA I\r
1365 ATX 7\r
1366 FLDA LINK-3,7\r
1367 FSTA I\r
1368/ GOTO 2004\r
1369 JA #2004\r
1370\r
1371/2009 K=54\r
1372#2009, FLDA #LIT+113\r
1373 FSTA K\r
1374/2010 SPK=K\r
1375#2010, FLDA K\r
1376 FSTA SPK\r
1377\r
1378/2011 CALL RSPEAK(SPK)\r
1379#2011, JSR RSPEAK\r
1380 JA .+4\r
1381 JA SPK\r
1382\r
1383/2012 VERB=0\r
1384#2012, FCLA\r
1385 FSTA VERB\r
1386/ OBJ=0\r
1387 FSTA OBJ\r
1388\r
1389/C\r
1390/C CHECK IF THIS LOC IS ELIGIBLE FOR ANY HINTS. IF BEEN HERE LONG ENOUGH,\r
1391/C BRANCH TO HELP SECTION (ON LATER PAGE). HINTS ALL COME BACK HERE EVENTUALLY\r
1392/C TO FINISH THE LOOP. IGNORE "HINTS" < 4 (SPECIAL STUFF, SEE DATABASE NOTES).\r
1393/C\r
1394/2600 DO 2602 HINT=4,HNTMAX\r
1395#2600, FLDA #LIT\r
1396 FSTA HINT\r
1397\r
1398/ IF(HINTED(HINT))GOTO 2602\r
1399#G0102, FLDA HINT\r
1400 ATX 7\r
1401 FLDA HINTED-3,7\r
1402 JNE #2602\r
1403/ IF(.NOT.BITSET(LOC,HINT))HINTLC(HINT)=-1\r
1404 JSR BITSET\r
1405 JA .+6\r
1406 JA LOC\r
1407 JA HINT\r
81e70d48 1408 JNE .+6\r
84b5715c
PH		 1409 FLDA MINUS1\r
1410 FSTA HINTLC-3,7\r
1411/ HINTLC(HINT)=HINTLC(HINT)+1\r
1412 FLDA ONE\r
1413 FADDM HINTLC-3,7\r
1414/ IF(HINTLC(HINT).GE.HINTS(HINT,1))GOTO 40000\r
81e70d48
PH		 1415 FLDA #LIT+36\r
1416 FADD HINT\r
84b5715c
PH		 1417 ATX 6\r
1418 FLDA HINTLC-3,7\r
81e70d48 1419 FSUB HINTS-0077,6\r
84b5715c
PH		 1420 JGE #40000\r
1421\r
1422/2602 CONTINUE\r
1423#2602, FLDA HINT\r
1424 FADD ONE\r
1425 FSTA HINT\r
1426 FSUB HNTMAX\r
1427 JLE #G0102\r
1428/C\r
1429/C KICK THE RANDOM NUMBER GENERATOR JUST TO ADD VARIETY TO THE CHASE. ALSO,\r
1430/C IF CLOSING TIME, CHECK FOR ANY OBJECTS BEING TOTED WITH PROP < 0 AND SET\r
1431/C THE PROP TO -1-PROP. THIS WAY OBJECTS WON'T BE DESCRIBED UNTIL THEY'VE\r
1432/C BEEN PICKED UP AND PUT DOWN SEPARATE FROM THEIR RESPECTIVE PILES. DON'T\r
1433/C TICK CLOCK1 UNLESS WELL INTO CAVE (AND NOT AT Y2).\r
1434/C\r
1435/ IF(.NOT.CLOSED)GOTO 2605\r
1436 FLDA CLOSED\r
1437 JEQ #2605\r
1438/ IF(PROP(OYSTER).LT.0.AND.TOTING(OYSTER))\r
1439/ 1 CALL PSPEAK(OYSTER,1)\r
1440\r
81e70d48
PH		 1441 FLDA OYSTER\r
1442 ATX 7\r
1443 FLDA PROP-3,7\r
1444 JGE .+20\r
84b5715c
PH		 1445 FLDA OYSTER\r
1446 JSA TOTING\r
81e70d48 1447 JEQ .+12\r
84b5715c
PH		 1448 JSR PSPEAK\r
1449 JA .+6\r
1450 JA OYSTER\r
1451 JA ONE\r
1452/ DO 2604 I=1,100\r
1453 FLDA ONE\r
1454 FSTA I\r
1455\r
1456/2604 IF(TOTING(I).AND.PROP(I).LT.0)PROP(I)=-1-PROP(I)\r
1457#2604, FLDA I\r
81e70d48 1458 ATX 7\r
84b5715c
PH		 1459 JSA TOTING\r
1460 JEQ .+13\r
81e70d48 1461 FLDA PROP-3,7\r
84b5715c
PH		 1462 JGE .+7\r
1463 FLDA MINUS1\r
81e70d48
PH		 1464 FSUB PROP-3,7\r
1465 FSTA PROP-3,7\r
84b5715c
PH		 1466 FLDA I\r
1467 FADD ONE\r
1468 FSTA I\r
1469 FSUB #LIT+154\r
1470 JLE #2604\r
1471\r
1472/2605 WZDARK=DARK(0)\r
1473#2605, JSA DARK\r
1474 FSTA WZDARK\r
1475/ IF(KNFLOC.GT.0.AND.KNFLOC.NE.LOC)KNFLOC=0\r
1476 FLDA KNFLOC\r
1477 JLE .+11\r
1478 FSUB LOC\r
1479 JEQ .+5\r
1480 FCLA\r
1481 FSTA KNFLOC\r
1482/ I=RND(1)\r
1483 JSR RND\r
1484 JA .+4\r
1485 JA ONE\r
1486/ CALL GETIN(WD1,WD1X,WD2,WD2X)\r
1487 JSR GETIN\r
1488 JA .+12\r
1489 JA WD1\r
1490 JA WD1X\r
1491 JA WD2\r
1492 JA WD2X\r
1493\r
1494/C\r
1495/C EVERY INPUT, CHECK "FOOBAR" FLAG. IF ZERO, NOTHING'S GOING ON. IF POS,\r
1496/C MAKE NEG. IF NEG, HE SKIPPED A WORD, SO MAKE IT ZERO.\r
1497/C\r
1498/2608 FOOBAR=MIN0(0,-FOOBAR)\r
1499#2608, FLDA FOOBAR\r
1500 FNEG\r
1501 FSTA #TMP\r
1502 JSR MIN0\r
1503 JA .+6\r
1504 JA ZERO\r
1505 JA #TMP\r
1506 FSTA FOOBAR\r
1507/ TURNS=TURNS+1\r
1508 FLDA ONE\r
1509 FADDM TURNS\r
1510/C IF(VERB.EQ.SAY.AND.WD2.NE.0)VERB=0\r
1511/C IF(VERB.EQ.SAY)GOTO 4090\r
1512/ IF(TALLY.EQ.0.AND.LOC.GE.15.AND.LOC.NE.33)CLOCK1=CLOCK1-1\r
1513 FLDA TALLY\r
1514 JNE .+23\r
1515 FLDA LOC\r
1516 FSUB #LIT+25\r
1517 JLT .+16\r
81e70d48 1518 LDX 41,0 /33\r
84b5715c
PH		 1519 XTA 0\r
1520 FSUB LOC\r
1521 JEQ .+7\r
1522 FLDA CLOCK1\r
1523 FSUB ONE\r
1524 FSTA CLOCK1\r
1525/ IF(CLOCK1.EQ.0)GOTO 10000\r
1526 FLDA CLOCK1\r
1527 JEQ #10000\r
1528/ IF(CLOCK1.LT.0)CLOCK2=CLOCK2-1\r
1529 JGE .+7\r
1530 FLDA CLOCK2\r
1531 FSUB ONE\r
1532 FSTA CLOCK2\r
1533/ IF(CLOCK2.EQ.0)GOTO 11000\r
1534 FLDA CLOCK2\r
1535 JEQ #11000\r
1536/ IF(PROP(LAMP).EQ.1)LIMIT=LIMIT-1\r
1537 FLDA LAMP\r
81e70d48
PH		 1538 ATX 7\r
1539 FLDA PROP-3,7\r
84b5715c
PH		 1540 FSUB ONE\r
1541 JNE .+5\r
1542 FLDA MINUS1\r
1543 FADDM LIMIT\r
1544/ IF(LIMIT.LE.30.AND.HERE(BATTER).AND.PROP(BATTER).EQ.0\r
1545/ 1 .AND.HERE(LAMP))GOTO 12000\r
1546 FLDA LIMIT\r
1547 FSUB #LIT+63\r
81e70d48 1548 JGT .+25\r
84b5715c
PH		 1549 FLDA BATTER\r
1550 JSA HERE\r
81e70d48
PH		 1551 JEQ .+17\r
1552 FLDA BATTER\r
1553 ATX 7\r
1554 FLDA PROP-3,7\r
84b5715c
PH		 1555 JNE .+10\r
1556 FLDA LAMP\r
1557 JSA HERE\r
1558 JNE #12000\r
1559/ IF(LIMIT.EQ.0)GOTO 12400\r
1560 FLDA LIMIT\r
1561 JEQ #12400\r
1562/ IF(LIMIT.LT.0.AND.LOC.LE.8)GOTO 12600\r
81e70d48 1563 FLDA LIMIT\r
84b5715c
PH		 1564 JGE .+7\r
1565 FLDA LOC\r
1566 FSUB #LIT+11\r
1567 JLE #12600\r
1568/ IF(LIMIT.LE.30)GOTO 12200\r
1569 FLDA LIMIT\r
1570 FSUB #LIT+63\r
1571 JLE #12200\r
1572\r
1573/19999 K=43\r
81e70d48 1574#19999, LDX 53,0 /43\r
84b5715c
PH		 1575 XTA 0\r
1576 FSTA K\r
1577/ IF(LIQLOC(LOC).EQ.WATER)K=70\r
1578 JSA LIQLOC\r
1579 FSUB WATER\r
1580 JNE .+7\r
81e70d48 1581 LDX 106,0 /70\r
84b5715c
PH		 1582 XTA 0\r
1583 FSTA K\r
1584/C\r
1585/C DO PRELIMINARY ANALYSIS OF SENTENCE TO FIND CERTAIN SPECIAL\r
1586/C CASES, VIZ,\r
1587/C\r
1588/C ENTER <WATER,STREAM>\r
1589/C ENTER <LOCATION>\r
1590/C <WATER,OIL> <PLANT,DOOR>\r
1591/C\r
1592/ CALL VOCAB(WD1,WD1A,-1,I)\r
1593 JSR VOCAB\r
1594 JA .+6\r
1595 JA WD1\r
1596 JA MINUS1\r
1597 FSTA I\r
1598/ CALL VOCAB(WD2,WD2A,-1,J)\r
1599 JSR VOCAB\r
1600 JA .+6\r
1601 JA WD2\r
1602 JA MINUS1\r
1603 FSTA J\r
1604/ IF(WD1.NE.'ENTE') GO TO 2609\r
1605 FLDA WD1\r
1606 FSUB TENTE\r
1607 JNE #2609\r
1608/ IF(J .EQ. (WATER+1000)\r
1609/ 1 .OR. J .EQ. STREAM) GO TO 2010\r
1610 FLDA WATER\r
1611 FADD #LIT+314\r
1612 FSUB J\r
1613 JEQ #2010\r
1614 FLDA J\r
1615 FSUB STREAM\r
1616 JEQ #2010\r
1617/ IF(WD2 .NE. 0) GO TO 2800\r
1618 FLDA WD2\r
1619 JNE #2800\r
1620\r
1621/2609 IF((I .NE. (WATER+1000) .AND. I .NE. (OIL+1000))\r
1622/ 1 .OR. (J .NE. (PLANT+1000) .AND. J .NE. (DOOR+1000)))\r
1623/ 2 GO TO 2610\r
1624#2609, FLDA WATER\r
1625 FADD #LIT+314\r
1626 FSUB I\r
1627 JEQ .+11\r
1628 FLDA OIL\r
1629 FADD #LIT+314\r
1630 FSUB I\r
1631 JNE #2610\r
1632 FLDA PLANT\r
1633 FADD #LIT+314\r
1634 FSUB J\r
1635 JEQ .+11\r
1636 FLDA DOOR\r
1637 FADD #LIT+314\r
1638 FSUB J\r
1639 JNE #2610\r
1640/ WD2="POUR"\r
1641 FLDA TPOUR\r
1642 FSTA WD2\r
1643\r
1644/2610 IF(WD1 .EQ. 'WEST' .AND. PCT(10))\r
1645/ 1 CALL RSPEAK(17)\r
1646\r
1647#2610, FLDA WD1\r
1648 FSUB TWEST\r
1649 JNE #2630\r
1650 JSR PCT\r
1651 JA .+4\r
1652 JA #LIT+17\r
1653 JEQ #2630\r
1654 JSR RSPEAK\r
1655 JA .+4\r
1656 JA #LIT+33\r
1657/2630 CALL VOCAB(WD1,-1,I)\r
1658#2630, JSR VOCAB\r
1659 JA .+6\r
1660 JA WD1\r
1661 JA MINUS1\r
1662 FSTA I\r
1663/ IF(I.EQ.-1)GOTO 3000\r
1664 FADD ONE\r
1665 JEQ #3000\r
1666/ K=MOD(I,1000)\r
1667 JSR MOD\r
1668 JA .+6\r
1669 JA I\r
1670 JA #LIT+314\r
1671 FSTA K\r
1672/ KQ=I/1000+1\r
1673 FLDA I\r
1674 FDIV #LIT+314\r
1675 JSA #FIX\r
1676 FADD ONE\r
1677 FSTA KQ\r
1678/ GOTO (8,5000,4000,2010)KQ\r
1679 FLDA KQ\r
1680 ATX 1\r
1681 STARTD\r
1682 FLDA .+2,1\r
1683 STARTF\r
1684 JAC\r
1685 JA #8\r
1686 JA #5000\r
1687 JA #4000\r
1688 JA #2010\r
1689/ CALL BUG(22)\r
1690 JSR BUG\r
1691 JA .+4\r
1692 JA #LIT+41\r
1693\r
1694/C\r
1695/C GET SECOND WORD FOR ANALYSIS.\r
1696/C\r
1697/2800 WD1=WD2\r
1698/ WD1A=WD2A\r
1699\r
1700#2800, FLDA WD2\r
1701 FSTA WD1\r
1702/ WD1X=WD2X\r
1703 FLDA WD2X\r
1704 FSTA WD1X\r
1705/ WD2=0\r
1706 FCLA\r
1707 FSTA WD2\r
1708/ GOTO 2610\r
1709 JA #2610\r
1710\r
1711/C\r
1712/C GEE, I DON'T UNDERSTAND.\r
1713/C\r
1714/3000 SPK=60\r
81e70d48
PH		 1715#3000, LDX 74,0 /60\r
1716 XTA 0\r
84b5715c
PH		 1717 FSTA SPK\r
1718/ IF(PCT(20))SPK=61\r
1719 JSR PCT\r
1720 JA .+4\r
1721 JA #LIT+36\r
1722 JEQ .+6\r
81e70d48 1723 LDX 75,0 /61\r
84b5715c
PH		 1724 XTA 0\r
1725 FSTA SPK\r
1726/ IF(PCT(20))SPK=13\r
1727 JSR PCT\r
1728 JA .+4\r
1729 JA #LIT+36\r
1730 JEQ .+6\r
81e70d48 1731 LDX 15,0 /13\r
84b5715c
PH		 1732 XTA 0\r
1733 FSTA SPK\r
1734/ CALL RSPEAK(SPK)\r
1735 JSR RSPEAK\r
1736 JA .+4\r
1737 JA SPK\r
1738/ GOTO 2600\r
1739 JA #2600\r
1740\r
1741/C\r
1742/C ANALYSE A VERB. REMEMBER WHAT IT WAS, GO BACK FOR OBJECT IF SECOND WORD\r
1743/C UNLESS VERB IS "SAY", WHICH SNARFS ARBITRARY SECOND WORD.\r
1744/C\r
1745/4000 VERB=K\r
1746#4000, FLDA K\r
1747 FSTA VERB\r
1748/ SPK=ACTSPK(VERB)\r
1749 ATX 7\r
1750 FLDA ACTSPK-3,7\r
1751 FSTA SPK\r
1752/ IF(WD2.NE.0.AND.VERB.NE.SAY)GOTO 2800\r
1753 FLDA WD2\r
1754 JEQ .+10\r
1755 FLDA VERB\r
1756 FSUB SAY\r
1757 JNE #2800\r
1758/ IF(VERB.EQ.SAY)OBJ=WD2\r
1759 FLDA VERB\r
1760 FSUB SAY\r
1761 JNE .+5\r
1762 FLDA WD2\r
1763 FSTA OBJ\r
1764/ IF(OBJ.NE.0)GOTO 4090\r
1765 FLDA OBJ\r
1766 FSUB ZERO\r
1767 JNE #4090\r
1768\r
1769/C\r
1770/C ANALYSE AN INTRANSITIVE VERB (IE, NO OBJECT GIVEN YET).\r
1771/C\r
1772/4080 GOTO(8010,8000,8000,8040,2009,8040,9070,9080,8000,8000,\r
1773/ 1 2011,9120,9130,8140,9150,8000,8000,8180,8000,8200,\r
1774/ 2 8000,9220,9230,8240,8250,8260,8270,8000,8000,8300,\r
1775/ 3 8310,8320)VERB\r
1776/C TAKE DROP SAY OPEN NOTH LOCK ON OFF WAVE CALM\r
1777/C WALK KILL POUR EAT DRNK RUB TOSS QUIT FIND INVN\r
1778/C FEED FILL BLST SCOR FOO BRF READ BREK WAKE SUSP\r
1779/C HOUR RESU\r
1780#4080, FLDA VERB\r
1781 ATX 1\r
1782 STARTD\r
1783 FLDA .+2,1\r
1784 STARTF\r
1785 JAC\r
1786 JA #8010\r
1787 JA #8000\r
1788 JA #8000\r
1789 JA #8040\r
1790 JA #2009\r
1791 JA #8040\r
1792 JA #9070\r
1793 JA #9080\r
1794 JA #8000\r
1795 JA #8000\r
1796 JA #2011\r
1797 JA #9120\r
1798 JA #9130\r
1799 JA #8140\r
1800 JA #9150\r
1801 JA #8000\r
1802 JA #8000\r
1803 JA #8180\r
1804 JA #8000\r
1805 JA #8200\r
1806 JA #8000\r
1807 JA #9220\r
1808 JA #9230\r
1809 JA #8240\r
1810 JA #8250\r
1811 JA #8260\r
1812 JA #8270\r
1813 JA #8000\r
1814 JA #8000\r
1815 JA #8300\r
1816 JA #8310\r
1817 JA #8320\r
1818/ CALL BUG(23)\r
1819 JSR BUG\r
1820 JA .+4\r
1821 JA #LIT+44\r
1822\r
1823/C\r
1824/C ANALYSE A TRANSITIVE VERB.\r
1825/C\r
1826/4090 GOTO(9010,9020,9030,9040,2009,9040,9070,9080,9090,2011,\r
1827/ 1 2011,9120,9130,9140,9150,9160,9170,2011,9190,9190,\r
1828/ 2 9210,9220,9230,2011,2011,2011,9270,9280,9290,2011,\r
1829/ 3 2011,2011)VERB\r
1830/C TAKE DROP SAY OPEN NOTH LOCK ON OFF WAVE CALM\r
1831/C WALK KILL POUR EAT DRNK RUB TOSS QUIT FIND INVN\r
1832/C FEED FILL BLST SCOR FOO BRF READ BREK WAKE SUSP\r
1833/C HOUR RESU\r
1834#4090, FLDA VERB\r
1835 ATX 1\r
1836 STARTD\r
1837 FLDA .+2,1\r
1838 STARTF\r
1839 JAC\r
1840 JA #9010\r
1841 JA #9020\r
1842 JA #9030\r
1843 JA #9040\r
1844 JA #2009\r
1845 JA #9040\r
1846 JA #9070\r
1847 JA #9080\r
1848 JA #9090\r
1849 JA #2011\r
1850 JA #2011\r
1851 JA #9120\r
1852 JA #9130\r
1853 JA #9140\r
1854 JA #9150\r
1855 JA #9160\r
1856 JA #9170\r
1857 JA #2011\r
1858 JA #9190\r
1859 JA #9190\r
1860 JA #9210\r
1861 JA #9220\r
1862 JA #9230\r
1863 JA #2011\r
1864 JA #2011\r
1865 JA #2011\r
1866 JA #9270\r
1867 JA #9280\r
1868 JA #9290\r
1869 JA #2011\r
1870 JA #2011\r
1871 JA #2011\r
1872 JA #2011\r
1873/ CALL BUG(24)\r
1874 JSR BUG\r
1875 JA .+4\r
1876 JA #LIT+47\r
1877\r
1878/C\r
1879/C ANALYSE AN OBJECT WORD. SEE IF THE THING IS HERE, WHETHER WE'VE GOT A VERB\r
1880/C YET, AND SO ON. OBJECT MUST BE HERE UNLESS VERB IS "FIND" OR "INVENT(ORY)"\r
1881/C (AND NO NEW VERB YET TO BE ANALYSED). WATER AND OIL ARE ALSO FUNNY, SINCE\r
1882/C THEY ARE NEVER ACTUALLY DROPPED AT ANY LOCATION, BUT MIGHT BE HERE INSIDE\r
1883/C THE BOTTLE OR AS A FEATURE OF THE LOCATION.\r
1884/C\r
1885/5000 OBJ=K\r
1886#5000, FLDA K\r
1887 FSTA OBJ\r
1888/ IF(FIXED(K).NE.LOC.AND..NOT.HERE(K))GOTO 5100\r
1889 FLDA K\r
1890 ATX 7\r
1891 FLDA FIXED-3,7\r
1892 FSUB LOC\r
1893 JEQ #5010\r
1894 FLDA K\r
1895 JSA HERE\r
1896 JEQ #5100\r
1897\r
1898/5010 IF(WD2.NE.0)GOTO 2800\r
1899#5010, FLDA WD2\r
1900 JNE #2800\r
1901/ IF(VERB.NE.0)GOTO 4090\r
1902 FLDA VERB\r
1903 JNE #4090\r
1904/ TYPE 5015\r
1905/5015 FORMAT(' What do you want to do with the ',$)\r
81e70d48
PH		 1906 JSR SIXOUT\r
1907 JA .+10\r
84b5715c 1908 JA #5015\r
81e70d48 1909 JA ZERO\r
84b5715c
PH		 1910 JA TWO\r
1911\r
1912/ CALL A5TOA1(WD1,WD1A,WD1X,'?')\r
1913 JSR A5TOA1\r
1914 JA .+10\r
1915 JA WD1\r
1916 JA WD1X\r
1917 JA TQUES\r
1918 TRAP3 #WRITO\r
1919 JA #LIT\r
1920 JA #LINEF+2\r
1921 TRAP3 #RENDO\r
1922/ GOTO 2600\r
1923#LINEF, JA #2600\r
1924 TEXT +(' ')+\r
1925\r
1926/C\r
1927/5100 IF(K.NE.GRATE)GOTO 5110\r
1928#5100, FLDA K\r
1929 FSUB GRATE\r
1930 JNE #5110\r
1931/ IF(LOC.EQ.1.OR.LOC.EQ.4.OR.LOC.EQ.7)K=DPRSSN\r
1932 FLDA LOC\r
1933 FSUB ONE\r
1934 JEQ .+10\r
1935 FSUB THREE\r
1936 JEQ .+5\r
1937 FSUB THREE\r
1938 JNE .+6\r
1939 FLDA DPRSSN\r
1940 FSTA K\r
1941/ IF(LOC.GT.9.AND.LOC.LT.15)K=ENTRNC\r
1942 FLDA LOC\r
1943 FSUB #LIT+14\r
1944 JLE .+13\r
1945 FLDA LOC\r
1946 FSUB #LIT+25\r
1947 JGE .+6\r
1948 FLDA ENTRNC\r
1949 FSTA K\r
1950/ IF(K.NE.GRATE)GOTO 8\r
1951 FLDA K\r
1952 FSUB GRATE\r
1953 JNE #8\r
1954\r
1955/5110 IF(K.NE.DWARF)GOTO 5120\r
1956#5110, FLDA K\r
1957 FSUB DWARF\r
1958 JNE #5120\r
1959/ DO 5112 I=1,5\r
1960 FLDA ONE\r
1961 FSTA I\r
1962\r
1963/ IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 5010\r
1964#G0122, FLDA I\r
1965 ATX 7\r
1966 FLDA DLOC-3,7\r
1967 FSUB LOC\r
1968 JNE #5112\r
1969 FLDA DFLAG\r
1970 FSUB TWO\r
1971 JGE #5010\r
1972/5112 CONTINUE\r
1973#5112, FLDA I\r
1974 FADD ONE\r
1975 FSTA I\r
1976 FSUB #LIT+3\r
1977 JLE #G0122\r
1978\r
1979/5120 IF((LIQ(0).EQ.K.AND.HERE(BOTTLE)).OR.K.EQ.LIQLOC(LOC))GOTO 5010\r
1980#5120, JSA LIQ\r
1981 FSUB K\r
1982 JNE .+10\r
1983 FLDA BOTTLE\r
1984 JSA HERE\r
1985 JNE #5010\r
1986 JSA LIQLOC\r
1987 FSUB K\r
1988 JEQ #5010\r
1989/ IF(OBJ.NE.PLANT.OR..NOT.AT(PLANT2).OR.PROP(PLANT2).EQ.0)GOTO 5130\r
1990 FLDA OBJ\r
1991 FSUB PLANT\r
1992 JNE #5130\r
1993 FLDA PLANT2\r
1994 JSA AT\r
1995 JEQ #5130\r
81e70d48
PH		 1996 FLDA PLANT2\r
1997 ATX 7\r
1998 FLDA PROP-3,7\r
84b5715c
PH		 1999 JEQ #5130\r
2000/ OBJ=PLANT2\r
2001 FLDA PLANT2\r
2002 FSTA OBJ\r
2003/ GOTO 5010\r
2004 JA #5010\r
2005\r
2006/5130 IF(OBJ.NE.KNIFE.OR.KNFLOC.NE.LOC)GOTO 5140\r
2007#5130, FLDA OBJ\r
2008 FSUB KNIFE\r
2009 JNE #5140\r
2010 FLDA KNFLOC\r
2011 FSUB LOC\r
2012 JNE #5140\r
2013/ KNFLOC=-1\r
2014 FLDA MINUS1\r
2015 FSTA KNFLOC\r
2016/ SPK=116\r
2017 FLDA #LIT+170\r
2018 FSTA SPK\r
2019/ GOTO 2011\r
2020 JA #2011\r
2021\r
2022/5140 IF(OBJ.NE.ROD.OR..NOT.HERE(ROD2))GOTO 5190\r
2023#5140, FLDA OBJ\r
2024 FSUB ROD\r
2025 JNE #5190\r
2026 FLDA ROD2\r
2027 JSA HERE\r
2028 JEQ #5190\r
2029/ OBJ=ROD2\r
2030 FLDA ROD2\r
2031 FSTA OBJ\r
2032/ GOTO 5010\r
2033 JA #5010\r
2034\r
2035/5190 IF((VERB.EQ.FIND.OR.VERB.EQ.INVENT).AND.WD2.EQ.0)GOTO 5010\r
2036#5190, FLDA VERB\r
2037 FSUB INVENT\r
2038 JEQ .+10\r
2039 FLDA VERB\r
2040 FSUB FIND\r
2041 JNE .+5\r
2042 FLDA WD2\r
2043 JEQ #5010\r
2044/ TYPE 5199\r
81e70d48
PH		 2045 JSR SIXOUT\r
2046 JA .+10\r
84b5715c 2047 JA #5199\r
81e70d48 2048 JA ZERO\r
84b5715c
PH		 2049 JA TWO\r
2050\r
2051/5199 FORMAT(' I don''t see any ',$)\r
2052\r
2053/ CALL A5TOA1(WD1,WD1A,WD1X,'.')\r
2054/ GOTO 2012\r
2055 JSR A5TOA1\r
2056 JA #2012\r
2057 JA WD1\r
2058 JA WD1X\r
2059 JA TQDOT\r
2060\r
2061/C FIGURE OUT THE NEW LOCATION\r
2062/C\r
2063/C GIVEN THE CURRENT LOCATION IN "LOC", AND A MOTION VERB NUMBER IN "K", PUT\r
2064/C THE NEW LOCATION IN "NEWLOC". THE CURRENT LOC IS SAVED IN "OLDLOC" IN CASE\r
2065/C HE WANTS TO RETREAT. THE CURRENT OLDLOC IS SAVED IN OLDLC2, IN CASE HE\r
2066/C DIES. (IF HE DOES, NEWLOC WILL BE LIMBO, AND OLDLOC WILL BE WHAT KILLED\r
2067/C HIM, SO WE NEED OLDLC2, WHICH IS THE LAST PLACE HE WAS SAFE.)\r
2068/C\r
2069/8 KK=KEY(LOC)\r
2070#8, FLDA LOC\r
2071 ATX 7\r
2072 FLDA KEY-3,7\r
2073 FSTA KK\r
2074/ NEWLOC=LOC\r
2075 FLDA LOC\r
2076 FSTA NEWLOC\r
2077/ IF(KK.EQ.0)CALL BUG(26)\r
2078 FLDA KK\r
2079 JNE .+10\r
2080 JSR BUG\r
2081 JA .+4\r
2082 JA #LIT+55\r
2083/ IF(K.EQ.NULL)GOTO 2\r
2084 FLDA K\r
2085 FSUB NULL\r
2086 JEQ #2\r
2087/ IF(K.EQ.BACK)GOTO 20\r
2088 FLDA K\r
2089 FSUB BACK\r
2090 JEQ #20\r
2091/ IF(K.EQ.LOOK)GOTO 30\r
2092 FLDA K\r
2093 FSUB LOOK\r
2094 JEQ #30\r
2095/ IF(K.EQ.CAVE)GOTO 40\r
2096 FLDA K\r
2097 FSUB CAVE\r
2098 JEQ #40\r
2099/ OLDLC2=OLDLOC\r
2100 FLDA OLDLOC\r
2101 FSTA OLDLC2\r
2102/ OLDLOC=LOC\r
2103 FLDA LOC\r
2104 FSTA OLDLOC\r
2105/C\r
2106/9 LL=IABS(TRAVEL(KK))\r
2107#9, JSR GETWRD\r
2108 JA .+10\r
2109 JA TRAVEL\r
2110 JA KK\r
2111 JA ZERO\r
2112 FSTA #TMP\r
2113 JSR IABS\r
2114 JA .+4\r
2115 JA #TMP\r
2116 FSTA LL\r
2117/ IF(LL.EQ.1 .OR. LL.EQ.K)GOTO 10\r
2118 FSUB ONE\r
2119 JEQ #10\r
2120 FLDA LL\r
2121 FSUB K\r
2122 JEQ #10\r
2123/ IF(TRAVEL(KK).LT.0)GOTO 50\r
2124 JSR GETWRD\r
2125 JA .+10\r
2126 JA TRAVEL\r
2127 JA KK\r
2128 JA ZERO\r
2129 JLT #50\r
2130/ KK=KK+1\r
2131 FLDA ONE\r
2132 FADDM KK\r
2133/ GOTO 9\r
2134 JA #9\r
2135\r
2136/C\r
2137/10 NEWLOC=TRVCON(KK)\r
2138#10, JSR GETWRD\r
2139 JA .+10\r
2140 JA TRVCON\r
2141 JA KK\r
2142 JA ZERO\r
2143 FSTA NEWLOC\r
2144/ K=MOD(NEWLOC,100)\r
2145 JSR MOD\r
2146 JA .+6\r
2147 JA NEWLOC\r
2148 JA #LIT+154\r
2149 FSTA K\r
2150/ IF(NEWLOC.LE.300)GOTO 13\r
2151 FLDA NEWLOC\r
2152 FSUB #LIT+306\r
2153 JLE #13\r
2154/ IF(PROP(K).NE.NEWLOC/100-3)GOTO 16\r
2155 FLDA K\r
2156 ATX 7\r
2157 FLDA NEWLOC\r
2158 FDIV #LIT+154\r
2159 JSA #FIX\r
2160 FSUB THREE\r
2161 FSUB PROP-3,7\r
2162 JNE #16\r
2163/C\r
2164/C TRY NEXT ENTRY IN TRAVEL TABLE\r
2165/C\r
2166/12 IF(TRAVEL(KK).LT.0)CALL BUG(25)\r
2167#12, JSR GETWRD\r
2168 JA .+10\r
2169 JA TRAVEL\r
2170 JA KK\r
2171 JA ZERO\r
2172 JGE .+10\r
2173 JSR BUG\r
2174 JA .+4\r
2175 JA #LIT+52\r
2176/ KK=KK+1\r
2177 FLDA KK\r
2178 FSTA #TMP\r
2179 FADD ONE\r
2180 FSTA KK\r
2181\r
2182/C MAKE SURE HE DOESN'T GO THROUGH SAME TEST AGAIN\r
2183/C\r
2184/ IF(TRVCON(KK-1).EQ.TRVCON(KK) .AND. TRVLOC(KK-1).EQ.TRVLOC(KK))\r
2185/ 1 GOTO 12\r
2186 JSR GETWRD\r
2187 JA .+10\r
2188 JA TRVCON\r
2189 JA #TMP\r
2190 JA ZERO\r
2191 FSTA #TMP+3\r
2192 JSR GETWRD\r
2193 JA .+10\r
2194 JA TRVCON\r
2195 JA KK\r
2196 JA ZERO\r
2197 FSUB #TMP+3\r
2198 JNE #10\r
2199\r
2200 JSR GETWRD\r
2201 JA .+10\r
2202 JA TRVLOC\r
2203 JA #TMP\r
2204 JA ZERO\r
2205 FSTA #TMP+3\r
2206\r
2207 JSR GETWRD\r
2208 JA .+10\r
2209 JA TRVLOC\r
2210 JA #TMP\r
2211 FSUB #TMP+3\r
2212 JEQ #12\r
2213/ GO TO 10\r
2214 JA #10\r
2215/C\r
2216/13 IF(NEWLOC.LE.100)GOTO 14\r
2217#13, FLDA NEWLOC\r
2218 FSUB #LIT+154\r
2219 JLE #14\r
2220/ IF(TOTING(K).OR.(NEWLOC.GT.200.AND.AT(K)))GOTO 16\r
2221 FLDA K\r
2222 JSA TOTING\r
2223 JNE #16\r
81e70d48 2224 LDX 310,0 /200\r
84b5715c
PH		 2225 XTA 0\r
2226 FSUB NEWLOC\r
2227 JGT #12\r
2228 FLDA K\r
2229 JSA AT\r
2230 JNE #16\r
2231/ GOTO 12\r
2232 JA #12\r
2233\r
2234/C\r
2235/14 IF(NEWLOC.NE.0.AND..NOT.PCT(NEWLOC))GOTO 12\r
2236#14, FLDA NEWLOC\r
2237 JEQ #16\r
2238 JSR PCT\r
2239 JA .+4\r
2240 JA NEWLOC\r
2241 JEQ #12\r
2242\r
2243/16 NEWLOC=TRVLOC(KK)\r
2244#16, JSR GETWRD\r
2245 JA .+10\r
2246 JA TRVLOC\r
2247 JA KK\r
2248 JA ZERO\r
2249 FSTA NEWLOC\r
2250/ IF(NEWLOC.LE.300)GOTO 2\r
2251 FSUB #LIT+306\r
2252 JLE #2\r
2253/ IF(NEWLOC.LE.500)GOTO 30000\r
2254 FLDA NEWLOC\r
2255 FSUB #LIT+311\r
2256 JLE #30000\r
2257/ CALL RSPEAK(NEWLOC-500)\r
2258/ FLDA NEWLOC\r
2259/ FSUB #LIT+311\r
2260 FSTA #TMP\r
2261 JSR RSPEAK\r
2262 JA .+4\r
2263 JA #TMP\r
2264/ NEWLOC=LOC\r
2265 FLDA LOC\r
2266 FSTA NEWLOC\r
2267/ GOTO 2\r
2268 JA #2\r
2269\r
2270/C\r
2271/C SPECIAL MOTIONS COME HERE. LABELLING CONVENTION: STATEMENT NUMBERS NNNXX\r
2272/C (XX=00-99) ARE USED FOR SPECIAL CASE NUMBER NNN (NNN=301-500).\r
2273/C\r
2274/30000 NEWLOC=NEWLOC-300\r
2275#30000, FLDA NEWLOC\r
2276 FSUB #LIT+306\r
2277 FSTA NEWLOC\r
2278/ GOTO (30100,30200,30300)NEWLOC\r
2279/ FLDA NEWLOC\r
2280 ATX 1\r
2281 STARTD\r
2282 FLDA .+2,1\r
2283 STARTF\r
2284 JAC\r
2285 JA #30100\r
2286 JA #30200\r
2287 JA #30300\r
2288/ CALL BUG(20)\r
2289 JSR BUG\r
2290 JA .+4\r
2291 JA #LIT+36\r
2292\r
2293/C\r
2294/C TRAVEL 301. PLOVER-ALCOVE PASSAGE. CAN CARRY ONLY EMERALD. NOTE: TRAVEL\r
2295/C TABLE MUST INCLUDE "USELESS" ENTRIES GOING THROUGH PASSAGE, WHICH CAN NEVER\r
2296/C BE USED FOR ACTUAL MOTION, BUT CAN BE SPOTTED BY "GO BACK".\r
2297/C\r
2298/30100 NEWLOC=99+100-LOC\r
2299#30100, FLDA #LIT+300 /199\r
2300 FSUB LOC\r
2301 FSTA NEWLOC\r
2302/ IF(HOLDNG.EQ.0.OR.(HOLDNG.EQ.1.AND.TOTING(EMRALD)))GOTO 2\r
2303 FLDA HOLDNG\r
2304 JEQ #2\r
2305 FSUB ONE\r
2306 JNE #M27\r
2307 FLDA EMRALD\r
2308 JSA TOTING\r
2309 JNE #2\r
2310/ NEWLOC=LOC\r
2311#M27, FLDA LOC\r
2312 FSTA NEWLOC\r
2313/ CALL RSPEAK(117)\r
2314/ GOTO 2\r
2315 JSR RSPEAK\r
2316 JA #2\r
2317 JA #LIT+173\r
2318\r
2319/C\r
2320/C TRAVEL 302. PLOVER TRANSPORT. DROP THE EMERALD (ONLY USE SPECIAL TRAVEL IF\r
2321/C TOTING IT), SO HE'S FORCED TO USE THE PLOVER-PASSAGE TO GET IT OUT. HAVING\r
2322/C DROPPED IT, GO BACK AND PRETEND HE WASN'T CARRYING IT AFTER ALL.\r
2323/C\r
2324/30200 CALL DROP(EMRALD,LOC)\r
2325/GOTO 12\r
2326#30200, JSR DROP\r
2327 JA #12\r
2328 JA EMRALD\r
2329 JA LOC\r
2330\r
2331/C\r
2332/C TRAVEL 303. TROLL BRIDGE. MUST BE DONE ONLY AS SPECIAL MOTION SO THAT\r
2333/C DWARVES WON'T WANDER ACROSS AND ENCOUNTER THE BEAR. (THEY WON'T FOLLOW THE\r
2334/C PLAYER THERE BECAUSE THAT REGION IS FORBIDDEN TO THE PIRATE.) IF\r
2335/C PROP(TROLL)=1, HE'S CROSSED SINCE PAYING, SO STEP OUT AND BLOCK HIM.\r
2336/C (STANDARD TRAVEL ENTRIES CHECK FOR PROP(TROLL)=0.) SPECIAL STUFF FOR BEAR.\r
2337/C\r
2338/30300 IF(PROP(TROLL).NE.1)GOTO 30310\r
2339#30300, FLDA TROLL\r
81e70d48
PH		 2340 ATX 7\r
2341 FLDA PROP-3,7\r
84b5715c
PH		 2342 FSUB ONE\r
2343 JNE #30310\r
2344/ CALL PSPEAK(TROLL,1)\r
2345 JSR PSPEAK\r
2346 JA .+6\r
2347 JA TROLL\r
2348 JA ONE\r
2349/ PROP(TROLL)=0\r
2350 FCLA\r
2351 FSTA PROP-3,7\r
2352/ CALL MOVE(TROLL2,0)\r
2353 JSR MOVE\r
2354 JA .+6\r
2355 JA TROLL2\r
2356 JA ZERO\r
2357/ CALL MOVE(TROLL2+100,0)\r
2358 FLDA TROLL2\r
2359 FADD #LIT+154\r
2360 FSTA #TMP\r
2361 JSR MOVE\r
2362 JA .+6\r
2363 JA #TMP\r
2364 JA ZERO\r
2365/ CALL MOVE(TROLL,PLAC(TROLL))\r
2366 FLDA TROLL\r
2367 ATX 7\r
81e70d48
PH		 2368 XTA 7\r
2369 FMUL THREE\r
2370 ALN 0\r
2371 STARTD\r
2372 FADD PPLAC\r
2373 FSTA .+11\r
2374 STARTF\r
84b5715c
PH		 2375 JSR MOVE\r
2376 JA .+6\r
2377 JA TROLL\r
81e70d48 2378 JA .\r
84b5715c
PH		 2379/ CALL MOVE(TROLL+100,FIXD(TROLL))\r
2380 FLDA TROLL\r
84b5715c
PH		 2381 FADD #LIT+154\r
2382 FSTA #TMP\r
81e70d48
PH		 2383 FLDA TROLL\r
2384 ATX 7\r
2385 XTA 7\r
2386 FMUL THREE\r
2387 ALN 0\r
2388 STARTD\r
2389 FADD PFIXD\r
2390 FSTA .+11\r
2391 STARTF\r
84b5715c
PH		 2392 JSR MOVE\r
2393 JA .+6\r
2394 JA #TMP\r
81e70d48 2395 JA .\r
84b5715c 2396/ CALL JUGGLE(CHASM)\r
81e70d48
PH		 2397 JSR JUGGLE\r
2398 JA .+4\r
2399 JA CHASM\r
84b5715c
PH		 2400/ NEWLOC=LOC\r
2401 FLDA LOC\r
2402 FSTA NEWLOC\r
2403/ GOTO 2\r
2404 JA #2\r
2405\r
2406/C\r
2407/30310 NEWLOC=PLAC(TROLL)+FIXD(TROLL)-LOC\r
2408#30310, FLDA TROLL\r
2409 ATX 7\r
2410 FLDA PLAC-3,7\r
2411 FADD FIXD-3,7\r
2412 FSUB LOC\r
2413 FSTA NEWLOC\r
2414/ IF(PROP(TROLL).EQ.0)PROP(TROLL)=1\r
2415 FLDA PROP-3,7\r
2416 JNE .+5\r
2417 FLDA ONE\r
2418 FSTA PROP-3,7\r
2419/ IF(.NOT.TOTING(BEAR))GOTO 2\r
2420 FLDA BEAR\r
2421 JSA TOTING\r
2422 JEQ #2\r
2423/ CALL RSPEAK(162)\r
2424 JSR RSPEAK\r
2425 JA .+4\r
2426 JA #LIT+237\r
2427/ PROP(CHASM)=1\r
2428 FLDA CHASM\r
2429 ATX 7\r
2430 FLDA ONE\r
81e70d48 2431/ PROP(TROLL)=2\r
84b5715c 2432 FSTA PROP-3,7\r
84b5715c
PH		 2433 FLDA TROLL\r
2434 ATX 7\r
2435 FLDA TWO\r
2436 FSTA PROP-3,7\r
2437/ CALL DROP(BEAR,NEWLOC)\r
2438 JSR DROP\r
2439 JA .+6\r
2440 JA BEAR\r
2441 JA NEWLOC\r
2442/ FIXED(BEAR)=-1\r
2443 FLDA BEAR\r
2444 ATX 7\r
2445 FLDA MINUS1\r
2446 FSTA FIXED-3,7\r
2447/ PROP(BEAR)=3\r
2448 FLDA THREE\r
2449 FSTA PROP-3,7\r
2450/ IF(PROP(SPICES).LT.0)TALLY2=TALLY2+1\r
2451 FLDA SPICES\r
81e70d48
PH		 2452 ATX 7\r
2453 FLDA PROP-3,7\r
84b5715c
PH		 2454 JGE .+7\r
2455 FLDA TALLY2\r
2456 FADD ONE\r
2457 FSTA TALLY2\r
2458/ OLDLC2=NEWLOC\r
2459 FLDA NEWLOC\r
2460 FSTA OLDLC2\r
2461/ GOTO 99\r
2462 JA #99\r
2463\r
2464/C\r
2465/C END OF SPECIALS.\r
2466/C\r
2467/C HANDLE "GO BACK". LOOK FOR VERB WHICH GOES FROM LOC TO OLDLOC, OR TO OLDLC2\r
2468/C IF OLDLOC HAS FORCED-MOTION. K2 SAVES ENTRY -> FORCED LOC -> PREVIOUS LOC.\r
2469/C\r
2470/20 K=OLDLOC\r
2471#20, FLDA OLDLOC\r
2472 FSTA K\r
2473/ IF(FORCED(K))K=OLDLC2\r
2474/ FLDA K\r
2475 JSA FORCED\r
2476 JEQ .+6\r
2477 FLDA OLDLC2\r
2478 FSTA K\r
2479/ OLDLC2=OLDLOC\r
2480 FLDA OLDLOC\r
2481 FSTA OLDLC2\r
2482/ OLDLOC=LOC\r
2483 FLDA LOC\r
2484 FSTA OLDLOC\r
2485/ K2=0\r
2486 FCLA\r
2487 FSTA K2\r
2488/ IF(K.NE.LOC)GOTO 21\r
2489 FLDA K\r
2490 FSUB LOC\r
2491 JNE #21\r
2492/ CALL RSPEAK(91)\r
2493/ GOTO 2\r
2494 JSR RSPEAK\r
2495 JA #2\r
2496 JA #LIT+140\r
2497\r
2498/C\r
2499/21 LL=TRVLOC(KK)\r
2500#21, JSR GETWRD\r
2501 JA .+10\r
2502 JA TRVLOC\r
2503 JA KK\r
2504 JA ZERO\r
2505 FSTA LL\r
2506/ IF(LL.EQ.K)GOTO 25\r
2507 FSUB K\r
2508 JEQ #25\r
2509/ IF(LL.GT.300)GOTO 22\r
2510 FLDA LL\r
2511 FSUB #LIT+306\r
2512 JGT #22\r
2513/ J=KEY(LL)\r
2514 FLDA LL\r
2515 ATX 7\r
2516 FLDA KEY-3,7\r
2517 FSTA J\r
2518/ IF(FORCED(LL).AND.TRVLOC(KK).EQ.K)K2=KK\r
2519 FLDA LL\r
2520 JSA FORCED\r
2521 JEQ #22\r
2522 JSR GETWRD\r
2523 JA .+10\r
2524 JA TRVLOC\r
2525 JA KK\r
2526 JA ZERO\r
2527 FSUB K\r
2528 JNE #22\r
2529 FLDA KK\r
2530 FSTA K2\r
2531/22 IF(TRAVEL(KK).LT.0)GOTO 23\r
2532#22, JSR GETWRD\r
2533 JA .+10\r
2534 JA TRAVEL\r
2535 JA KK\r
2536 JA ZERO\r
2537 JLT #23\r
2538/ KK=KK+1\r
2539 FLDA ONE\r
2540 FADDM KK\r
2541/ GOTO 21\r
2542 JA #21\r
2543\r
2544/C\r
2545/23 KK=K2\r
2546#23, FLDA K2\r
2547 FSTA KK\r
2548/ IF(KK.NE.0)GOTO 25\r
2549 JNE #25\r
2550/ CALL RSPEAK(140)\r
2551/ GOTO 2\r
2552 JSR RSPEAK\r
2553 JA #2\r
2554 JA #LIT+223\r
2555\r
2556/C\r
2557/25 K=IABS(TRAVEL(KK))\r
2558#25, JSR GETWRD\r
2559 JA .+10\r
2560 JA TRAVEL\r
2561 JA KK\r
2562 JA ZERO\r
2563 FSTA #TMP\r
2564 JSR IABS\r
2565 JA .+4\r
2566 JA #TMP\r
2567 FSTA K\r
2568/ KK=KEY(LOC)\r
2569 FLDA LOC\r
2570 ATX 7\r
2571 FLDA KEY-3,7\r
2572 FSTA KK\r
2573/ GOTO 9\r
2574 JA #9\r
2575\r
2576/C\r
2577/C LOOK. CAN'T GIVE MORE DETAIL. PRETEND IT WASN'T DARK (THOUGH IT MAY "NOW"\r
2578/C BE DARK) SO HE WON'T FALL INTO A PIT WHILE STARING INTO THE GLOOM.\r
2579/C\r
2580/30 IF(DETAIL.LT.3)CALL RSPEAK(15)\r
2581#30, FLDA DETAIL\r
2582 FSUB THREE\r
2583 JGE .+10\r
2584 JSR RSPEAK\r
2585 JA .+4\r
2586 JA #LIT+25\r
2587/ DETAIL=DETAIL+1\r
2588 FLDA ONE\r
2589 FADDM DETAIL\r
2590/ WZDARK=.FALSE.\r
2591 FCLA\r
2592 FSTA WZDARK\r
2593/ ABB(LOC)=0\r
2594 FLDA LOC\r
2595 ATX 7\r
2596 FCLA\r
2597 FSTA ABB-3,7\r
2598/ GOTO 2\r
2599 JA #2\r
2600\r
2601/C\r
2602/C CAVE. DIFFERENT MESSAGES DEPENDING ON WHETHER ABOVE GROUND.\r
2603/C\r
2604/40 IF(LOC.LT.8)CALL RSPEAK(57)\r
2605#40, FLDA LOC\r
2606 FSUB #LIT+11\r
2607 JGE .+10\r
2608 JSR RSPEAK\r
2609 JA #2\r
2610 JA #LIT+116\r
2611/ IF(LOC.GE.8)CALL RSPEAK(58)\r
2612/ GOTO 2\r
2613 JSR RSPEAK\r
2614 JA #2\r
2615 JA #LIT+121\r
2616\r
2617/C\r
2618/C NON-APPLICABLE MOTION. VARIOUS MESSAGES DEPENDING ON WORD GIVEN.\r
2619/C\r
2620/50 SPK=12\r
2621#50, FLDA #LIT+22\r
2622 FSTA SPK\r
2623/ IF(K.GE.43.AND.K.LE.50)SPK=9\r
81e70d48 2624 LDX 53,0 /43\r
84b5715c
PH		 2625 XTA 0\r
2626 FSUB K\r
81e70d48 2627 JGE .+7\r
84b5715c
PH		 2628 FLDA K\r
2629 FSUB #LIT+110\r
2630 JLE #M31\r
2631/ IF(K.EQ.29.OR.K.EQ.30)SPK=9\r
81e70d48
PH		 2632 LDX 35,0 /29\r
2633 XTA 0\r
84b5715c
PH		 2634 FSUB K\r
2635 JEQ #M31\r
2636 FADD ONE\r
81e70d48
PH		 2637 JEQ #M31\r
2638 JA #M33\r
84b5715c
PH		 2639#M31, FLDA #LIT+14\r
2640 FSTA SPK\r
2641 JA #M32\r
2642/ IF(K.EQ.7.OR.K.EQ.36.OR.K.EQ.37)SPK=10\r
2643 LDX 7,0\r
2644 XTA 0\r
2645 FSUB K\r
2646 JEQ #M34\r
81e70d48 2647 LDX 44,0\r
84b5715c
PH		 2648 XTA 0\r
2649 FSUB K\r
2650 JEQ #M34\r
2651 FADD ONE\r
2652 JNE #M35\r
2653#M34, FLDA #LIT+17\r
2654 FSTA SPK\r
2655 JA #M32\r
2656/ IF(K.EQ.11.OR.K.EQ.19)SPK=11\r
81e70d48 2657#M35, LDX 13,0 /11\r
84b5715c
PH		 2658 XTA 0\r
2659 FSUB K\r
2660 JEQ #M36\r
81e70d48 2661 LDX 23,0 /19\r
84b5715c
PH		 2662 XTA 0\r
2663 FSUB K\r
2664 JNE #M32\r
81e70d48 2665#M36, LDX 13,0\r
84b5715c
PH		 2666 XTA 0\r
2667 FSTA SPK\r
2668/ IF(VERB.EQ.FIND.OR.VERB.EQ.INVENT)SPK=59\r
2669#M32, FLDA VERB\r
2670 FSUB INVENT\r
2671 JEQ #M37\r
2672 FLDA VERB\r
2673 FSUB FIND\r
2674 JNE #M38\r
81e70d48 2675#M37, LDX 73,0 /59\r
84b5715c
PH		 2676 XTA 0\r
2677 FSTA SPK\r
2678/ IF(K.EQ.62.OR.K.EQ.65)SPK=42\r
2679#M38, FLDA K\r
2680 FSUB #LIT+124\r
2681 JEQ #M39\r
2682 FSUB THREE\r
2683 JNE #M40\r
81e70d48 2684#M39, LDX 52,0 /42\r
84b5715c
PH		 2685 XTA 0\r
2686 FSTA SPK\r
2687/ IF(K.EQ.17)SPK=80\r
2688#M40, FLDA K\r
2689 FSUB #LIT+33\r
2690 JNE #M33\r
81e70d48
PH		 2691 LDX 120,0 /80\r
2692 XTA 0\r
84b5715c
PH		 2693 FSTA SPK\r
2694/ CALL RSPEAK(SPK)\r
2695/ GOTO 2\r
2696#M33, JSR RSPEAK\r
2697 JA #2\r
2698 JA SPK\r
2699\r
2700/C "YOU'RE DEAD, JIM."\r
2701/C\r
2702/C IF THE CURRENT LOC IS ZERO, IT MEANS THE CLOWN GOT HIMSELF KILLED. WE'LL\r
2703/C ALLOW THIS MAXDIE TIMES. MAXDIE IS AUTOMATICALLY SET BASED ON THE NUMBER OF\r
2704/C SNIDE MESSAGES AVAILABLE. EACH DEATH RESULTS IN A MESSAGE (81, 83, ETC.)\r
2705/C WHICH OFFERS REINCARNATION; IF ACCEPTED, THIS RESULTS IN MESSAGE 82, 84,\r
2706/C ETC. THE LAST TIME, IF HE WANTS ANOTHER CHANCE, HE GETS A SNIDE REMARK AS\r
2707/C WE EXIT. WHEN REINCARNATED, ALL OBJECTS BEING CARRIED GET DROPPED AT OLDLC2\r
2708/C (PRESUMABLY THE LAST PLACE PRIOR TO BEING KILLED) WITHOUT CHANGE OF PROPS.\r
2709/C THE LOOP RUNS BACKWARDS TO ASSURE THAT THE BIRD IS DROPPED BEFORE THE CAGE.\r
2710/C (THIS KLUGE COULD BE CHANGED ONCE WE'RE SURE ALL REFERENCES TO BIRD AND CAGE\r
2711/C ARE DONE BY KEYWORDS.) THE LAMP IS A SPECIAL CASE (IT WOULDN'T DO TO LEAVE\r
2712/C IT IN THE CAVE). IT IS TURNED OFF AND LEFT OUTSIDE THE BUILDING (ONLY IF HE\r
2713/C WAS CARRYING IT, OF COURSE). HE HIMSELF IS LEFT INSIDE THE BUILDING (AND\r
2714/C HEAVEN HELP HIM IF HE TRIES TO XYZZY BACK INTO THE CAVE WITHOUT THE LAMP!).\r
2715/C OLDLOC IS ZAPPED SO HE CAN'T JUST "RETREAT".\r
2716/C\r
2717/C THE EASIEST WAY TO GET KILLED IS TO FALL INTO A PIT IN PITCH DARKNESS.\r
2718/C\r
2719/90 CALL RSPEAK(23)\r
2720#90, JSR RSPEAK\r
2721 JA .+4\r
2722 JA #LIT+44\r
2723/ OLDLC2=LOC\r
2724 FLDA LOC\r
2725 FSTA OLDLC2\r
2726/C\r
2727/C OKAY, HE'S DEAD. LET'S GET ON WITH IT.\r
2728/C\r
2729/99 IF(CLOSNG)GOTO 95\r
2730#99, FLDA CLOSNG\r
2731 JNE #95\r
2732/ YEA=YES(81+NUMDIE*2,82+NUMDIE*2,54)\r
2733 FLDA NUMDIE\r
2734 FADD NUMDIE\r
2735 FADD #LIT+132\r
2736 FSTA #TMP\r
81e70d48 2737 FLDA #TMP\r
84b5715c
PH		 2738 FADD ONE\r
2739 FSTA #TMP+3\r
2740 JSR YES\r
2741 JA .+10\r
2742 JA #TMP\r
2743 JA #TMP+3\r
2744 JA #LIT+113\r
2745 FSTA YEA\r
2746/ NUMDIE=NUMDIE+1\r
2747 FLDA NUMDIE\r
2748 FADD ONE\r
2749 FSTA NUMDIE\r
2750/ IF(NUMDIE.EQ.MAXDIE.OR..NOT.YEA)GOTO 20000\r
2751 FSUB MAXDIE\r
2752 JEQ #20000\r
2753 FLDA YEA\r
2754 JEQ #20000\r
2755/ PLACE(WATER)=0\r
2756 FLDA WATER\r
2757 ATX 7\r
2758 FCLA\r
2759 FSTA PLACE-3,7\r
2760/ PLACE(OIL)=0\r
2761 FLDA OIL\r
2762 ATX 7\r
2763 FCLA\r
2764 FSTA PLACE-3,7\r
2765/ IF(TOTING(LAMP))PROP(LAMP)=0\r
2766 FLDA LAMP\r
2767 JSA TOTING\r
81e70d48
PH		 2768 JEQ .+10\r
2769 FLDA LAMP\r
2770 ATX 7\r
84b5715c 2771 FCLA\r
81e70d48 2772 FSTA PROP-3,7\r
84b5715c
PH		 2773/ DO 98 J=1,100\r
2774 FLDA ONE\r
2775 FSTA J\r
2776\r
2777/ I=101-J\r
81e70d48 2778#G0150, LDX 145,0 /101\r
84b5715c
PH		 2779 XTA 0\r
2780 FSUB J\r
2781 FSTA I\r
2782/ IF(.NOT.TOTING(I))GOTO 98\r
2783 JSA TOTING\r
2784 JEQ #98\r
2785/ K=OLDLC2\r
2786 FLDA OLDLC2\r
2787 FSTA K\r
2788/ IF(I.EQ.LAMP)K=1\r
2789 FLDA I\r
2790 FSUB LAMP\r
2791 JNE .+5\r
2792 FLDA ONE\r
2793 FSTA K\r
2794/ CALL DROP(I,K)\r
2795 JSR DROP\r
2796 JA .+6\r
2797 JA I\r
2798 JA K\r
2799\r
2800/98 CONTINUE\r
2801#98, FLDA J\r
2802 FADD ONE\r
2803 FSTA J\r
2804 FSUB #LIT+154\r
2805 JLE #G0150\r
2806/ LOC=3\r
2807 FLDA THREE\r
2808/ OLDLOC=LOC\r
2809 FSTA LOC\r
2810 FSTA OLDLOC\r
2811/ GOTO 2000\r
2812 JA #2000\r
2813\r
2814/C\r
2815/C HE DIED DURING CLOSING TIME. NO RESURRECTION. TALLY UP A DEATH AND EXIT.\r
2816/C\r
2817/95 CALL RSPEAK(131)\r
2818#95, JSR RSPEAK\r
2819 JA .+4\r
2820 JA #LIT+212\r
2821/ NUMDIE=NUMDIE+1\r
2822 FLDA ONE\r
2823 FADDM NUMDIE\r
2824/ GOTO 20000\r
2825 JA #20000\r
2826\r
2827/C ROUTINES FOR PERFORMING THE VARIOUS ACTION VERBS\r
2828/C\r
2829/C STATEMENT NUMBERS IN THIS SECTION ARE 8000 FOR INTRANSITIVE VERBS, 9000 FOR\r
2830/C TRANSITIVE, PLUS TEN TIMES THE VERB NUMBER. MANY INTRANSITIVE VERBS USE THE\r
2831/C TRANSITIVE CODE, AND SOME VERBS USE CODE FOR OTHER VERBS, AS NOTED BELOW.\r
2832/C\r
2833/C RANDOM INTRANSITIVE VERBS COME HERE. CLEAR OBJ JUST IN CASE (SEE "ATTACK").\r
2834/C\r
2835/8000 TYPE 8002\r
81e70d48
PH		 2836#8000, JSR SIXOUT\r
2837 JA .+10\r
84b5715c 2838 JA #8002\r
81e70d48 2839 JA ZERO\r
84b5715c
PH		 2840 JA TWO\r
2841\r
2842/8002 FORMAT(' I don''t understand "',$)\r
2843/ CALL A5TOA1(WD1,WD1A,WD1X,'".')\r
2844 JSR A5TOA1\r
2845 JA .+10\r
2846 JA WD1\r
2847 JA WD1X\r
2848 JA TQDOT\r
2849/ OBJ=0\r
2850 FCLA\r
2851 FSTA OBJ\r
2852 TRAP3 #WRITO\r
2853 JA #LIT\r
2854 JA #LINEF+2\r
2855 TRAP3 #RENDO\r
2856/ GOTO 2600\r
2857 JA #2600\r
2858\r
2859/C\r
2860/C CARRY, NO OBJECT GIVEN YET. OK IF ONLY ONE OBJECT PRESENT.\r
2861/C\r
2862/8010 IF(ATLOC(LOC).EQ.0.OR.LINK(ATLOC(LOC)).NE.0)GOTO 8000\r
2863#8010, FLDA LOC\r
2864 ATX 7\r
2865 FLDA ATLOC-3,7\r
2866 JEQ #8000\r
2867 ATX 6\r
2868 FLDA LINK-3,6\r
2869 JNE #8000\r
2870/ DO 8012 I=1,5\r
2871 FLDA ONE\r
2872 FSTA I\r
2873\r
2874/ IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 8000\r
2875#G0152, FLDA I\r
2876 ATX 7\r
2877 FLDA DLOC-3,7\r
2878 FSUB LOC\r
2879 JNE #8012\r
2880 FLDA DFLAG\r
2881 FSUB TWO\r
2882 JGE #8000\r
2883\r
2884/8012 CONTINUE\r
2885#8012, FLDA I\r
2886 FADD ONE\r
2887 FSTA I\r
2888 FSUB #LIT+3\r
2889 JLE #G0152\r
2890/ OBJ=ATLOC(LOC)\r
2891 FLDA LOC\r
2892 ATX 7\r
2893 FLDA ATLOC-3,7\r
2894 FSTA OBJ\r
2895\r
2896/C\r
2897/C CARRY AN OBJECT. SPECIAL CASES FOR BIRD AND CAGE (IF BIRD IN CAGE, CAN'T\r
2898/C TAKE ONE WITHOUT THE OTHER. LIQUIDS ALSO SPECIAL, SINCE THEY DEPEND ON\r
2899/C STATUS OF BOTTLE. ALSO VARIOUS SIDE EFFECTS, ETC.\r
2900/C\r
2901/9010 IF(TOTING(OBJ))GOTO 2011\r
2902#9010, FLDA OBJ\r
2903 JSA TOTING\r
2904 JNE #2011\r
2905/ SPK=25\r
2906 FLDA #LIT+52\r
2907 FSTA SPK\r
2908/ IF(OBJ.EQ.PLANT.AND.PROP(PLANT).LE.0)SPK=115\r
2909 FLDA OBJ\r
2910 FSUB PLANT\r
81e70d48 2911 JNE .+13\r
84b5715c 2912 FLDA PLANT\r
81e70d48
PH		 2913 ATX 7\r
2914 FLDA PROP-3,7\r
84b5715c
PH		 2915 JGT .+4\r
2916 FLDA #LIT+165\r
2917 FSTA SPK\r
2918/ IF(OBJ.EQ.BEAR.AND.PROP(BEAR).EQ.1)SPK=169\r
2919 FLDA OBJ\r
2920 FSUB BEAR\r
81e70d48 2921 JNE .+16\r
84b5715c 2922 FLDA BEAR\r
81e70d48
PH		 2923 ATX 7\r
2924 FLDA PROP-3,7\r
84b5715c
PH		 2925 FSUB ONE\r
2926 JNE .+6\r
81e70d48 2927 LDX 251,0 /169\r
84b5715c
PH		 2928 XTA 0\r
2929 FSTA SPK\r
2930/ IF(OBJ.EQ.CHAIN.AND.PROP(BEAR).NE.0)SPK=170\r
2931 FLDA OBJ\r
2932 FSUB CHAIN\r
81e70d48 2933 JNE .+15\r
84b5715c 2934 FLDA BEAR\r
81e70d48
PH		 2935 ATX 7\r
2936 FLDA PROP-3,7\r
84b5715c 2937 JEQ .+6\r
81e70d48 2938 LDX 252,0 /170\r
84b5715c
PH		 2939 XTA 0\r
2940 FSTA SPK\r
2941/ IF(FIXED(OBJ).NE.0)GOTO 2011\r
2942 FLDA OBJ\r
2943 ATX 7\r
2944 FLDA FIXED-3,7\r
2945 JNE #2011\r
2946/ IF(OBJ.NE.WATER.AND.OBJ.NE.OIL)GOTO 9017\r
2947 FLDA OBJ\r
2948 FSUB WATER\r
2949 JEQ .+10\r
2950 FLDA OBJ\r
2951 FSUB OIL\r
2952 JNE #9017\r
2953/ IF(HERE(BOTTLE).AND.LIQ(0).EQ.OBJ)GOTO 9018\r
2954 FLDA BOTTLE\r
2955 JSA HERE\r
2956 JEQ .+10\r
2957 JSA LIQ\r
2958 FSUB OBJ\r
2959 JEQ #9018\r
2960/ OBJ=BOTTLE\r
2961 FLDA BOTTLE\r
2962 FSTA OBJ\r
2963/ IF(TOTING(BOTTLE).AND.PROP(BOTTLE).EQ.1)GOTO 9220\r
2964 FLDA BOTTLE\r
2965 JSA TOTING\r
81e70d48
PH		 2966 JEQ #M222\r
2967 FLDA BOTTLE\r
2968 ATX 7\r
2969 FLDA PROP-3,7\r
84b5715c
PH		 2970 FSUB ONE\r
2971 JEQ #9220\r
2972\r
2973/ IF(PROP(BOTTLE).NE.1)SPK=105\r
81e70d48
PH		 2974#M222, FLDA BOTTLE\r
2975 ATX 7\r
2976 FLDA PROP-3,7\r
84b5715c
PH		 2977 FSUB ONE\r
2978 JEQ .+4\r
2979 FLDA #LIT+157\r
2980 FSTA SPK\r
2981/ IF(.NOT.TOTING(BOTTLE))SPK=104\r
2982 FLDA BOTTLE\r
2983 JSA TOTING\r
2984 JNE #2011\r
81e70d48 2985 LDX 150,0 / 104\r
84b5715c
PH		 2986 XTA 0\r
2987 FSTA SPK\r
2988/ GOTO 2011\r
2989 JA #2011\r
2990\r
2991/9018 OBJ=BOTTLE\r
2992#9018, FLDA BOTTLE\r
2993 FSTA OBJ\r
2994\r
2995/9017 IF(HOLDNG.LT.7)GOTO 9016\r
2996#9017, LDX 7,0\r
2997 XTA 0\r
2998 FSUB HOLDNG\r
2999 JGE #9016\r
3000/ CALL RSPEAK(92)\r
3001 JSR RSPEAK\r
3002 JA #2012\r
3003 JA #LIT+143\r
3004/ GOTO 2012\r
3005\r
3006/9016 IF(OBJ.NE.BIRD)GOTO 9014\r
3007#9016, FLDA OBJ\r
3008 FSUB BIRD\r
3009 JNE #9014\r
3010/ IF(PROP(BIRD).NE.0)GOTO 9014\r
3011 FLDA BIRD\r
81e70d48
PH		 3012 ATX 7\r
3013 FLDA PROP-3,7\r
84b5715c
PH		 3014 JNE #9014\r
3015/ IF(.NOT.TOTING(ROD))GOTO 9013\r
3016 FLDA ROD\r
3017 JSA TOTING\r
3018 JEQ #9013\r
3019/ CALL RSPEAK(26)\r
3020 JSR RSPEAK\r
3021 JA #2012\r
3022 JA #LIT+55\r
3023/ GOTO 2012\r
3024\r
3025/9013 IF(TOTING(CAGE))GOTO 9015\r
3026#9013, FLDA CAGE\r
3027 JSA TOTING\r
3028 JNE #9015\r
3029/ CALL RSPEAK(27)\r
3030 JSR RSPEAK\r
3031 JA #2012\r
3032 JA #LIT+60\r
3033/ GOTO 2012\r
3034\r
3035/9015 PROP(BIRD)=1\r
3036#9015, FLDA BIRD\r
3037 ATX 7\r
3038 FLDA ONE\r
3039 FSTA PROP-3,7\r
3040\r
3041/9014 IF((OBJ.EQ.BIRD.OR.OBJ.EQ.CAGE).AND.PROP(BIRD).NE.0)\r
3042/ 1 CALL CARRY(BIRD+CAGE-OBJ,LOC)\r
3043#9014, FLDA OBJ\r
3044 FSUB BIRD\r
3045 JEQ .+10\r
3046 FLDA OBJ\r
3047 FSUB CAGE\r
81e70d48 3048 JNE .+30\r
84b5715c 3049 FLDA BIRD\r
81e70d48
PH		 3050 ATX 7\r
3051 FLDA PROP-3,7\r
84b5715c
PH		 3052 JEQ .+21\r
3053 FLDA BIRD\r
3054 FADD CAGE\r
3055 FSUB OBJ\r
3056 FSTA #TMP\r
3057 JSR CARRY\r
3058 JA .+6\r
3059 JA #TMP\r
3060 JA LOC\r
3061/ CALL CARRY(OBJ,LOC)\r
3062 JSR CARRY\r
3063 JA .+6\r
3064 JA OBJ\r
3065 JA LOC\r
3066/ K=LIQ(0)\r
3067 JSA LIQ\r
3068 FSTA K\r
3069/ IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=-1\r
3070 FLDA OBJ\r
3071 FSUB BOTTLE\r
3072 JNE #2009A\r
3073 FLDA K\r
3074 JEQ #2009A\r
3075 ATX 7\r
3076 FLDA MINUS1\r
3077 FSTA PLACE-3,7\r
3078/ GOTO 2009\r
81e70d48
PH		 3079#2009A, FLDA #LIT+135 /RHM - "Taken" message\r
3080 FSTA K\r
84b5715c
PH		 3081 JA #2010\r
3082\r
3083/C\r
3084/C DISCARD OBJECT. "THROW" ALSO COMES HERE FOR MOST OBJECTS. SPECIAL CASES FOR\r
3085/C BIRD (MIGHT ATTACK SNAKE OR DRAGON) AND CAGE (MIGHT CONTAIN BIRD) AND VASE.\r
3086/C DROP COINS AT VENDING MACHINE FOR EXTRA BATTERIES.\r
3087/C\r
3088/9020 IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2\r
3089#9020, FLDA ROD2\r
3090 JSA TOTING\r
3091 JEQ .+22\r
3092 FLDA OBJ\r
3093 FSUB ROD\r
3094 JNE .+14\r
3095 FLDA ROD\r
3096 JSA TOTING\r
3097 JNE .+6\r
3098 FLDA ROD2\r
3099 FSTA OBJ\r
3100/ IF(.NOT.TOTING(OBJ))GOTO 2011\r
3101 FLDA OBJ\r
3102 JSA TOTING\r
3103 JEQ #2011\r
3104/ IF(OBJ.NE.BIRD.OR..NOT.HERE(SNAKE))GOTO 9024\r
3105 FLDA OBJ\r
3106 FSUB BIRD\r
3107 JNE #9024\r
3108 FLDA SNAKE\r
3109 JSA HERE\r
3110 JEQ #9024\r
3111/ CALL RSPEAK(30)\r
3112 JSR RSPEAK\r
3113 JA .+4\r
3114 JA #LIT+63\r
3115/ IF(CLOSED)GOTO 19000\r
3116 FLDA CLOSED\r
3117 JNE #19000\r
3118/ CALL DSTROY(SNAKE)\r
81e70d48
PH		 3119 JSR DSTROY\r
3120 JA .+4\r
3121 JA SNAKE\r
84b5715c
PH		 3122/C\r
3123/C SET PROP FOR USE BY TRAVEL OPTIONS\r
3124/C\r
3125/ PROP(SNAKE)=1\r
3126 FLDA SNAKE\r
3127 ATX 7\r
3128 FLDA ONE\r
3129 FSTA PROP-3,7\r
3130\r
3131/9021 K=LIQ(0)\r
3132#9021, JSA LIQ\r
3133 FSTA K\r
3134/ IF(K.EQ.OBJ)OBJ=BOTTLE\r
3135 FSUB OBJ\r
3136 JNE .+6\r
3137 FLDA BOTTLE\r
3138 FSTA OBJ\r
3139/ IF(OBJ.EQ.BOTTLE.AND.K.NE.0)PLACE(K)=0\r
3140 FLDA OBJ\r
3141 FSUB BOTTLE\r
3142 JNE .+12\r
3143 FLDA K\r
3144 JEQ .+6\r
3145 ATX 7\r
3146 FCLA\r
3147 FSTA PLACE-3,7\r
3148/ IF(OBJ.EQ.CAGE.AND.PROP(BIRD).NE.0)CALL DROP(BIRD,LOC)\r
3149 FLDA OBJ\r
3150 FSUB CAGE\r
81e70d48 3151 JNE .+21\r
84b5715c 3152 FLDA BIRD\r
81e70d48
PH		 3153 ATX 7\r
3154 FLDA PROP-3,7\r
84b5715c
PH		 3155 JEQ .+12\r
3156 JSR DROP\r
3157 JA .+6\r
3158 JA BIRD\r
3159 JA LOC\r
3160/ IF(OBJ.EQ.BIRD)PROP(BIRD)=0\r
3161 FLDA OBJ\r
3162 FSUB BIRD\r
3163 JNE .+10\r
3164 FLDA BIRD\r
3165 ATX 7\r
3166 FCLA\r
3167 FSTA PROP-3,7\r
3168/ CALL DROP(OBJ,LOC)\r
3169 JSR DROP\r
3170/ GO TO 2012\r
3171 JA #2012\r
3172/\r
3173 JA OBJ\r
3174 JA LOC\r
3175\r
3176/C\r
3177/9024 IF(OBJ.NE.COINS.OR..NOT.HERE(VEND))GOTO 9025\r
3178#9024, FLDA OBJ\r
3179 FSUB COINS\r
3180 JNE #9025\r
3181 FLDA VEND\r
3182 JSA HERE\r
3183 JEQ #9025\r
3184/ CALL DSTROY(COINS)\r
81e70d48
PH		 3185 JSR DSTROY\r
3186 JA .+4\r
3187 JA COINS\r
84b5715c
PH		 3188/ CALL DROP(BATTER,LOC)\r
3189 JSR DROP\r
3190 JA .+6\r
3191 JA BATTER\r
3192 JA LOC\r
3193/ CALL PSPEAK(BATTER,0)\r
3194 JSR PSPEAK\r
3195 JA .+6\r
3196 JA BATTER\r
3197 JA ZERO\r
3198/ GOTO 2012\r
3199 JA #2012\r
3200\r
3201\f/C\r
3202/9025 IF(OBJ.NE.BIRD.OR..NOT.AT(DRAGON).OR.PROP(DRAGON).NE.0)GOTO 9026\r
3203#9025, FLDA OBJ\r
3204 FSUB BIRD\r
3205 JNE #9026\r
3206 FLDA DRAGON\r
3207 JSA AT\r
3208 JEQ #9026\r
81e70d48
PH		 3209 FLDA DRAGON\r
3210 ATX 7\r
3211 FLDA PROP-3,7\r
84b5715c
PH		 3212 JNE #9026\r
3213/ CALL RSPEAK(154)\r
3214 JSR RSPEAK\r
3215 JA .+4\r
81e70d48 3216 JA #LIT+374\r
84b5715c 3217/ CALL DSTROY(BIRD)\r
81e70d48
PH		 3218 JSR DSTROY\r
3219 JA .+4\r
3220 JA BIRD\r
84b5715c
PH		 3221/ PROP(BIRD)=0\r
3222 FLDA BIRD\r
3223 ATX 7\r
3224 FCLA\r
3225 FSTA PROP-3,7\r
3226/ IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1\r
3227 FLDA SNAKE\r
3228 ATX 7\r
3229 FLDA PLACE-3,7\r
3230 FSUB PLAC-3,7\r
3231 JNE #2012\r
3232 FLDA TALLY2\r
3233 FADD ONE\r
3234 FSTA TALLY2\r
3235/ GOTO 2012\r
3236 JA #2012\r
3237\r
3238/C\r
3239/9026 IF(OBJ.NE.BEAR.OR..NOT.AT(TROLL))GOTO 9027\r
3240#9026, FLDA OBJ\r
3241 FSUB BEAR\r
3242 JNE #9027\r
3243 FLDA TROLL\r
3244 JSA AT\r
3245 JEQ #9027\r
3246/ CALL RSPEAK(163)\r
3247 JSR RSPEAK\r
3248 JA .+4\r
3249 JA #LIT+242\r
3250/ CALL MOVE(TROLL,0)\r
3251 JSR MOVE\r
3252 JA .+6\r
3253 JA TROLL\r
3254 JA ZERO\r
3255/ CALL MOVE(TROLL+100,0)\r
3256 FLDA TROLL\r
3257 FADD #LIT+154\r
3258 FSTA #TMP\r
3259 JSR MOVE\r
3260 JA .+6\r
3261 JA #TMP\r
3262 JA ZERO\r
3263/ CALL MOVE(TROLL2,PLAC(TROLL))\r
3264 FLDA TROLL\r
3265 ATX 7\r
81e70d48
PH		 3266 XTA 7\r
3267 FMUL THREE\r
3268 ALN 0\r
3269 STARTD\r
3270 FADD PPLAC\r
3271 FSTA .+11\r
3272 STARTF\r
84b5715c
PH		 3273 JSR MOVE\r
3274 JA .+6\r
3275 JA TROLL2\r
81e70d48 3276 JA .\r
84b5715c
PH		 3277/ CALL MOVE(TROLL2+100,FIXD(TROLL))\r
3278 FLDA TROLL2\r
3279 FADD #LIT+154\r
3280 FSTA #TMP\r
81e70d48
PH		 3281 FLDA TROLL\r
3282 ATX 7\r
3283 XTA 7\r
3284 FMUL THREE\r
3285 ALN 0\r
3286 STARTD\r
3287 FADD PFIXD\r
3288 FSTA .+11\r
3289 STARTF\r
84b5715c
PH		 3290 JSR MOVE\r
3291 JA .+6\r
3292 JA #TMP\r
81e70d48 3293 JA .\r
84b5715c 3294/ CALL JUGGLE(CHASM)\r
81e70d48
PH		 3295 JSR JUGGLE\r
3296 JA .+4\r
3297 JA CHASM\r
3298 FLDA TROLL\r
3299 ATX 7\r
84b5715c 3300/ PROP(TROLL)=2\r
84b5715c
PH		 3301 FLDA TWO\r
3302 FSTA PROP-3,7\r
3303/ GOTO 9021\r
3304 JA #9021\r
3305\r
3306/C\r
3307/9027 IF(OBJ.EQ.VASE.AND.LOC.NE.PLAC(PILLOW))GOTO 9028\r
3308#9027, FLDA OBJ\r
3309 FSUB VASE\r
3310 JNE .+13\r
3311 FLDA PILLOW\r
3312 ATX 7\r
3313 FLDA LOC\r
3314 FSUB PLAC-3,7\r
3315 JNE #9028\r
3316/ CALL RSPEAK(54)\r
3317 JSR RSPEAK\r
3318 JA #9021\r
3319 JA #LIT+113\r
3320/ GOTO 9021\r
3321\r
3322/C\r
3323/9028 PROP(VASE)=2\r
3324#9028, FLDA VASE\r
3325 ATX 7\r
3326 FLDA TWO\r
3327 FSTA PROP-3,7\r
3328/ IF(AT(PILLOW))PROP(VASE)=0\r
3329 FLDA PILLOW\r
3330 JSA AT\r
3331 JEQ .+10\r
3332 FLDA VASE\r
3333 ATX 7\r
3334 FCLA\r
3335 FSTA PROP-3,7\r
3336/ CALL PSPEAK(VASE,PROP(VASE)+1)\r
3337 FLDA VASE\r
81e70d48
PH		 3338 ATX 7\r
3339 FLDA PROP-3,7\r
84b5715c
PH		 3340 FADD ONE\r
3341 FSTA #TMP\r
3342 JSR PSPEAK\r
3343 JA .+6\r
3344 JA VASE\r
3345 JA #TMP\r
3346/ IF(PROP(VASE).NE.0)FIXED(VASE)=-1\r
3347 FLDA VASE\r
3348 ATX 7\r
3349 FLDA PROP-3,7\r
3350 JEQ #9021\r
3351 FLDA MINUS1\r
3352 FSTA FIXED-3,7\r
3353/ GOTO 9021\r
3354 JA #9021\r
3355\r
3356/C\r
3357/C SAY. ECHO WD2 (OR WD1 IF NO WD2 (SAY WHAT?, ETC.).) MAGIC WORDS OVERRIDE.\r
3358/C\r
3359/9030 IF(WD2.EQ.0)GOTO 9031\r
3360#9030, FLDA WD2\r
3361 JEQ #9031\r
3362/ WD1=WD2 WD1A=WD2A\r
3363 FLDA WD2\r
3364 FSTA WD1\r
3365/ WD1X=WD2X\r
3366 FLDA WD2X\r
3367 FSTA WD1X\r
3368\r
3369/9031 CALL VOCAB(WD1,WD1A,-1,I)\r
3370#9031, JSR VOCAB\r
3371 JA .+6\r
3372 JA WD1\r
3373 JA MINUS1\r
3374 FSTA I\r
3375/ IF(I.EQ.62.OR.I.EQ.65.OR.I.EQ.71.OR.I.EQ.2025)GOTO 9035\r
3376 FSUB #LIT+124\r
3377 JEQ #9035\r
3378 FSUB THREE\r
3379 JEQ #9035\r
3380 FSUB #LIT+3\r
3381 JEQ #9035\r
81e70d48 3382 LDX 3751,0 /2025\r
84b5715c
PH		 3383 XTA 0\r
3384 FSUB I\r
3385 JEQ #9035\r
3386/ TYPE 9032\r
81e70d48
PH		 3387 JSR SIXOUT\r
3388 JA .+10\r
84b5715c 3389 JA #9032\r
81e70d48 3390 JA ZERO\r
84b5715c
PH		 3391 JA TWO\r
3392/9032 FORMAT(' Okay, "',$)\r
3393/ CALL A5TOA1(WD1,WD1A,WD1X,'".')\r
3394 JSR A5TOA1\r
3395 JA #2012\r
3396 JA WD1\r
3397 JA WD1X\r
3398 JA TQDOT\r
3399/ GOTO 2012\r
3400\r
3401/C\r
3402/9035 WD2=0\r
3403#9035, FCLA\r
3404 FSTA WD2\r
3405/ OBJ=0\r
3406 FSTA OBJ\r
3407/ GOTO 2630\r
3408 JA #2630\r
3409\r
3410/C\r
3411/C LOCK, UNLOCK, NO OBJECT GIVEN. ASSUME VARIOUS THINGS IF PRESENT.\r
3412/C\r
3413/8040 SPK=28\r
81e70d48 3414#8040, LDX 34,0 /28\r
84b5715c
PH		 3415 XTA 0\r
3416 FSTA SPK\r
3417/ IF(HERE(CLAM))OBJ=CLAM\r
3418 FLDA CLAM\r
3419 JSA HERE\r
3420 JEQ .+6\r
3421 FLDA CLAM\r
3422 FSTA OBJ\r
3423/ IF(HERE(OYSTER))OBJ=OYSTER\r
3424 FLDA OYSTER\r
3425 JSA HERE\r
3426 JEQ .+6\r
3427 FLDA OYSTER\r
3428 FSTA OBJ\r
3429/ IF(AT(DOOR))OBJ=DOOR\r
3430 FLDA DOOR\r
3431 JSA AT\r
3432 JEQ .+6\r
3433 FLDA DOOR\r
3434 FSTA OBJ\r
3435/ IF(AT(GRATE))OBJ=GRATE\r
3436 FLDA GRATE\r
3437 JSA AT\r
3438 JEQ .+6\r
3439 FLDA GRATE\r
3440 FSTA OBJ\r
3441/ IF(OBJ.NE.0.AND.HERE(CHAIN))GOTO 8000\r
3442 FLDA OBJ\r
3443 JEQ .+10\r
3444 FLDA CHAIN\r
3445 JSA HERE\r
3446 JNE #8000\r
3447/ IF(HERE(CHAIN))OBJ=CHAIN\r
3448 FLDA CHAIN\r
3449 JSA HERE\r
3450 JEQ .+6\r
3451 FLDA CHAIN\r
3452 FSTA OBJ\r
3453/ IF(OBJ.EQ.0)GOTO 2011\r
3454 FLDA OBJ\r
3455 JEQ #2011\r
3456\r
3457/C\r
3458/C LOCK, UNLOCK OBJECT. SPECIAL STUFF FOR OPENING CLAM/OYSTER AND FOR CHAIN.\r
3459/C\r
3460/9040 IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)GOTO 9046\r
3461#9040, FLDA OBJ\r
3462 FSUB CLAM\r
3463 JEQ #9046\r
3464 FLDA OBJ\r
3465 FSUB OYSTER\r
3466 JEQ #9046\r
3467/ IF(OBJ.EQ.DOOR)SPK=111\r
3468 FLDA OBJ\r
3469 FSUB DOOR\r
3470 JNE #9040A\r
81e70d48 3471 LDX 157,0 /111\r
84b5715c
PH		 3472 XTA 0\r
3473 FSTA SPK\r
3474/ IF(OBJ.EQ.DOOR.AND.PROP(DOOR).EQ.1)SPK=54\r
3475#9040A, FLDA OBJ\r
3476 FSUB DOOR\r
81e70d48 3477 JNE .+16\r
84b5715c 3478 FLDA DOOR\r
81e70d48
PH		 3479 ATX 7\r
3480 FLDA PROP-3,7\r
84b5715c 3481 FSUB ONE\r
81e70d48
PH		 3482 JEQ .+6\r
3483 LDX 74,0 /60\r
3484 XTA 0\r
84b5715c
PH		 3485 FSTA SPK\r
3486/ IF(OBJ.EQ.CAGE)SPK=32\r
3487 FLDA OBJ\r
3488 FSUB CAGE\r
3489 JNE .+6\r
81e70d48 3490 LDX 40,0 /32\r
84b5715c
PH		 3491 XTA 0\r
3492 FSTA SPK\r
3493/ IF(OBJ.EQ.KEYS)SPK=55\r
3494 FLDA OBJ\r
3495 FSUB KEYS\r
3496 JNE .+6\r
81e70d48 3497 LDX 67,0 /55\r
84b5715c
PH		 3498 XTA 0\r
3499 FSTA SPK\r
3500/ IF(OBJ.EQ.GRATE.OR.OBJ.EQ.CHAIN)SPK=31\r
3501 FLDA OBJ\r
3502 FSUB GRATE\r
3503 JEQ .+10\r
3504 FLDA OBJ\r
3505 FSUB CHAIN\r
3506 JNE .+6\r
81e70d48 3507 LDX 37,0 /31\r
84b5715c
PH		 3508 XTA 0\r
3509 FSTA SPK\r
3510/ IF(SPK.NE.31.OR..NOT.HERE(KEYS))GOTO 2011\r
81e70d48 3511 LDX 37,0 /31\r
84b5715c
PH		 3512 XTA 0\r
3513 FSUB SPK\r
3514 JNE #2011\r
3515 FLDA KEYS\r
3516 JSA HERE\r
3517 JEQ #2011\r
3518/ IF(OBJ.EQ.CHAIN)GOTO 9048\r
3519 FLDA OBJ\r
3520 FSUB CHAIN\r
3521 JEQ #9048\r
3522/ IF(.NOT.CLOSNG)GOTO 9043\r
3523 FLDA CLOSNG\r
3524 JEQ #9043\r
3525/ K=130\r
3526 FLDA #LIT+207\r
3527 FSTA K\r
3528/ IF(.NOT.PANIC)CLOCK2=15\r
3529 FLDA PANIC\r
3530 JNE .+5\r
3531 FLDA #LIT+25\r
3532 FSTA CLOCK2\r
3533/ PANIC=.TRUE.\r
3534 FLDA ONE\r
3535 FSTA PANIC\r
3536/ GOTO 2010\r
3537 JA #2010\r
3538\r
3539/C\r
3540/9043 K=34+PROP(GRATE)\r
3541#9043, FLDA GRATE\r
3542 ATX 7\r
81e70d48 3543 LDX 42,0 /34\r
84b5715c
PH		 3544 XTA 0\r
3545 FADD PROP-3,7\r
3546 FSTA K\r
3547/ IF(VERB.EQ.LOCK)PROP(GRATE)=0\r
81e70d48
PH		 3548 FLDA GRATE\r
3549 ATX 7\r
84b5715c
PH		 3550 FLDA ONE\r
3551 FSTA PROP-3,7\r
3552 FLDA VERB\r
3553 FSUB LOCK\r
81e70d48
PH		 3554 JNE .+10\r
3555 FLDA GRATE\r
3556 ATX 7\r
3557 FCLA\r
84b5715c
PH		 3558 FSTA PROP-3,7\r
3559/ K=K+2*PROP(GRATE)\r
81e70d48
PH		 3560 FLDA GRATE\r
3561 ATX 7\r
84b5715c
PH		 3562 FLDA TWO\r
3563 FMUL PROP-3,7\r
3564 FADD K\r
3565 FSTA K\r
3566/ GOTO 2010\r
3567 JA #2010\r
3568\r
3569/C\r
3570/C CLAM/OYSTER.\r
3571/C\r
3572/9046 K=0\r
3573#9046, FCLA\r
3574 FSTA K\r
3575/ IF(OBJ.EQ.OYSTER)K=1\r
3576 FLDA OBJ\r
3577 FSUB OYSTER\r
3578 JNE .+5\r
3579 FLDA ONE\r
3580 FSTA K\r
3581/ SPK=124+K\r
81e70d48 3582 LDX 174,0\r
84b5715c
PH		 3583 XTA 0\r
3584 FADD K\r
3585 FSTA SPK\r
3586/ IF(TOTING(OBJ))SPK=120+K\r
3587 FLDA OBJ\r
3588 JSA TOTING\r
3589 JEQ #9046A\r
81e70d48 3590 LDX 170,0 /120\r
84b5715c
PH		 3591 XTA 0\r
3592 FADD K\r
3593 FSTA SPK\r
3594/ IF(.NOT.TOTING(TRIDNT))SPK=122+K\r
3595#9046A, FLDA TRIDNT\r
3596 JSA TOTING\r
3597 JNE .+10\r
81e70d48 3598 LDX 172,0 /122\r
84b5715c
PH		 3599 XTA 0\r
3600 FADD K\r
3601 FSTA SPK\r
3602/ IF(VERB.EQ.LOCK)SPK=61\r
3603 FLDA VERB\r
3604 FSUB LOCK\r
3605 JNE .+6\r
81e70d48 3606 LDX 75,0 /61\r
84b5715c
PH		 3607 XTA 0\r
3608 FSTA SPK\r
3609/ IF(SPK.NE.124)GOTO 2011\r
81e70d48 3610 LDX 174,0 /124\r
84b5715c
PH		 3611 XTA 0\r
3612 FSUB SPK\r
3613 JNE #2011\r
3614/ CALL DSTROY(CLAM)\r
81e70d48
PH		 3615 JSR DSTROY\r
3616 JA .+4\r
3617 JA CLAM\r
84b5715c
PH		 3618/ CALL DROP(OYSTER,LOC)\r
3619 JSR DROP\r
3620 JA .+6\r
3621 JA OYSTER\r
3622 JA LOC\r
3623/ CALL DROP(PEARL,105)\r
3624 JSR DROP\r
3625 JA #2011\r
3626 JA PEARL\r
3627 JA #LIT+157\r
3628/ GOTO 2011\r
3629\r
3630/C\r
3631/C CHAIN.\r
3632/C\r
3633/9048 IF(VERB.EQ.LOCK)GOTO 9049\r
3634#9048, FLDA VERB\r
3635 FSUB LOCK\r
3636 JEQ #9049\r
3637/ SPK=171\r
81e70d48 3638 LDX 253,0 /171\r
84b5715c
PH		 3639 XTA 0\r
3640 FSTA SPK\r
3641/ IF(PROP(BEAR).EQ.0)SPK=41\r
3642 FLDA BEAR\r
81e70d48
PH		 3643 ATX 7\r
3644 FLDA PROP-3,7\r
84b5715c 3645 JNE .+6\r
81e70d48 3646 LDX 51,0 /41\r
84b5715c
PH		 3647 XTA 0\r
3648 FSTA SPK\r
3649/ IF(PROP(CHAIN).EQ.0)SPK=37\r
3650 FLDA CHAIN\r
81e70d48
PH		 3651 ATX 7\r
3652 FLDA PROP-3,7\r
84b5715c
PH		 3653 JNE .+4\r
3654 FLDA #LIT+71\r
3655 FSTA SPK\r
3656/ IF(SPK.NE.171)GOTO 2011\r
81e70d48 3657 LDX 253,0 /171\r
84b5715c
PH		 3658 XTA 0\r
3659 FSUB SPK\r
3660 JNE #2011\r
3661/ PROP(CHAIN)=0\r
3662 FCLA\r
3663 FSTA PROP-3,7\r
3664/ FIXED(CHAIN)=0\r
3665 FSTA FIXED-3,7\r
3666/ IF(PROP(BEAR).NE.3)PROP(BEAR)=2\r
3667 FLDA BEAR\r
81e70d48
PH		 3668 ATX 7\r
3669 FLDA PROP-3,7\r
84b5715c
PH		 3670 FSUB THREE\r
3671 JEQ .+5\r
3672 FLDA TWO\r
3673 FSTA PROP-3,7\r
3674/ FIXED(BEAR)=2-PROP(BEAR)\r
3675 FLDA TWO\r
3676 FSUB PROP-3,7\r
3677 FSTA FIXED-3,7\r
3678/ GOTO 2011\r
3679 JA #2011\r
3680\r
3681/C\r
3682/9049 SPK=172\r
81e70d48 3683#9049, LDX 254,0 /172\r
84b5715c
PH		 3684 XTA 0\r
3685 FSTA SPK\r
3686/ IF(PROP(CHAIN).NE.0)SPK=34\r
3687 FLDA CHAIN\r
81e70d48
PH		 3688 ATX 7\r
3689 FLDA PROP-3,7\r
84b5715c 3690 JEQ .+6\r
81e70d48 3691 LDX 42,0 /34\r
84b5715c
PH		 3692 XTA 0\r
3693 FSTA SPK\r
3694/ IF(LOC.NE.PLAC(CHAIN))SPK=173\r
3695 FLDA LOC\r
3696 FSUB PLAC-3,7\r
3697 JEQ .+6\r
81e70d48 3698 LDX 255,0 /173\r
84b5715c
PH		 3699 XTA 0\r
3700 FSTA SPK\r
3701/ IF(SPK.NE.172)GOTO 2011\r
81e70d48 3702 LDX 254,0 /172\r
84b5715c
PH		 3703 XTA 0\r
3704 FSUB SPK\r
3705 JNE #2011\r
3706/ PROP(CHAIN)=2\r
3707 FLDA TWO\r
3708 FSTA PROP-3,7\r
3709/ IF(TOTING(CHAIN))CALL DROP(CHAIN,LOC)\r
3710 FLDA CHAIN\r
3711 JSA TOTING\r
3712 JEQ .+12\r
3713 JSR DROP\r
3714 JA .+6\r
3715 JA CHAIN\r
3716 JA LOC\r
3717/ FIXED(CHAIN)=-1\r
3718 FLDA MINUS1\r
3719 FSTA FIXED-3,7\r
3720/ GOTO 2011\r
3721 JA #2011\r
3722\r
3723/C\r
3724/C LIGHT LAMP\r
3725/C\r
3726/9070 IF(.NOT.HERE(LAMP))GOTO 2011\r
3727#9070, FLDA LAMP\r
3728 JSA HERE\r
3729 JEQ #2011\r
3730/ SPK=184\r
3731 FLDA #LIT+253\r
3732 FSTA SPK\r
3733/ IF(LIMIT.LT.0)GOTO 2011\r
3734 FLDA LIMIT\r
3735 JLT #2011\r
3736/ PROP(LAMP)=1\r
3737 FLDA LAMP\r
3738 ATX 7\r
3739 FLDA ONE\r
3740 FSTA PROP-3,7\r
3741/ CALL RSPEAK(39)\r
3742 JSR RSPEAK\r
3743 JA .+4\r
3744 JA #LIT+74\r
3745/ IF(WZDARK)GOTO 2000\r
3746 FLDA WZDARK\r
3747 JNE #2000\r
3748/ GOTO 2012\r
3749 JA #2012\r
3750\r
3751/C\r
3752/C LAMP OFF\r
3753/C\r
3754/9080 IF(.NOT.HERE(LAMP))GOTO 2011\r
3755#9080, FLDA LAMP\r
84b5715c
PH		 3756 JSA HERE\r
3757 JEQ #2011\r
3758/ PROP(LAMP)=0\r
81e70d48
PH		 3759 FLDA LAMP\r
3760 ATX 7\r
84b5715c
PH		 3761 FCLA\r
3762 FSTA PROP-3,7\r
3763/ CALL RSPEAK(40)\r
3764 JSR RSPEAK\r
3765 JA .+4\r
3766 JA #LIT+77\r
3767/ IF(DARK(0))CALL RSPEAK(16)\r
3768 JSA DARK\r
3769 JEQ #2012\r
3770 JSR RSPEAK\r
3771 JA #2012\r
3772 JA #LIT+30\r
3773/ GOTO 2012\r
3774\r
3775/C\r
3776/C WAVE. NO EFFECT UNLESS WAVING ROD AT FISSURE.\r
3777/C\r
3778/9090 IF((.NOT.TOTING(OBJ)).AND.(OBJ.NE.ROD.OR..NOT.TOTING(ROD2)))\r
3779/ 1 SPK=29\r
3780#9090, FLDA OBJ\r
3781 JSA TOTING\r
3782 JNE .+20\r
3783 FLDA OBJ\r
3784 FSUB ROD\r
3785 JNE .+12\r
3786 FLDA ROD2\r
3787 JSA TOTING\r
3788 JNE .+4\r
81e70d48 3789 FLDA #LIT+402\r
84b5715c
PH		 3790 FSTA SPK\r
3791/ IF(OBJ.NE.ROD.OR..NOT.AT(FISSUR).OR..NOT.TOTING(OBJ)\r
3792/ 1 .OR.CLOSNG)GOTO 2011\r
3793 FLDA OBJ\r
3794 FSUB ROD\r
3795 JNE #2011\r
3796 FLDA FISSUR\r
3797 JSA AT\r
3798 JEQ #2011\r
3799 FLDA OBJ\r
3800 JSA TOTING\r
3801 JEQ #2011\r
3802 FLDA CLOSNG\r
3803 JNE #2011\r
3804/ PROP(FISSUR)=1-PROP(FISSUR)\r
3805 FLDA FISSUR\r
3806 ATX 7\r
3807 FLDA ONE\r
3808 FSUB PROP-3,7\r
3809 FSTA PROP-3,7\r
3810/ CALL PSPEAK(FISSUR,2-PROP(FISSUR))\r
3811 FLDA FISSUR\r
3812 ATX 7\r
3813 FLDA TWO\r
3814 FSUB PROP-3,7\r
3815 FSTA #TMP\r
3816 JSR PSPEAK\r
3817 JA #2012\r
3818 JA FISSUR\r
3819 JA #TMP\r
3820/ GOTO 2012\r
3821\r
3822/C\r
3823/C ATTACK. ASSUME TARGET IF UNAMBIGUOUS. "THROW" ALSO LINKS HERE. ATTACKABLE\r
3824/C OBJECTS FALL INTO TWO CATEGORIES: ENEMIES (SNAKE, DWARF, ETC.) AND OTHERS\r
3825/C (BIRD, CLAM). AMBIGUOUS IF TWO ENEMIES, OR IF NO ENEMIES BUT TWO OTHERS.\r
3826/C\r
3827/9120 DO 9121 I=1,5\r
3828#9120, FLDA ONE\r
3829 FSTA I\r
3830\r
3831#H0102, FLDA I\r
3832 ATX 7\r
3833/ IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2)GOTO 9122\r
3834 FLDA DLOC-3,7\r
3835 FSUB LOC\r
3836 JNE #9121\r
3837 FLDA DFLAG\r
3838 FSUB TWO\r
3839 JGE #9122\r
3840\r
3841/9121 CONTINUE\r
3842#9121, FLDA I\r
3843 FADD ONE\r
3844 FSTA I\r
3845 FSUB #LIT+3\r
3846 JLE #H0102\r
3847/ I=0\r
3848 FCLA\r
3849 FSTA I\r
3850\r
3851/9122 IF(OBJ.NE.0)GOTO 9124\r
3852#9122, FLDA OBJ\r
3853 JNE #9124\r
3854/ IF(I.NE.0)OBJ=DWARF\r
3855 FLDA I\r
3856 JEQ .+6\r
3857 FLDA DWARF\r
3858 FSTA OBJ\r
3859/ IF(HERE(SNAKE))OBJ=OBJ*100+SNAKE\r
3860 FLDA SNAKE\r
3861 JSA HERE\r
3862 JEQ .+11\r
3863 FLDA OBJ\r
3864 FMUL #LIT+154\r
3865 FADD SNAKE\r
3866 FSTA OBJ\r
3867/ IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)OBJ=OBJ*100+DRAGON\r
3868 FLDA DRAGON\r
3869 JSA AT\r
81e70d48
PH		 3870 JEQ .+20\r
3871 FLDA DRAGON\r
3872 ATX 7\r
3873 FLDA PROP-3,7\r
84b5715c
PH		 3874 JNE .+11\r
3875 FLDA OBJ\r
3876 FMUL #LIT+154\r
3877 FADD DRAGON\r
3878 FSTA OBJ\r
3879/ IF(AT(TROLL))OBJ=OBJ*100+TROLL\r
3880 FLDA TROLL\r
3881 JSA AT\r
3882 JEQ .+11\r
3883 FLDA OBJ\r
3884 FMUL #LIT+154\r
3885 FADD TROLL\r
3886 FSTA OBJ\r
3887/ IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)OBJ=OBJ*100+BEAR\r
3888 FLDA BEAR\r
3889 JSA HERE\r
81e70d48
PH		 3890 JEQ .+20\r
3891 FLDA BEAR\r
3892 ATX 7\r
3893 FLDA PROP-3,7\r
84b5715c
PH		 3894 JNE .+11\r
3895 FLDA OBJ\r
3896 FMUL #LIT+154\r
3897 FADD BEAR\r
3898 FSTA OBJ\r
3899/ IF(OBJ.GT.100)GOTO 8000\r
3900 FLDA OBJ\r
3901 FSUB #LIT+154\r
3902 JGT #8000\r
3903/ IF(OBJ.NE.0)GOTO 9124\r
3904 FLDA OBJ\r
3905 JNE #9124\r
3906/C\r
3907/C CAN'T ATTACK BIRD BY THROWING AXE.\r
3908/C\r
3909/ IF(HERE(BIRD).AND.VERB.NE.THROW)OBJ=BIRD\r
3910 FLDA BEAR\r
3911 JSA HERE\r
3912 JEQ .+14\r
3913 FLDA VERB\r
3914 FSUB THROW\r
3915 JNE .+6\r
3916 FLDA BIRD\r
3917 FSTA OBJ\r
3918/C\r
3919/C CLAM AND OYSTER BOTH TREATED AS CLAM FOR INTRANSITIVE CASE; NO HARM DONE.\r
3920/C\r
3921/ IF(HERE(CLAM).OR.HERE(OYSTER))OBJ=100*OBJ+CLAM\r
3922 FLDA CLAM\r
3923 JSA HERE\r
3924 JNE .+10\r
3925 FLDA OYSTER\r
3926 JSA HERE\r
3927 JEQ .+11\r
3928 FLDA #LIT+154\r
3929 FMUL OBJ\r
3930 FADD CLAM\r
3931 FSTA OBJ\r
3932/ IF(OBJ.GT.100)GOTO 8000\r
3933 FLDA OBJ\r
3934 FSUB #LIT+154\r
3935 JGT #8000\r
3936\r
3937/9124 IF(OBJ.NE.BIRD)GOTO 9125\r
3938#9124, FLDA OBJ\r
3939 FSUB BIRD\r
3940 JNE #9125\r
3941/ SPK=137\r
81e70d48 3942 LDX 211,0 /137\r
84b5715c
PH		 3943 XTA 0\r
3944 FSTA SPK\r
3945/ IF(CLOSED)GOTO 2011\r
3946 FLDA CLOSED\r
3947 JNE #2011\r
3948/ CALL DSTROY(BIRD)\r
81e70d48
PH		 3949 JSR DSTROY\r
3950 JA .+4\r
3951 JA BIRD\r
84b5715c
PH		 3952/ PROP(BIRD)=0\r
3953 FLDA BIRD\r
3954 ATX 7\r
3955 FCLA\r
3956 FSTA PROP-3,7\r
3957/ IF(PLACE(SNAKE).EQ.PLAC(SNAKE))TALLY2=TALLY2+1\r
3958 FLDA SNAKE\r
3959 ATX 7\r
3960 FLDA PLACE-3,7\r
3961 FSUB PLAC-3,7\r
3962 JNE .+7\r
3963 FLDA TALLY2\r
3964 FADD ONE\r
3965 FSTA TALLY2\r
3966/ SPK=45\r
3967 FLDA #LIT+102\r
3968 FSTA SPK\r
3969\r
3970/9125 IF(OBJ.EQ.0)SPK=44\r
3971#9125, FLDA OBJ\r
3972 JNE .+6\r
81e70d48 3973 LDX 54,0 /44\r
84b5715c
PH		 3974 XTA 0\r
3975 FSTA SPK\r
3976/ IF(OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER)SPK=150\r
3977 FLDA OBJ\r
3978 FSUB CLAM\r
3979 JEQ .+10\r
3980 FLDA OBJ\r
3981 FSUB OYSTER\r
3982 JNE .+6\r
81e70d48 3983 LDX 226,0 /150\r
84b5715c
PH		 3984 XTA 0\r
3985 FSTA SPK\r
3986/ IF(OBJ.EQ.SNAKE)SPK=46\r
3987 FLDA OBJ\r
3988 FSUB SNAKE\r
3989 JNE .+6\r
81e70d48 3990 LDX 56,0 /46\r
84b5715c
PH		 3991 XTA 0\r
3992 FSTA SPK\r
3993/ IF(OBJ.EQ.DWARF)SPK=49\r
3994 FLDA OBJ\r
3995 FSUB DWARF\r
3996 JNE .+4\r
3997 FLDA #LIT+105\r
3998 FSTA SPK\r
3999/ IF(OBJ.EQ.DWARF.AND.CLOSED)GOTO 19000\r
4000 FLDA OBJ\r
4001 FSUB DWARF\r
4002 JNE .+6\r
4003 FLDA CLOSED\r
4004 JNE #19000\r
4005/ IF(OBJ.EQ.DRAGON)SPK=167\r
4006 FLDA OBJ\r
4007 FSUB DRAGON\r
4008 JNE .+6\r
81e70d48 4009 LDX 247,0 /167\r
84b5715c
PH		 4010 XTA 0\r
4011 FSTA SPK\r
4012/ IF(OBJ.EQ.TROLL)SPK=157\r
4013 FLDA OBJ\r
4014 FSUB TROLL\r
4015 JNE .+6\r
81e70d48 4016 LDX 235,0 /157\r
84b5715c
PH		 4017 XTA 0\r
4018 FSTA SPK\r
4019/ IF(OBJ.EQ.BEAR)SPK=165+(PROP(BEAR)+1)/2\r
4020 FLDA OBJ\r
4021 FSUB BEAR\r
81e70d48 4022 JNE .+15\r
84b5715c 4023 FLDA BEAR\r
81e70d48
PH		 4024 ATX 7\r
4025 FLDA PROP-3,7\r
84b5715c
PH		 4026 FADD ONE\r
4027 FDIV TWO\r
4028 JSA #FIX\r
4029 FADD #LIT+245\r
4030 FSTA SPK\r
4031/ IF(OBJ.NE.DRAGON.OR.PROP(DRAGON).NE.0)GOTO 2011\r
4032 FLDA OBJ\r
4033 FSUB DRAGON\r
4034 JNE #2011\r
4035 FLDA DRAGON\r
81e70d48
PH		 4036 ATX 7\r
4037 FLDA PROP-3,7\r
84b5715c
PH		 4038 JNE #2011\r
4039/C\r
4040/C FUN STUFF FOR DRAGON. IF HE INSISTS ON ATTACKING IT, WIN! SET PROP TO DEAD,\r
4041/C MOVE DRAGON TO CENTRAL LOC (STILL FIXED), MOVE RUG THERE (NOT FIXED), AND\r
4042/C MOVE HIM THERE, TOO. THEN DO A NULL MOTION TO GET NEW DESCRIPTION.\r
4043/C\r
4044/ CALL RSPEAK(49)\r
4045 JSR RSPEAK\r
4046 JA .+4\r
4047 JA #LIT+105\r
4048/ VERB=0\r
4049 FCLA\r
4050 FSTA VERB\r
4051/ OBJ=0\r
4052 FSTA OBJ\r
4053/ CALL GETIN(WD1,WD1A,WD1X,WD2,WD2A,WD2X)\r
4054 JSR GETIN\r
4055 JA .+12\r
4056 JA WD1\r
4057 JA WD1X\r
4058 JA WD2\r
4059 JA WD2X\r
4060/ IF(WD1.NE.'YE'.AND.WD1.NE.'Y')GOTO 2608\r
4061 FLDA WD1\r
4062 FSUB TYES\r
4063 JEQ OKKILL\r
4064 FLDA WD1\r
4065 FSUB TYE\r
4066 JEQ OKKILL\r
4067 FLDA WD1\r
4068 FSUB TY\r
4069 JNE #2608\r
4070/ CALL PSPEAK(DRAGON,1)\r
4071OKKILL, JSR PSPEAK\r
4072 JA .+6\r
4073 JA DRAGON\r
4074 JA ONE\r
4075/ PROP(DRAGON)=2\r
4076 FLDA DRAGON\r
4077 ATX 7\r
4078 FLDA TWO\r
4079 FSTA PROP-3,7\r
4080/ PROP(RUG)=0\r
4081 FLDA RUG\r
4082 ATX 7\r
4083 FCLA\r
4084 FSTA PROP-3,7\r
4085/ K=(PLAC(DRAGON)+FIXD(DRAGON))/2\r
4086 FLDA DRAGON\r
4087 ATX 7\r
4088 FLDA PLAC-3,7\r
4089 FADD FIXD-3,7\r
4090 FDIV TWO\r
4091 JSA #FIX\r
4092 FSTA K\r
4093/ CALL MOVE(DRAGON+100,-1)\r
4094 FLDA DRAGON\r
4095 FADD #LIT+154\r
4096 FSTA #TMP\r
4097 JSR MOVE\r
4098 JA .+6\r
4099 JA #TMP\r
4100 JA MINUS1\r
4101/ CALL MOVE(RUG+100,0)\r
4102 FLDA RUG\r
4103 FADD #LIT+154\r
4104 FSTA #TMP\r
4105 JSR MOVE\r
4106 JA .+6\r
4107 JA #TMP\r
4108 JA ZERO\r
4109/ CALL MOVE(DRAGON,K)\r
4110 JSR MOVE\r
4111 JA .+6\r
4112 JA DRAGON\r
4113 JA K\r
4114/ CALL MOVE(RUG,K)\r
4115 JSR MOVE\r
4116 JA .+6\r
4117 JA RUG\r
4118 JA K\r
4119/ DO 9126 OBJ=1,100\r
4120 FLDA ONE\r
4121 FSTA OBJ\r
4122\r
4123/ IF(PLACE(OBJ).EQ.PLAC(DRAGON).OR.PLACE(OBJ).EQ.FIXD(DRAGON))\r
4124/ 1 CALL MOVE(OBJ,K)\r
4125#H0122, FLDA OBJ\r
4126 ATX 7\r
4127 FLDA DRAGON\r
4128 ATX 6\r
4129 FLDA PLACE-3,7\r
4130 FSUB PLAC-3,6\r
4131 JEQ .+10\r
4132 FLDA PLACE-3,7\r
4133 FSUB FIXD-3,6\r
4134 JNE #9126\r
4135 JSR MOVE\r
4136 JA .+6\r
4137 JA OBJ\r
4138 JA K\r
4139/9126 CONTINUE\r
4140#9126, FLDA OBJ\r
4141 FADD ONE\r
4142 FSTA OBJ\r
4143 FSUB #LIT+154\r
4144 JLE #H0122\r
4145/ LOC=K\r
4146 FLDA K\r
4147 FSTA LOC\r
4148/ K=NULL\r
4149 FLDA NULL\r
4150 FSTA K\r
4151/ GOTO 8\r
4152 JA #8\r
4153\r
4154/C\r
4155/C POUR. IF NO OBJECT, OR OBJECT IS BOTTLE, ASSUME CONTENTS OF BOTTLE.\r
4156/C SPECIAL TESTS FOR POURING WATER OR OIL ON PLANT OR RUSTY DOOR.\r
4157/C\r
4158/9130 IF(OBJ.EQ.BOTTLE.OR.OBJ.EQ.0)OBJ=LIQ(0)\r
4159#9130, FLDA OBJ\r
4160 FSUB BOTTLE\r
4161 JEQ .+6\r
4162 FLDA OBJ\r
4163 JNE .+6\r
4164 JSA LIQ\r
4165 FSTA OBJ\r
4166/ IF(OBJ.EQ.0)GOTO 8000\r
4167 FLDA OBJ\r
4168 JEQ #8000\r
4169/ IF(.NOT.TOTING(OBJ))GOTO 2011\r
4170 FLDA OBJ\r
4171 JSA TOTING\r
4172 JEQ #2011\r
4173/ SPK=78\r
81e70d48 4174 LDX 116,0 /78\r
84b5715c
PH		 4175 XTA 0\r
4176 FSTA SPK\r
4177/ IF(OBJ.NE.OIL.AND.OBJ.NE.WATER)GOTO 2011\r
4178 FLDA OBJ\r
4179 FSUB OIL\r
4180 JEQ .+10\r
4181 FLDA OBJ\r
4182 FSUB WATER\r
4183 JNE #2011\r
4184/ PROP(BOTTLE)=1\r
4185 FLDA BOTTLE\r
4186 ATX 7\r
4187 FLDA ONE\r
4188 FSTA PROP-3,7\r
4189/ PLACE(OBJ)=0\r
4190 FLDA OBJ\r
4191 ATX 7\r
4192 FCLA\r
4193 FSTA PLACE-3,7\r
4194/ SPK=77\r
81e70d48 4195 LDX 115,0 /77\r
84b5715c
PH		 4196 XTA 0\r
4197 FSTA SPK\r
4198/ IF(.NOT.(AT(PLANT).OR.AT(DOOR)))GOTO 2011\r
4199 FLDA PLANT\r
4200 JSA AT\r
4201 JNE .+10\r
4202 FLDA DOOR\r
4203 JSA AT\r
4204 JEQ #2011\r
4205/C\r
4206/ IF(AT(DOOR))GOTO 9132\r
4207 FLDA DOOR\r
4208 JSA AT\r
4209 JNE #9132\r
4210/ SPK=112\r
81e70d48 4211 LDX 160,0 /112\r
84b5715c
PH		 4212 XTA 0\r
4213 FSTA SPK\r
4214/ IF(OBJ.NE.WATER)GOTO 2011\r
4215 FLDA OBJ\r
4216 FSUB WATER\r
4217 JNE #2011\r
4218/ CALL PSPEAK(PLANT,PROP(PLANT)+1)\r
4219 FLDA PLANT\r
81e70d48
PH		 4220 ATX 7\r
4221 FLDA PROP-3,7\r
84b5715c
PH		 4222 FADD ONE\r
4223 FSTA #TMP\r
4224 JSR PSPEAK\r
4225 JA .+6\r
4226 JA PLANT\r
4227 JA #TMP\r
4228/ PROP(PLANT)=MOD(PROP(PLANT)+2,6)\r
4229 FLDA PLANT\r
81e70d48
PH		 4230 ATX 7\r
4231 FLDA PROP-3,7\r
84b5715c
PH		 4232 FADD TWO\r
4233 FSTA #TMP\r
4234 JSR MOD\r
4235 JA .+6\r
4236 JA #TMP\r
4237 JA #LIT+6\r
4238 FSTA PROP-3,7\r
4239/ PROP(PLANT2)=PROP(PLANT)/2\r
4240 FLDA PLANT2\r
4241 ATX 7\r
4242 FLDA PLANT\r
81e70d48
PH		 4243 ATX 6\r
4244 FLDA PROP-3,6\r
84b5715c
PH		 4245 FDIV TWO\r
4246 JSA #FIX\r
81e70d48 4247 FSTA PROP-3,7\r
84b5715c
PH		 4248/ K=NULL\r
4249 FLDA NULL\r
4250 FSTA K\r
4251/ GOTO 8\r
4252 JA #8\r
4253\r
4254/C\r
4255/9132 PROP(DOOR)=0\r
4256#9132, FLDA DOOR\r
4257 ATX 7\r
4258 FCLA\r
4259 FSTA PROP-3,7\r
4260/ IF(OBJ.EQ.OIL)PROP(DOOR)=1\r
4261 FLDA OBJ\r
4262 FSUB OIL\r
4263 JNE .+10\r
4264 FLDA DOOR\r
4265 ATX 7\r
4266 FLDA ONE\r
4267 FSTA PROP-3,7\r
4268/ SPK=113+PROP(DOOR)\r
4269 FLDA DOOR\r
4270 ATX 7\r
81e70d48 4271 LDX 161,0 /113\r
84b5715c
PH		 4272 XTA 0\r
4273 FADD PROP-3,7\r
4274 FSTA SPK\r
4275/ GOTO 2011\r
4276 JA #2011\r
4277\r
4278/C\r
4279/C EAT. INTRANSITIVE: ASSUME FOOD IF PRESENT, ELSE ASK WHAT. TRANSITIVE: FOOD\r
4280/C OK, SOME THINGS LOSE APPETITE, REST ARE RIDICULOUS.\r
4281/C\r
4282/8140 IF(.NOT.HERE(FOOD))GOTO 8000\r
4283#8140, FLDA FOOD\r
4284 JSA HERE\r
4285 JEQ #8000\r
4286\r
4287/8142 CALL DSTROY(FOOD)\r
81e70d48
PH		 4288#8142, JSR DSTROY\r
4289 JA .+4\r
4290 JA FOOD\r
84b5715c 4291/ SPK=72\r
81e70d48 4292 LDX 110,0 /72\r
84b5715c
PH		 4293 XTA 0\r
4294 FSTA SPK\r
4295/ GOTO 2011\r
4296 JA #2011\r
4297/C\r
4298/9140 IF(OBJ.EQ.FOOD)GOTO 8142\r
4299#9140, FLDA OBJ\r
4300 FSUB FOOD\r
4301 JEQ #8142\r
4302/ IF(OBJ.EQ.BIRD.OR.OBJ.EQ.SNAKE.OR.OBJ.EQ.CLAM.OR.OBJ.EQ.OYSTER\r
4303/ 1 .OR.OBJ.EQ.DWARF.OR.OBJ.EQ.DRAGON.OR.OBJ.EQ.TROLL\r
4304/ 2 .OR.OBJ.EQ.BEAR)SPK=71\r
4305 FLDA OBJ\r
4306 FSUB BIRD\r
4307 JEQ #M78\r
4308 FLDA OBJ\r
4309 FSUB SNAKE\r
4310 JEQ #M78\r
4311 FLDA OBJ\r
4312 FSUB CLAM\r
4313 JEQ #M78\r
4314 FLDA OBJ\r
4315 FSUB OYSTER\r
4316 JEQ #M78\r
4317 FLDA OBJ\r
4318 FSUB DWARF\r
4319 JEQ #M78\r
4320 FLDA OBJ\r
4321 FSUB DRAGON\r
4322 JEQ #M78\r
4323 FLDA OBJ\r
4324 FSUB TROLL\r
4325 JEQ #M78\r
4326 FLDA OBJ\r
4327 FSUB BEAR\r
4328 JNE #2011\r
81e70d48 4329#M78, LDX 107,0 /71\r
84b5715c
PH		 4330 XTA 0\r
4331 FSTA SPK\r
4332/ GOTO 2011\r
4333 JA #2011\r
4334\r
4335/C\r
4336/C DRINK. IF NO OBJECT, ASSUME WATER AND LOOK FOR IT HERE. IF WATER IS IN\r
4337/C THE BOTTLE, DRINK THAT, ELSE MUST BE AT A WATER LOC, SO DRINK STREAM.\r
4338/C\r
4339/9150 IF(OBJ.EQ.0.AND.LIQLOC(LOC).NE.WATER.AND.(LIQ(0).NE.WATER\r
4340/ 1 .OR..NOT.HERE(BOTTLE)))GOTO 8000\r
4341#9150, FLDA OBJ\r
4342 JNE #M79\r
4343 JSA LIQLOC\r
4344 FSUB WATER\r
4345 JEQ #M79\r
4346 JSA LIQ\r
4347 FSUB WATER\r
4348 JNE #8000\r
4349 FLDA BOTTLE\r
4350 JSA HERE\r
4351 JEQ #8000\r
4352/ IF(OBJ.NE.0.AND.OBJ.NE.WATER)SPK=110\r
4353#M79, FLDA OBJ\r
81e70d48
PH		 4354 JEQ .+12\r
4355 FLDA OBJ\r
84b5715c
PH		 4356 FSUB WATER\r
4357 JEQ .+4\r
4358 FLDA #LIT+162\r
4359 FSTA SPK\r
4360/ IF(SPK.EQ.110.OR.LIQ(0).NE.WATER.OR..NOT.HERE(BOTTLE))GOTO 2011\r
4361 FLDA SPK\r
4362 FSUB #LIT+162\r
4363 JEQ #2011\r
4364 JSA LIQ\r
4365 FSUB WATER\r
4366 JNE #2011\r
4367 FLDA BOTTLE\r
4368 JSA HERE\r
4369 JEQ #2011\r
4370/ PROP(BOTTLE)=1\r
81e70d48
PH		 4371 FLDA BOTTLE\r
4372 ATX 7\r
84b5715c 4373 FLDA ONE\r
81e70d48 4374 FSTA PROP-3,7\r
84b5715c
PH		 4375/ PLACE(WATER)=0\r
4376 FLDA WATER\r
4377 ATX 7\r
4378 FCLA\r
4379 FSTA PLACE-3,7\r
4380/ SPK=74\r
81e70d48 4381 LDX 112,0 /74\r
84b5715c
PH		 4382 XTA 0\r
4383 FSTA SPK\r
4384/ GOTO 2011\r
4385 JA #2011\r
4386\r
4387/C\r
4388/C RUB. YIELDS VARIOUS SNIDE REMARKS.\r
4389/C\r
4390/9160 IF(OBJ.NE.LAMP)SPK=76\r
4391#9160, FLDA OBJ\r
4392 FSUB LAMP\r
4393 JEQ #2011\r
81e70d48 4394 LDX 114,0 /76\r
84b5715c
PH		 4395 XTA 0\r
4396 FSTA SPK\r
4397/ GOTO 2011\r
4398 JA #2011\r
4399\r
4400/C\r
4401/C THROW. SAME AS DISCARD UNLESS AXE. THEN SAME AS ATTACK EXCEPT IGNORE BIRD,\r
4402/C AND IF DWARF IS PRESENT THEN ONE MIGHT BE KILLED. (ONLY WAY TO DO SO!)\r
4403/C AXE ALSO SPECIAL FOR DRAGON, BEAR, AND TROLL. TREASURES SPECIAL FOR TROLL.\r
4404/C\r
4405/9170 IF(TOTING(ROD2).AND.OBJ.EQ.ROD.AND..NOT.TOTING(ROD))OBJ=ROD2\r
4406#9170, FLDA ROD2\r
4407 JSA TOTING\r
4408 JEQ #M81\r
4409 FLDA OBJ\r
4410 FSUB ROD\r
4411 JNE #M81\r
4412 FLDA ROD\r
4413 JSA TOTING\r
4414 JNE #M81\r
4415 FLDA ROD2\r
4416 FSTA OBJ\r
4417/ IF(.NOT.TOTING(OBJ))GOTO 2011\r
4418#M81, FLDA OBJ\r
4419 JSA TOTING\r
4420 JEQ #2011\r
4421/ IF(OBJ.GE.50.AND.OBJ.LE.MAXTRS.AND.AT(TROLL))GOTO 9178\r
4422 FLDA OBJ\r
4423 FSUB #LIT+110\r
4424 JLT #M82\r
4425 FLDA OBJ\r
4426 FSUB MAXTRS\r
4427 JGT #M82\r
4428 FLDA TROLL\r
4429 JSA AT\r
4430 JNE #9178\r
4431/ IF(OBJ.EQ.FOOD.AND.HERE(BEAR))GOTO 9177\r
4432#M82, FLDA OBJ\r
4433 FSUB FOOD\r
4434 JNE #M83\r
4435 FLDA BEAR\r
4436 JSA HERE\r
4437 JNE #9177\r
4438/ IF(OBJ.NE.AXE)GOTO 9020\r
4439#M83, FLDA OBJ\r
4440 FSUB AXE\r
4441 JNE #9020\r
4442/ DO 9171 I=1,5\r
4443 FLDA ONE\r
4444 FSTA I\r
4445\r
4446/C\r
4447/C NEEDN'T CHECK DFLAG IF AXE IS HERE.\r
4448/C\r
4449/ IF(DLOC(I).EQ.LOC)GOTO 9172\r
4450#H0132, FLDA I\r
4451 ATX 7\r
4452 FLDA DLOC-3,7\r
4453 FSUB LOC\r
4454 JEQ #9172\r
4455\r
4456/9171 CONTINUE\r
4457#9171, FLDA I\r
4458 FADD ONE\r
4459 FSTA I\r
4460 FSUB #LIT+3\r
4461 JLE #H0132\r
4462/ SPK=152\r
81e70d48 4463 LDX 230,0 /152\r
84b5715c
PH		 4464 XTA 0\r
4465 FSTA SPK\r
4466/ IF(AT(DRAGON).AND.PROP(DRAGON).EQ.0)GOTO 9175\r
4467 FLDA DRAGON\r
4468 JSA AT\r
4469 JEQ #M84\r
81e70d48
PH		 4470 FLDA DRAGON\r
4471 ATX 7\r
4472 FLDA PROP-3,7\r
84b5715c
PH		 4473 JEQ #9175\r
4474/ SPK=158\r
81e70d48 4475#M84, LDX 236,0 /158\r
84b5715c
PH		 4476 XTA 0\r
4477 FSTA SPK\r
4478/ IF(AT(TROLL))GOTO 9175\r
4479 FLDA TROLL\r
4480 JSA AT\r
4481 JNE #9175\r
4482/ IF(HERE(BEAR).AND.PROP(BEAR).EQ.0)GOTO 9176\r
4483 FLDA BEAR\r
4484 JSA HERE\r
4485 JEQ #M85\r
81e70d48
PH		 4486 FLDA BEAR\r
4487 ATX 7\r
4488 FLDA PROP-3,7\r
84b5715c
PH		 4489 JEQ #9176\r
4490/ OBJ=0\r
4491#M85, FCLA\r
4492 FSTA OBJ\r
4493/ GOTO 9120\r
4494 JA #9120\r
4495\r
4496/C\r
4497/9172 SPK=48\r
81e70d48 4498#9172, LDX 60,0 /48\r
84b5715c
PH		 4499 XTA 0\r
4500 FSTA SPK\r
4501/ IF(RND(3).EQ.0)GOTO 9175\r
4502 JSR RND\r
4503 JA .+4\r
4504 JA THREE\r
4505 JEQ #9175\r
4506/ DSEEN(I)=.FALSE.\r
4507 FLDA I\r
4508 ATX 7\r
4509 FCLA\r
4510 FSTA DSEEN-3,7\r
4511/ DLOC(I)=0\r
4512 FSTA DLOC-3,7\r
4513/ SPK=47\r
81e70d48 4514 LDX 57,0 /47\r
84b5715c
PH		 4515 XTA 0\r
4516 FSTA SPK\r
4517/ DKILL=DKILL+1\r
4518 FLDA ONE\r
4519 FADDM DKILL\r
4520/ IF(DKILL.EQ.1)SPK=149\r
4521 FSUB ONE\r
4522 JNE #9175\r
81e70d48 4523 LDX 225,0 /149\r
84b5715c
PH		 4524 XTA 0\r
4525 FSTA SPK\r
4526/9175 CALL RSPEAK(SPK)\r
4527#9175, JSR RSPEAK\r
4528 JA .+4\r
4529 JA SPK\r
4530/ CALL DROP(AXE,LOC)\r
4531 JSR DROP\r
4532 JA .+6\r
4533 JA AXE\r
4534 JA LOC\r
4535/ K=NULL\r
4536 FLDA NULL\r
4537 FSTA K\r
4538/ GOTO 8\r
4539 JA #8\r
4540\r
4541/C\r
4542/C THIS'LL TEACH HIM TO THROW THE AXE AT THE BEAR!\r
4543/C\r
4544/9176 SPK=164\r
81e70d48 4545#9176, LDX 244,0 /164\r
84b5715c
PH		 4546 XTA 0\r
4547 FSTA SPK\r
4548/ CALL DROP(AXE,LOC)\r
4549 JSR DROP\r
4550 JA .+6\r
4551 JA AXE\r
4552 JA LOC\r
4553/ FIXED(AXE)=-1\r
4554 FLDA AXE\r
4555 ATX 7\r
4556 FLDA MINUS1\r
4557 FSTA FIXED-3,7\r
4558/ PROP(AXE)=1\r
4559 FLDA ONE\r
4560 FSTA PROP-3,7\r
4561/ CALL JUGGLE(BEAR)\r
81e70d48 4562 JSR JUGGLE\r
84b5715c
PH		 4563/ GOTO 2011\r
4564 JA #2011\r
81e70d48 4565 JA BEAR\r
84b5715c
PH		 4566\r
4567/C\r
4568/C BUT THROWING FOOD IS ANOTHER STORY.\r
4569/C\r
4570/9177 OBJ=BEAR\r
4571#9177, FLDA BEAR\r
4572 FSTA OBJ\r
4573/ GOTO 9210\r
4574 JA #9210\r
4575\r
4576/C\r
4577/C SNARF A TREASURE FOR THE TROLL.\r
4578/C\r
4579/9178 SPK=159\r
81e70d48 4580#9178, LDX 237,0 /159\r
84b5715c
PH		 4581 XTA 0\r
4582 FSTA SPK\r
4583/ CALL DROP(OBJ,0)\r
4584 JSR DROP\r
4585 JA .+6\r
4586 JA OBJ\r
4587 JA ZERO\r
4588/ CALL MOVE(TROLL,0)\r
4589 JSR MOVE\r
4590 JA .+6\r
4591 JA TROLL\r
4592 JA ZERO\r
4593/ CALL MOVE(TROLL+100,0)\r
4594 FLDA TROLL\r
4595 FADD #LIT+154\r
4596 FSTA #TMP\r
4597 JSR MOVE\r
4598 JA .+6\r
4599 JA #TMP\r
4600 JA ZERO\r
4601/ CALL DROP(TROLL2,PLAC(TROLL))\r
4602 FLDA TROLL\r
4603 ATX 7\r
81e70d48
PH		 4604 XTA 7\r
4605 FMUL THREE\r
4606 ALN 0\r
4607 STARTD\r
4608 FADD PPLAC\r
4609 FSTA .+11\r
4610 STARTF\r
84b5715c
PH		 4611 JSR DROP\r
4612 JA .+6\r
4613 JA TROLL2\r
81e70d48 4614 JA .\r
84b5715c
PH		 4615/ CALL DROP(TROLL2+100,FIXD(TROLL))\r
4616 FLDA TROLL2\r
4617 FADD #LIT+154\r
4618 FSTA #TMP\r
81e70d48
PH		 4619 FLDA TROLL\r
4620 ATX 7\r
4621 XTA 7\r
4622 FMUL THREE\r
4623 ALN 0\r
4624 STARTD\r
4625 FADD PFIXD\r
4626 FSTA .+11\r
4627 STARTF\r
84b5715c
PH		 4628 JSR DROP\r
4629 JA .+6\r
4630 JA #TMP\r
81e70d48 4631 JA .\r
84b5715c 4632/ CALL JUGGLE(CHASM)\r
81e70d48
PH		 4633 JSR JUGGLE\r
4634 JA .+4\r
4635 JA CHASM\r
84b5715c
PH		 4636/ GOTO 2011\r
4637 JA #2011\r
4638\r
4639/C\r
4640/C QUIT. INTRANSITIVE ONLY. VERIFY INTENT AND EXIT IF THAT'S WHAT HE WANTS.\r
4641/C\r
4642/8180 GAVEUP=YES(22,54,54)\r
4643#8180, JSR YES\r
4644 JA .+10\r
4645 JA #LIT+41\r
4646 JA #LIT+113\r
4647 JA #LIT+113\r
4648 FSTA GAVEUP\r
4649\r
4650/8185 IF(GAVEUP)GOTO 20000\r
4651#8185, FLDA GAVEUP\r
4652 JNE #20000\r
4653/ GOTO 2012\r
4654 JA #2012\r
4655/C\r
4656/C FIND. MIGHT BE CARRYING IT, OR IT MIGHT BE HERE. ELSE GIVE CAVEAT.\r
4657/C\r
4658/9190 IF(AT(OBJ).OR.(LIQ(0).EQ.OBJ.AND.AT(BOTTLE))\r
4659/ 1 .OR.K.EQ.LIQLOC(LOC))SPK=94\r
4660#9190, FLDA OBJ\r
4661 JSA AT\r
4662 JNE #M86\r
4663 JSA LIQ\r
4664 FSUB OBJ\r
4665 JNE #M87\r
4666 FLDA BOTTLE\r
4667 JSA AT\r
4668 JNE #M86\r
4669#M87, JSA LIQLOC\r
4670 FSUB K\r
4671 JNE .+6\r
81e70d48 4672#M86, LDX 136,0 /94\r
84b5715c
PH		 4673 XTA 0\r
4674 FSTA SPK\r
4675/ DO 9192 I=1,5\r
4676 FLDA ONE\r
4677 FSTA I\r
4678/9192 IF(DLOC(I).EQ.LOC.AND.DFLAG.GE.2.AND.OBJ.EQ.DWARF)SPK=94\r
4679#9192, FLDA I\r
4680 ATX 7\r
4681 FLDA DLOC-3,7\r
4682 FSUB LOC\r
4683 JNE #M88\r
4684 FLDA DFLAG\r
4685 FSUB TWO\r
4686 JLT #M88\r
4687 FLDA OBJ\r
4688 FSUB DWARF\r
4689 JNE #M88\r
81e70d48 4690 LDX 136,0 /94\r
84b5715c
PH		 4691 XTA 0\r
4692 FSTA SPK\r
4693#M88, FLDA I\r
4694 FADD ONE\r
4695 FSTA I\r
4696 FSUB #LIT+3\r
4697 JLE #9192\r
4698/ IF(CLOSED)SPK=138\r
4699 FLDA CLOSED\r
4700 JEQ .+6\r
81e70d48 4701 LDX 212,0 /138\r
84b5715c
PH		 4702 XTA 0\r
4703 FSTA SPK\r
4704/ IF(TOTING(OBJ))SPK=24\r
4705 FLDA OBJ\r
4706 JSA TOTING\r
4707 JEQ #2011\r
4708 FLDA #LIT+47\r
4709 FSTA SPK\r
4710/ GOTO 2011\r
4711 JA #2011\r
4712\r
4713/C\r
4714/C INVENTORY. IF OBJECT, TREAT SAME AS FIND. ELSE REPORT ON CURRENT BURDEN.\r
4715/C\r
4716/8200 SPK=98\r
81e70d48 4717#8200, LDX 142,0 /98\r
84b5715c
PH		 4718 XTA 0\r
4719 FSTA SPK\r
4720/ DO 8201 I=1,100\r
4721 FLDA ONE\r
4722 FSTA I\r
4723\r
4724/ IF(I.EQ.BEAR.OR..NOT.TOTING(I))GOTO 8201\r
4725#H0143, FLDA I\r
4726 FSUB BEAR\r
4727 JEQ #8201\r
4728 FLDA I\r
4729 JSA TOTING\r
4730 JEQ #8201\r
4731/ IF(SPK.EQ.98)CALL RSPEAK(99)\r
81e70d48 4732 LDX 142,0 /98\r
84b5715c
PH		 4733 XTA 0\r
4734 FSUB SPK\r
4735 JNE .+10\r
4736 JSR RSPEAK\r
4737 JA .+4\r
4738 JA #LIT+151\r
4739/ CALL PSPEAK(I,-1)\r
4740 JSR PSPEAK\r
4741 JA .+6\r
4742 JA I\r
4743 JA MINUS1\r
4744/ SPK=0\r
4745 FCLA\r
4746 FSTA SPK\r
4747\r
4748/8201 CONTINUE\r
4749#8201, FLDA I\r
4750 FADD ONE\r
4751 FSTA I\r
4752 FSUB #LIT+154\r
4753 JLE #H0143\r
4754/ IF(TOTING(BEAR))SPK=141\r
4755 FLDA BEAR\r
4756 JSA TOTING\r
4757 JEQ #2011\r
4758 FLDA #LIT+226\r
4759 FSTA SPK\r
4760/ GOTO 2011\r
4761 JA #2011\r
4762\r
4763/C\r
4764/C FEED. IF BIRD, NO SEED. SNAKE, DRAGON, TROLL: QUIP. IF DWARF, MAKE HIM\r
4765/C MAD. BEAR, SPECIAL.\r
4766/C\r
4767/9210 IF(OBJ.NE.BIRD)GOTO 9212\r
4768#9210, FLDA OBJ\r
4769 FSUB BIRD\r
4770 JNE #9212\r
4771/ SPK=100\r
4772 FLDA #LIT+154\r
4773 FSTA SPK\r
4774/ GOTO 2011\r
4775 JA #2011\r
4776\r
4777/C\r
4778/9212 IF(OBJ.NE.SNAKE.AND.OBJ.NE.DRAGON.AND.OBJ.NE.TROLL)GOTO 9213\r
4779#9212, FLDA OBJ\r
4780 FSUB SNAKE\r
4781 JEQ #M89\r
4782 FLDA OBJ\r
4783 FSUB DRAGON\r
4784 JEQ #M89\r
4785 FLDA OBJ\r
4786 FSUB TROLL\r
4787 JNE #9213\r
4788/ SPK=102\r
81e70d48 4789#M89, LDX 146,0 /102\r
84b5715c
PH		 4790 XTA 0\r
4791 FSTA SPK\r
4792/ IF(OBJ.EQ.DRAGON.AND.PROP(DRAGON).NE.0)SPK=110\r
4793 FLDA OBJ\r
4794 FSUB DRAGON\r
4795 JNE #M90\r
4796 FLDA DRAGON\r
81e70d48
PH		 4797 ATX 7\r
4798 FLDA PROP-3,7\r
84b5715c
PH		 4799 JEQ .+4\r
4800 FLDA #LIT+162\r
4801 FSTA SPK\r
4802/ IF(OBJ.EQ.TROLL)SPK=182\r
4803#M90, FLDA OBJ\r
4804 FSUB TROLL\r
4805 JNE .+6\r
81e70d48 4806 LDX 266,0 /182\r
84b5715c
PH		 4807 XTA 0\r
4808 FSTA SPK\r
4809/ IF(OBJ.NE.SNAKE.OR.CLOSED.OR..NOT.HERE(BIRD))GOTO 2011\r
4810 FLDA OBJ\r
4811 FSUB SNAKE\r
4812 JNE #2011\r
4813 FLDA CLOSED\r
4814 JNE #2011\r
4815 FLDA BIRD\r
4816 JSA HERE\r
4817 JEQ #2011\r
4818/ SPK=101\r
81e70d48 4819 LDX 145,0 /101\r
84b5715c
PH		 4820 XTA 0\r
4821 FSTA SPK\r
4822/ CALL DSTROY(BIRD)\r
81e70d48
PH		 4823 JSR DSTROY\r
4824 JA .+4\r
4825 JA BIRD\r
84b5715c
PH		 4826/ PROP(BIRD)=0\r
4827 FLDA BIRD\r
4828 ATX 7\r
4829 FCLA\r
4830 FSTA PROP-3,7\r
4831/ TALLY2=TALLY2+1\r
4832 FLDA TALLY2\r
4833 FADD ONE\r
4834 FSTA TALLY2\r
4835/ GOTO 2011\r
4836 JA #2011\r
4837\r
4838/C\r
4839/9213 IF(OBJ.NE.DWARF)GOTO 9214\r
4840#9213, FLDA OBJ\r
4841 FSUB DWARF\r
4842 JNE #9214\r
4843/ IF(.NOT.HERE(FOOD))GOTO 2011\r
4844 FLDA FOOD\r
4845 JSA HERE\r
4846 JEQ #2011\r
4847/ SPK=103\r
81e70d48 4848 LDX 147,0 / 103\r
84b5715c
PH		 4849 XTA 0\r
4850 FSTA SPK\r
4851/ DFLAG=DFLAG+1\r
4852 FLDA ONE\r
4853 FADDM DFLAG\r
4854/ GOTO 2011\r
4855 JA #2011\r
4856\r
4857/C\r
4858/9214 IF(OBJ.NE.BEAR)GOTO 9215\r
4859#9214, FLDA OBJ\r
4860 FSUB BEAR\r
4861 JNE #9215\r
4862/ IF(PROP(BEAR).EQ.0)SPK=102\r
4863 FLDA BEAR\r
81e70d48
PH		 4864 ATX 7\r
4865 FLDA PROP-3,7\r
84b5715c 4866 JNE .+6\r
81e70d48 4867 LDX 146,0 /102\r
84b5715c
PH		 4868 XTA 0\r
4869 FSTA SPK\r
4870/ IF(PROP(BEAR).EQ.3)SPK=110\r
4871 FLDA PROP-3,7\r
4872 FSUB THREE\r
4873 JNE .+4\r
4874 FLDA #LIT+162\r
4875 FSTA SPK\r
4876/ IF(.NOT.HERE(FOOD))GOTO 2011\r
4877 FLDA FOOD\r
4878 JSA HERE\r
4879 JEQ #2011\r
4880/ CALL DSTROY(FOOD)\r
81e70d48
PH		 4881 JSR DSTROY\r
4882 JA .+4\r
4883 JA FOOD\r
84b5715c
PH		 4884/ PROP(BEAR)=1\r
4885 FLDA ONE\r
4886 FSTA PROP-3,7\r
4887/ FIXED(AXE)=0\r
4888 FLDA AXE\r
4889 ATX 7\r
4890 FCLA\r
4891 FSTA FIXED-3,7\r
4892/ PROP(AXE)=0\r
4893 FSTA PROP-3,7\r
4894/ SPK=168\r
81e70d48 4895 LDX 250,0 /168\r
84b5715c
PH		 4896 XTA 0\r
4897 FSTA SPK\r
4898/ GOTO 2011\r
4899 JA #2011\r
4900\r
4901/C\r
4902/9215 SPK=14\r
81e70d48 4903#9215, LDX 16,0 /14\r
84b5715c
PH		 4904 XTA 0\r
4905 FSTA SPK\r
4906/ GOTO 2011\r
4907 JA #2011\r
4908\r
4909/C\r
4910/C FILL. BOTTLE MUST BE EMPTY, AND SOME LIQUID AVAILABLE. (VASE IS NASTY.)\r
4911/C\r
4912/9220 IF(OBJ.EQ.VASE)GOTO 9222\r
4913#9220, FLDA OBJ\r
4914 FSUB VASE\r
4915 JEQ #9222\r
4916/ IF(OBJ.NE.0.AND.OBJ.NE.BOTTLE)GOTO 2011\r
4917 FLDA OBJ\r
4918 JEQ #M91\r
4919 FLDA OBJ\r
4920 FSUB BOTTLE\r
4921 JNE #2011\r
4922/ IF(OBJ.EQ.0.AND..NOT.HERE(BOTTLE))GOTO 8000\r
4923#M91, FLDA OBJ\r
4924 JNE #M92\r
4925 FLDA BOTTLE\r
4926 JSA HERE\r
4927 JEQ #8000\r
4928/ SPK=107\r
81e70d48 4929#M92, LDX 153,0 /107\r
84b5715c
PH		 4930 XTA 0\r
4931 FSTA SPK\r
4932/ IF(LIQLOC(LOC).EQ.0)SPK=106\r
4933 JSA LIQLOC\r
4934 JNE #M92A\r
81e70d48 4935 LDX 152,0 /106\r
84b5715c
PH		 4936 XTA 0\r
4937 FSTA SPK\r
4938/ IF(LIQ(0).NE.0)SPK=105\r
4939#M92A, JSA LIQ\r
4940 JEQ .+4\r
4941 FLDA #LIT+157\r
4942 FSTA SPK\r
4943/ IF(SPK.NE.107)GOTO 2011\r
81e70d48 4944 LDX 153,0 /107\r
84b5715c
PH		 4945 XTA 0\r
4946 FSUB SPK\r
4947 JNE #2011\r
4948/ PROP(BOTTLE)=MOD(COND(LOC),4)/2*2\r
4949 FLDA BOTTLE\r
4950 ATX 7\r
4951 FLDA LOC\r
4952 ATX 6\r
81e70d48
PH		 4953 XTA 6\r
4954 FMUL THREE\r
4955 ALN 0\r
4956 STARTD\r
4957 FADD PCOND\r
4958 FSTA .+7\r
4959 STARTF\r
84b5715c
PH		 4960 JSR MOD\r
4961 JA .+6\r
81e70d48 4962 JA .\r
84b5715c
PH		 4963 JA #LIT\r
4964 FDIV TWO\r
4965 JSA #FIX\r
4966 FMUL TWO\r
4967 FSTA PROP-3,7\r
4968/ K=LIQ(0)\r
4969 JSA LIQ\r
4970 FSTA K\r
4971/ IF(TOTING(BOTTLE))PLACE(K)=-1\r
4972 FLDA BOTTLE\r
4973 JSA TOTING\r
81e70d48 4974 JEQ .+11\r
84b5715c
PH		 4975 FLDA K\r
4976 ATX 7\r
4977 FLDA MINUS1\r
4978 FSTA PLACE-3,7\r
4979/ IF(K.EQ.OIL)SPK=108\r
4980 FLDA K\r
4981 FSUB OIL\r
4982 JNE #2011\r
81e70d48 4983 LDX 154,0 /108\r
84b5715c
PH		 4984 XTA 0\r
4985 FSTA SPK\r
4986/ GOTO 2011\r
4987 JA #2011\r
4988\r
4989/C\r
4990/9222 SPK=29\r
81e70d48
PH		 4991#9222, LDX 35,0 /29\r
4992 XTA 0\r
84b5715c
PH		 4993 FSTA SPK\r
4994/ IF(LIQLOC(LOC).EQ.0)SPK=144\r
4995 JSA LIQLOC\r
4996 JNE .+6\r
81e70d48 4997 LDX 220,0 /144\r
84b5715c
PH		 4998 XTA 0\r
4999 FSTA SPK\r
5000/ IF(LIQLOC(LOC).EQ.0.OR..NOT.TOTING(VASE))GOTO 2011\r
5001 JSA LIQLOC\r
5002 JEQ #2011\r
5003 FLDA VASE\r
5004 JSA TOTING\r
5005 JEQ #2011\r
5006/ CALL RSPEAK(145)\r
5007 JSR RSPEAK\r
5008 JA .+4\r
5009 JA #LIT+234\r
5010/ PROP(VASE)=2\r
5011 FLDA VASE\r
5012 ATX 7\r
5013 FLDA TWO\r
5014 FSTA PROP-3,7\r
5015/ FIXED(VASE)=-1\r
5016 FLDA MINUS1\r
5017 FSTA FIXED-3,7\r
5018/ GOTO 9024\r
5019 JA #9024\r
5020\r
5021/C\r
5022/C BLAST. NO EFFECT UNLESS YOU'VE GOT DYNAMITE, WHICH IS A NEAT TRICK!\r
5023/C\r
5024/9230 IF(PROP(ROD2).LT.0.OR..NOT.CLOSED)GOTO 2011\r
5025#9230, FLDA ROD2\r
81e70d48
PH		 5026 ATX 7\r
5027 FLDA PROP-3,7\r
84b5715c
PH		 5028 JLT #2011\r
5029 FLDA CLOSED\r
5030 JEQ #2011\r
5031/ BONUS=133\r
81e70d48 5032 LDX 205,0 /133\r
84b5715c
PH		 5033 XTA 0\r
5034 FSTA BONUS\r
5035/ IF(LOC.EQ.115)BONUS=134\r
5036 FLDA LOC\r
5037 FSUB #LIT+165\r
5038 JNE .+7\r
81e70d48 5039 LDX 206,0 /134\r
84b5715c
PH		 5040 XTA 0\r
5041 FSTA BONUS\r
5042/ IF(HERE(ROD2))BONUS=135\r
5043 FLDA ROD2\r
5044 JSA HERE\r
5045 JEQ .+7\r
81e70d48 5046 LDX 207,0 /135\r
84b5715c
PH		 5047 XTA 0\r
5048 FSTA BONUS\r
5049/ CALL RSPEAK(BONUS)\r
5050 JSR RSPEAK\r
5051 JA .+4\r
5052 JA BONUS\r
5053/ GOTO 20000\r
5054 JA #20000\r
5055\r
5056/C\r
5057/C SCORE. GO TO SCORING SECTION, WHICH WILL RETURN TO 8241 IF SCORNG IS TRUE.\r
5058/C\r
5059/8240 SCORNG=.TRUE.\r
5060#8240, FLDA ONE\r
5061 FSTA SCORNG\r
5062/ GOTO 20000\r
5063 JA #20000\r
5064\r
5065/C\r
5066/8241 SCORNG=.FALSE.\r
5067#8241, FCLA\r
5068 FSTA SCORNG\r
5069/ TYPE 8243,SCORE,MXSCOR\r
81e70d48
PH		 5070 JSR SIXOUT\r
5071 JA .+10\r
84b5715c 5072 JA #8243\r
81e70d48 5073 JA ZERO\r
84b5715c
PH		 5074 JA TWO\r
5075 \r
5076 TRAP3 #WRITO\r
5077 JA #LIT\r
5078 JA #8243A\r
5079 FLDA SCORE\r
5080 TRAP3 #RSVO\r
5081 TRAP3 #RENDO\r
5082\r
81e70d48
PH		 5083 JSR SIXOUT\r
5084 JA .+10\r
84b5715c 5085 JA #8243B\r
81e70d48 5086 JA ZERO\r
84b5715c
PH		 5087 JA THREE\r
5088\r
5089 TRAP3 #WRITO\r
5090 JA #LIT\r
5091 JA #8243A\r
5092 FLDA MXSCOR\r
5093 TRAP3 #RSVO\r
5094 TRAP3 #RENDO\r
5095\r
81e70d48
PH		 5096 JSR SIXOUT\r
5097 JA .+10\r
84b5715c 5098 JA #8243C\r
81e70d48 5099 JA ZERO\r
84b5715c
PH		 5100 JA ONE\r
5101\r
5102/8243 FORMAT(' If you were to quit now, you would score',I4\r
5103/ 1 ,' out of a possible',I4,'.')\r
5104/ GAVEUP=YES(143,54,54)\r
5105 JSR YES\r
5106 JA .+10\r
5107 JA #LIT+231\r
5108 JA #LIT+113\r
5109 JA #LIT+113\r
5110 FSTA GAVEUP\r
5111/ GOTO 8185\r
5112 JA #8185\r
5113\r
5114/C\r
5115/C FEE FIE FOE FOO (AND FUM). ADVANCE TO NEXT STATE IF GIVEN IN PROPER ORDER.\r
5116/C LOOK UP WD1 IN SECTION 3 OF VOCAB TO DETERMINE WHICH WORD WE'VE GOT. LAST\r
5117/C WORD ZIPS THE EGGS BACK TO THE GIANT ROOM (UNLESS ALREADY THERE).\r
5118/C\r
5119/8250 CALL VOCAB(WD1,WD1A,3,K)\r
5120#8250, JSR VOCAB\r
5121 JA .+6\r
5122 JA WD1\r
5123 JA THREE\r
5124 FSTA K\r
5125/ SPK=42\r
81e70d48 5126 LDX 52,0 /42\r
84b5715c
PH		 5127 XTA 0\r
5128 FSTA SPK\r
5129/ IF(FOOBAR.EQ.1-K)GOTO 8252\r
5130 FLDA ONE\r
5131 FSUB K\r
5132 FSUB FOOBAR\r
5133 JEQ #8252\r
5134/ IF(FOOBAR.NE.0)SPK=151\r
5135 FLDA FOOBAR\r
5136 JEQ #2011\r
81e70d48 5137 LDX 227,0 /151\r
84b5715c
PH		 5138 XTA 0\r
5139 FSTA SPK\r
5140/ GOTO 2011\r
5141 JA #2011\r
5142\r
5143/C\r
5144/8252 FOOBAR=K\r
5145#8252, FLDA K\r
5146 FSTA FOOBAR\r
5147/ IF(K.NE.4)GOTO 2009\r
5148 FSUB #LIT\r
5149 JNE #2009\r
5150/ FOOBAR=0\r
5151 FCLA\r
5152 FSTA FOOBAR\r
5153/ IF(PLACE(EGGS).EQ.PLAC(EGGS)\r
5154/ 1 .OR.(TOTING(EGGS).AND.LOC.EQ.PLAC(EGGS)))GOTO 2011\r
5155 FLDA EGGS\r
5156 ATX 7\r
5157 FLDA PLACE-3,7\r
5158 FSUB PLAC-3,7\r
5159 JEQ #2011\r
5160 FLDA EGGS\r
5161 JSA TOTING\r
5162 JEQ #M93\r
5163 FLDA LOC\r
5164 FSUB PLAC-3,7\r
5165 JEQ #2011\r
5166/C\r
5167/C BRING BACK TROLL IF WE STEAL THE EGGS BACK FROM HIM BEFORE CROSSING.\r
5168/C\r
5169/ IF(PLACE(EGGS).EQ.0.AND.PLACE(TROLL).EQ.0.AND.PROP(TROLL).EQ.0)\r
5170/ 1 PROP(TROLL)=1\r
5171#M93, FLDA PLACE-3,7\r
5172 JNE #M94\r
5173 FLDA TROLL\r
5174 ATX 6\r
5175 FLDA PLACE-3,6\r
5176 JNE #M94\r
5177 FLDA PROP-3,6\r
5178 JNE #M94\r
5179 FLDA ONE\r
5180 FSTA PROP-3,6\r
5181/ K=2\r
5182#M94, FLDA TWO\r
5183 FSTA K\r
5184/ IF(HERE(EGGS))K=1\r
5185 FLDA EGGS\r
5186 JSA HERE\r
5187 JEQ .+5\r
5188 FLDA ONE\r
5189 FSTA K\r
5190/ IF(LOC.EQ.PLAC(EGGS))K=0\r
5191 FLDA LOC\r
5192 FSUB PLAC-3,7\r
5193 JNE .+5\r
5194 FCLA\r
5195 FSTA K\r
5196/ CALL MOVE(EGGS,PLAC(EGGS))\r
81e70d48
PH		 5197 XTA 7\r
5198 FMUL THREE\r
5199 ALN 0\r
5200 STARTD\r
5201 FADD PPLAC\r
5202 FSTA .+11\r
5203 STARTF\r
84b5715c
PH		 5204 JSR MOVE\r
5205 JA .+6\r
5206 JA EGGS\r
81e70d48 5207 JA .\r
84b5715c
PH		 5208/ CALL PSPEAK(EGGS,K)\r
5209 JSR PSPEAK\r
5210 JA .+6\r
5211 JA EGGS\r
5212 JA K\r
5213/ GOTO 2012\r
5214 JA #2012\r
5215\r
5216/C\r
5217/C BRIEF. INTRANSITIVE ONLY. SUPPRESS LONG DESCRIPTIONS AFTER FIRST TIME.\r
5218/C\r
5219/8260 SPK=156\r
81e70d48 5220#8260, LDX 234,0 /156\r
84b5715c
PH		 5221 XTA 0\r
5222 FSTA SPK\r
5223/ ABBNUM=10000\r
5224 FLDA #LIT+322\r
5225 FSTA ABBNUM\r
5226/ DETAIL=3\r
5227 FLDA THREE\r
5228 FSTA DETAIL\r
5229/ GOTO 2011\r
5230 JA #2011\r
5231\r
5232/C\r
5233/C READ. MAGAZINES IN DWARVISH, MESSAGE WE'VE SEEN, AND . . . OYSTER?\r
5234/C\r
5235/8270 IF(HERE(MAGZIN))OBJ=MAGZIN\r
5236#8270, FLDA MAGZIN\r
5237 JSA HERE\r
5238 JEQ .+6\r
5239 FLDA MAGZIN\r
5240 FSTA OBJ\r
5241/ IF(HERE(TABLET))OBJ=OBJ*100+TABLET\r
5242 FLDA TABLET\r
5243 JSA HERE\r
5244 JEQ .+11\r
5245 FLDA OBJ\r
5246 FMUL #LIT+154\r
5247 FADD TABLET\r
5248 FSTA OBJ\r
5249/ IF(HERE(MESSAG))OBJ=OBJ*100+MESSAG\r
5250 FLDA MESSAGE\r
5251 JSA HERE\r
5252 JEQ .+11\r
5253 FLDA OBJ\r
5254 FMUL #LIT+154\r
5255 FADD MESSAG\r
5256 FSTA OBJ\r
5257/ IF(CLOSED.AND.TOTING(OYSTER))OBJ=OYSTER\r
5258 FLDA OYSTER\r
5259 JSA TOTING\r
5260 FMUL CLOSED\r
5261 JEQ .+6\r
5262 FLDA OYSTER\r
5263 FSTA OBJ\r
5264/ IF(OBJ.GT.100.OR.OBJ.EQ.0.OR.DARK(0))GOTO 8000\r
5265 FLDA OBJ\r
5266 FSUB #LIT+154\r
5267 JGT #8000\r
5268 FLDA OBJ\r
5269 JEQ #8000\r
5270 JSA DARK\r
5271 JNE #8000\r
5272\r
5273/C\r
5274/9270 IF(DARK(0))GOTO 5190\r
5275#9270, JSA DARK\r
5276 JNE #5190\r
5277/ IF(OBJ.EQ.MAGZIN)SPK=190\r
5278 FLDA OBJ\r
5279 FSUB MAGZIN\r
5280 JNE .+6\r
81e70d48 5281 LDX 276,0 /190\r
84b5715c
PH		 5282 XTA 0\r
5283 FSTA SPK\r
5284/ IF(OBJ.EQ.TABLET)SPK=196\r
5285 FLDA OBJ\r
5286 FSUB TABLET\r
5287 JNE .+6\r
81e70d48 5288 LDX 304,0 /196\r
84b5715c
PH		 5289 XTA 0\r
5290 FSTA SPK\r
5291/ IF(OBJ.EQ.MESSAG)SPK=191\r
5292 FLDA OBJ\r
5293 FSUB MESSAG\r
5294 JNE .+6\r
81e70d48 5295 LDX 277,0 /191\r
84b5715c
PH		 5296 XTA 0\r
5297 FSTA SPK\r
5298/ IF(OBJ.EQ.OYSTER.AND.HINTED(2).AND.TOTING(OYSTER))SPK=194\r
5299 FLDA OBJ\r
5300 FSUB OYSTER\r
5301 JNE #M95\r
81e70d48
PH		 5302 FLDA TWO\r
5303 ATX 7\r
5304 FLDA HINTED-3,7\r
84b5715c
PH		 5305 JEQ #M95\r
5306 FLDA OYSTER\r
5307 JSA TOTING\r
5308 JEQ .+6\r
81e70d48 5309 LDX 302,0 /194\r
84b5715c
PH		 5310 XTA 0\r
5311 FSTA SPK\r
5312/ IF(OBJ.NE.OYSTER.OR.HINTED(2).OR..NOT.TOTING(OYSTER)\r
5313/ 1 .OR..NOT.CLOSED)GOTO 2011\r
5314#M95, FLDA OBJ\r
5315 FSUB OYSTER\r
5316 JNE #2011\r
81e70d48 5317 FLDA HINTED-3,7\r
84b5715c
PH		 5318 JNE #2011\r
5319 FLDA OYSTER\r
5320 JSA TOTING\r
5321 JEQ #2011\r
5322 FLDA CLOSED\r
5323 JEQ #2011\r
5324/ HINTED(2)=YES(192,193,54)\r
81e70d48
PH		 5325 FLDA TWO\r
5326 ATX 7\r
84b5715c 5327 JSR YES\r
81e70d48 5328 JA .+10\r
84b5715c
PH		 5329 JA #LIT+267\r
5330 JA #LIT+272\r
5331 JA #LIT+113\r
81e70d48 5332 FSTA HINTED-3,7\r
84b5715c 5333/ GOTO 2012\r
81e70d48 5334 JA #2012\r
84b5715c
PH		 5335\r
5336/C\r
5337/C BREAK. ONLY WORKS FOR MIRROR IN REPOSITORY AND, OF COURSE, THE VASE.\r
5338/C\r
5339/9280 IF(OBJ.EQ.MIRROR)SPK=148\r
5340#9280, FLDA OBJ\r
5341 FSUB MIRROR\r
5342 JNE .+6\r
81e70d48 5343 LDX 224,0 /148\r
84b5715c
PH		 5344 XTA 0\r
5345 FSTA SPK\r
5346/ IF(OBJ.EQ.VASE.AND.PROP(VASE).EQ.0)GOTO 9282\r
5347 FLDA OBJ\r
5348 FSUB VASE\r
5349 JNE #M96\r
5350 FLDA VASE\r
81e70d48
PH		 5351 ATX 7\r
5352 FLDA PROP-3,7\r
84b5715c
PH		 5353 JEQ #9282\r
5354/ IF(OBJ.NE.MIRROR.OR..NOT.CLOSED)GOTO 2011\r
5355#M96, FLDA OBJ\r
5356 FSUB MIRROR\r
5357 JNE #2011\r
5358 FLDA CLOSED\r
5359 JEQ #2011\r
5360/ CALL RSPEAK(197)\r
5361 JSR RSPEAK\r
5362/ GOTO 19000\r
5363 JA #19000\r
5364 JA #LIT+275\r
5365\r
5366/C\r
5367/9282 SPK=198\r
81e70d48 5368#9282, LDX 306,0 /198\r
84b5715c
PH		 5369 XTA 0\r
5370 FSTA SPK\r
5371/ IF(TOTING(VASE))CALL DROP(VASE,LOC)\r
5372 FLDA VASE\r
5373 JSA TOTING\r
5374 JEQ .+12\r
5375 JSR DROP\r
5376 JA .+6\r
5377 JA VASE\r
5378 JA LOC\r
5379/ PROP(VASE)=2\r
81e70d48
PH		 5380 FLDA VASE\r
5381 ATX 7\r
84b5715c 5382 FLDA TWO\r
81e70d48 5383 FSTA PROP-3,7\r
84b5715c
PH		 5384/ FIXED(VASE)=-1\r
5385 FLDA MINUS1\r
81e70d48 5386 FSTA FIXED-3,7\r
84b5715c
PH		 5387/ GOTO 2011\r
5388 JA #2011\r
5389\r
5390/C\r
5391/C WAKE. ONLY USE IS TO DISTURB THE DWARVES.\r
5392/C\r
5393/9290 IF(OBJ.NE.DWARF.OR..NOT.CLOSED)GOTO 2011\r
5394#9290, FLDA OBJ\r
5395 FSUB DWARF\r
5396 JNE #2011\r
5397 FLDA CLOSED\r
5398 JEQ #2011\r
5399/ CALL RSPEAK(199)\r
5400 JSR RSPEAK\r
5401/ GOTO 19000\r
5402 JA #19000\r
5403 JA #LIT+300\r
5404\r
5405/C\r
5406/C SUSPEND. SAVE THE WORLD.\r
5407/C\r
5408/8300 CALL SAVEGM(.TRUE.,I)\r
5409/ GOTO 2012\r
5410#8300, JSR SAVEGM\r
5411 JA #2012\r
5412 JA ONE\r
5413 JA I\r
5414\r
5415/C\r
5416/C HOURS. JUST A JOKE.\r
5417/C\r
5418/8310 CALL RSPEAK(201)\r
5419#8310, JSR RSPEAK\r
5420/ GOTO 2012\r
5421 JA #2012\r
5422 JA #LIT+303\r
5423\r
5424/C\r
5425/C RESUME. RESTORE THE WORLD.\r
5426/C\r
5427/8320 CALL RSTRGM(.TRUE.,I)\r
5428/ GO TO 2012\r
5429\r
5430#8320, JSR RSTRGM\r
5431 JA #2012\r
5432 JA ONE\r
5433 JA I\r
5434\r
5435\r
5436/C HINTS\r
5437/C\r
5438/C COME HERE IF HE'S BEEN LONG ENOUGH AT REQUIRED LOC(S) FOR SOME UNUSED HINT.\r
5439/C HINT NUMBER IS IN VARIABLE "HINT". BRANCH TO QUICK TEST FOR ADDITIONAL\r
5440/C CONDITIONS, THEN COME BACK TO DO NEAT STUFF. GOTO 40010 IF CONDITIONS ARE\r
5441/C MET AND WE WANT TO OFFER THE HINT. GOTO 40020 TO CLEAR HINTLC BACK TO ZERO,\r
5442/C 40030 TO TAKE NO ACTION YET.\r
5443/C\r
5444/40000 GOTO (40400,40500,40600,40700,40800,40900)(HINT-3)\r
5445/C CAVE BIRD SNAKE MAZE DARK WITT\r
5446#40000, FLDA HINT\r
5447 FSUB THREE\r
5448 ATX 1\r
5449 STARTD\r
5450 FLDA .+2,1\r
5451 STARTF\r
5452 JAC\r
5453 JA #40400\r
5454 JA #40500\r
5455 JA #40600\r
5456 JA #40700\r
5457 JA #40800\r
5458 JA #40010\r
5459/ CALL BUG(27)\r
5460 JSR BUG\r
5461 JA .+4\r
5462 JA #LIT+60\r
5463/C\r
5464/40010 HINTLC(HINT)=0\r
5465#40010, FLDA HINT\r
5466 ATX 7\r
5467 FCLA\r
5468 FSTA HINTLC-3,7\r
5469/ IF(.NOT.YES(HINTS(HINT,3),0,54))GOTO 2602\r
81e70d48
PH		 5470 FLDA #LIT+377\r
5471 FADD HINT\r
84b5715c 5472 ATX 7\r
81e70d48
PH		 5473 XTA 7\r
5474 FMUL THREE\r
5475 ALN 0\r
5476 STARTD\r
5477 FADD PHINTS\r
5478 FSTA .+7\r
5479 STARTF\r
84b5715c
PH		 5480 JSR YES\r
5481 JA .+10\r
81e70d48 5482 JA .\r
84b5715c
PH		 5483 JA ZERO\r
5484 JA #LIT+113\r
5485 JEQ #2602\r
5486/ TYPE 40012,HINTS(HINT,2)\r
81e70d48
PH		 5487 JSR SIXOUT\r
5488 JA .+10\r
84b5715c 5489 JA #40012\r
81e70d48 5490 JA ZERO\r
84b5715c
PH		 5491 JA TWO\r
5492\r
5493 TRAP3 #WRITO\r
5494 JA #LIT\r
5495 JA #4001A\r
81e70d48
PH		 5496 FLDA TWO\r
5497 FMUL #LIT+36\r
5498 FADD HINT\r
84b5715c 5499 ATX 7\r
81e70d48 5500 FLDA HINTS-0077,7\r
84b5715c
PH		 5501 TRAP3 #RSVO\r
5502 TRAP3 #RENDO\r
5503\r
81e70d48
PH		 5504 JSR SIXOUT\r
5505 JA .+10\r
84b5715c 5506 JA #4001B\r
81e70d48 5507 JA ZERO\r
84b5715c
PH		 5508 JA ONE\r
5509/40012 FORMAT(' I am prepared to give you a hint, but it will cost you',\r
5510/ 1 I2,' points.')\r
5511\r
5512/ HINTED(HINT)=YES(175,HINTS(HINT,4),54)\r
5513 FLDA HINT\r
84b5715c 5514 ATX 7\r
81e70d48
PH		 5515 FLDA #LIT\r
5516 FMUL #LIT+36\r
5517 FADD HINT\r
5518 ATX 6\r
5519 XTA 6\r
5520 FMUL THREE\r
5521 ALN 0\r
5522 STARTD\r
5523 FADD PHINTS\r
5524 FSTA .+11\r
5525 STARTF\r
84b5715c
PH		 5526 JSR YES\r
5527 JA .+10\r
5528 JA #LIT+250\r
81e70d48 5529 JA .\r
84b5715c 5530 JA #LIT+113\r
81e70d48 5531 FSTA HINTED-3,7\r
84b5715c
PH		 5532/ IF(HINTED(HINT).AND.LIMIT.GT.30)LIMIT=LIMIT+30*HINTS(HINT,2)\r
5533 JEQ #40020\r
5534 FLDA LIMIT\r
5535 FSUB #LIT+63\r
5536 JLE #40020\r
81e70d48
PH		 5537 FLDA TWO\r
5538 FMUL #LIT+36\r
5539 FADD HINT\r
84b5715c
PH		 5540 ATX 6\r
5541 FLDA #LIT+63\r
81e70d48 5542 FMUL HINTS-0077,6\r
84b5715c
PH		 5543 FADD LIMIT\r
5544 FSTA LIMIT\r
5545/40020 HINTLC(HINT)=0\r
5546#40020, FLDA HINT\r
5547 ATX 7\r
5548 FCLA\r
5549 FSTA HINTLC-3,7\r
5550/40030 GOTO 2602\r
5551#40030, JA #2602\r
5552\r
5553/C\r
5554/C NOW FOR THE QUICK TESTS. SEE DATABASE DESCRIPTION FOR ONE-LINE NOTES.\r
5555/C\r
5556/40400 IF(PROP(GRATE).EQ.0.AND..NOT.HERE(KEYS))GOTO 40010\r
5557#40400, FLDA GRATE\r
81e70d48
PH		 5558 ATX 7\r
5559 FLDA PROP-3,7\r
84b5715c
PH		 5560 JNE #40020\r
5561 FLDA KEYS\r
5562 JSA HERE\r
5563 JEQ #40010\r
5564/ GOTO 40020\r
5565 JA #40020\r
5566\r
5567/40500 IF(HERE(BIRD).AND.TOTING(ROD).AND.OBJ.EQ.BIRD)GOTO 40010\r
5568#40500, FLDA BIRD\r
5569 JSA HERE\r
5570 JEQ #2602\r
5571 FLDA ROD\r
5572 JSA TOTING\r
5573 JEQ #2602\r
5574 FLDA OBJ\r
5575 JEQ #40010\r
5576 FSUB BIRD\r
5577 JEQ #40010\r
5578/ GOTO 40030\r
5579 JA #2602\r
5580\r
5581/C\r
5582/40600 IF(HERE(SNAKE).AND..NOT.HERE(BIRD))GOTO 40010\r
5583#40600, FLDA SNAKE\r
5584 JSA HERE\r
5585 JEQ #40020\r
5586 FLDA BIRD\r
5587 JSA HERE\r
5588 JEQ #40010\r
5589/ GOTO 40020\r
5590 JA #40020\r
5591\r
5592/C\r
5593/40700 IF(ATLOC(LOC).EQ.0.AND.ATLOC(OLDLOC).EQ.0\r
5594/ 1 .AND.ATLOC(OLDLC2).EQ.0.AND.HOLDNG.GT.1)GOTO 40010\r
5595#40700, FLDA LOC\r
5596 ATX 7\r
5597 FLDA ATLOC-3,7\r
5598 JNE #40020\r
5599 FLDA OLDLOC\r
5600 ATX 6\r
5601 FLDA ATLOC-3,6\r
5602 JNE #40020\r
5603 FLDA OLDLC2\r
5604 ATX 5\r
5605 FLDA ATLOC-3,5\r
5606 JNE #40020\r
5607 FLDA HOLDNG\r
5608 FSUB ONE\r
5609 JGT #40010\r
5610/ GOTO 40020\r
5611 JA #40020\r
5612\r
5613/C\r
5614/40800 IF(PROP(EMRALD).NE.-1.AND.PROP(PYRAM).EQ.-1)GOTO 40010\r
5615/ GOTO 40020\r
5616#40800, FLDA EMRALD\r
5617 ATX 7\r
5618 FLDA MINUS1\r
5619 FSUB PROP-3,7\r
5620 JEQ #40020\r
5621 FLDA PYRAM\r
5622 ATX 6\r
5623 FLDA MINUS1\r
5624 FSUB PROP-3,6\r
5625 JEQ #40010\r
5626/ GOTO 40020\r
5627 JA #40020\r
5628/C\r
5629/40900 JA #40010\r
5630/#40900 JA 40010\r
5631\r
5632/C CAVE CLOSING AND SCORING\r
5633/C\r
5634/C\r
5635/C THESE SECTIONS HANDLE THE CLOSING OF THE CAVE. THE CAVE CLOSES "CLOCK1"\r
5636/C TURNS AFTER THE LAST TREASURE HAS BEEN LOCATED (INCLUDING THE PIRATE'S\r
5637/C CHEST, WHICH MAY OF COURSE NEVER SHOW UP). NOTE THAT THE TREASURES NEED NOT\r
5638/C HAVE BEEN TAKEN YET, JUST LOCATED. HENCE CLOCK1 MUST BE LARGE ENOUGH TO GET\r
5639/C OUT OF THE CAVE (IT ONLY TICKS WHILE INSIDE THE CAVE). WHEN IT HITS ZERO,\r
5640/C WE BRANCH TO 10000 TO START CLOSING THE CAVE, AND THEN SIT BACK AND WAIT FOR\r
5641/C HIM TO TRY TO GET OUT. IF HE DOESN'T WITHIN CLOCK2 TURNS, WE CLOSE THE\r
5642/C CAVE; IF HE DOES TRY, WE ASSUME HE PANICS, AND GIVE HIM A FEW ADDITIONAL\r
5643/C TURNS TO GET FRANTIC BEFORE WE CLOSE. WHEN CLOCK2 HITS ZERO, WE BRANCH TO\r
5644/C 11000 TO TRANSPORT HIM INTO THE FINAL PUZZLE. NOTE THAT THE PUZZLE DEPENDS\r
5645/C UPON ALL SORTS OF RANDOM THINGS. FOR INSTANCE, THERE MUST BE NO WATER OR\r
5646/C OIL, SINCE THERE ARE BEANSTALKS WHICH WE DON'T WANT TO BE ABLE TO WATER,\r
5647/C SINCE THE CODE CAN'T HANDLE IT. ALSO, WE CAN HAVE NO KEYS, SINCE THERE IS A\r
5648/C GRATE (HAVING MOVED THE FIXED OBJECT!) THERE SEPARATING HIM FROM ALL THE\r
5649/C TREASURES. MOST OF THESE PROBLEMS ARISE FROM THE USE OF NEGATIVE PROP\r
5650/C NUMBERS TO SUPPRESS THE OBJECT DESCRIPTIONS UNTIL HE'S ACTUALLY MOVED THE\r
5651/C OBJECTS.\r
5652/C\r
5653/C WHEN THE FIRST WARNING COMES, WE LOCK THE GRATE, DESTROY THE BRIDGE, KILL\r
5654/C ALL THE DWARVES (AND THE PIRATE), REMOVE THE TROLL AND BEAR (UNLESS DEAD),\r
5655/C AND SET "CLOSNG" TO TRUE. LEAVE THE DRAGON; TOO MUCH TROUBLE TO MOVE IT.\r
5656/C FROM NOW UNTIL CLOCK2 RUNS OUT, HE CANNOT UNLOCK THE GRATE, MOVE TO ANY\r
5657/C LOCATION OUTSIDE THE CAVE (LOC<9), OR CREATE THE BRIDGE. NOR CAN HE BE\r
5658/C RESURRECTED IF HE DIES. NOTE THAT THE SNAKE IS ALREADY GONE, SINCE HE GOT\r
5659/C TO THE TREASURE ACCESSIBLE ONLY VIA THE HALL OF THE MT. KING. ALSO, HE'S\r
5660/C BEEN IN GIANT ROOM (TO GET EGGS), SO WE CAN REFER TO IT. ALSO ALSO, HE'S\r
5661/C GOTTEN THE PEARL, SO WE KNOW THE BIVALVE IS AN OYSTER. *AND*, THE DWARVES\r
5662/C MUST HAVE BEEN ACTIVATED, SINCE WE'VE FOUND CHEST.\r
5663/C\r
5664/10000 PROP(GRATE)=0\r
5665#10000, FLDA GRATE\r
5666 ATX 7\r
5667 FCLA\r
5668 FSTA PROP-3,7\r
5669/ PROP(FISSUR)=0\r
5670 FLDA FISSUR\r
5671 ATX 7\r
5672 FCLA\r
5673 FSTA PROP-3,7\r
5674/ DO 10010 I=1,6\r
5675 FLDA ONE\r
5676 FSTA I\r
5677\r
5678/ DSEEN(I)=.FALSE.\r
5679#H0204, FLDA I\r
5680 ATX 7\r
5681 FCLA\r
5682 FSTA DSEEN-3,7\r
5683/10010 DLOC(I)=0\r
5684/#10010, FLDA I\r
5685/ ATX 7\r
5686/ FCLA\r
5687 FSTA DLOC-3,7\r
5688 FLDA I\r
5689 FADD ONE\r
5690 FSTA I\r
5691 FSUB #LIT+6\r
5692 JLE #H0204\r
5693/ CALL MOVE(TROLL,0)\r
5694 JSR MOVE\r
5695 JA .+6\r
5696 JA TROLL\r
5697 JA ZERO\r
5698/ CALL MOVE(TROLL+100,0)\r
5699 FLDA TROLL\r
84b5715c
PH		 5700 FADD #LIT+154\r
5701 FSTA #TMP\r
5702 JSR MOVE\r
5703 JA .+6\r
5704 JA #TMP\r
5705 JA ZERO\r
5706/ CALL MOVE(TROLL2,PLAC(TROLL))\r
81e70d48
PH		 5707 FLDA TROLL\r
5708 ATX 7\r
5709 XTA 7\r
5710 FMUL THREE\r
5711 ALN 0\r
5712 STARTD\r
5713 FADD PPLAC\r
5714 FSTA .+11\r
5715 STARTF\r
84b5715c
PH		 5716 JSR MOVE\r
5717 JA .+6\r
5718 JA TROLL2\r
81e70d48 5719 JA .\r
84b5715c
PH		 5720/ CALL MOVE(TROLL2+100,FIXD(TROLL))\r
5721 FLDA TROLL2\r
5722 FADD #LIT+154\r
5723 FSTA #TMP\r
81e70d48
PH		 5724 FLDA TROLL\r
5725 ATX 7\r
5726 XTA 7\r
5727 FMUL THREE\r
5728 ALN 0\r
5729 STARTD\r
5730 FADD PFIXD\r
5731 FSTA .+11\r
5732 STARTF\r
84b5715c
PH		 5733 JSR MOVE\r
5734 JA .+6\r
5735 JA #TMP\r
81e70d48 5736 JA .\r
84b5715c 5737/ CALL JUGGLE(CHASM)\r
81e70d48
PH		 5738 JSR JUGGLE\r
5739 JA .+4\r
5740 JA CHASM\r
84b5715c
PH		 5741/ IF(PROP(BEAR).NE.3)CALL DSTROY(BEAR)\r
5742 FLDA BEAR\r
81e70d48
PH		 5743 ATX 7\r
5744 FLDA PROP-3,7\r
84b5715c 5745 FSUB THREE\r
81e70d48
PH		 5746 JEQ .+10\r
5747 JSR DSTROY\r
5748 JA .+4\r
5749 JA BEAR\r
84b5715c
PH		 5750/ PROP(CHAIN)=0\r
5751 FLDA CHAIN\r
5752 ATX 7\r
5753 FCLA\r
5754 FSTA PROP-3,7\r
5755/ FIXED(CHAIN)=0\r
5756/ PROP(AXE)=0\r
5757 FLDA AXE\r
5758 ATX 7\r
5759 FCLA\r
5760 FSTA PROP-3,7\r
5761/ FIXED(AXE)=0\r
5762 FSTA FIXED-3,7\r
5763/ CALL RSPEAK(129)\r
5764 JSR RSPEAK\r
5765 JA .+4\r
5766 JA #LIT+204\r
5767/ CLOCK1=-1\r
5768 FLDA MINUS1\r
5769 FSTA CLOCK1\r
5770/ CLOSNG=.TRUE.\r
5771 FLDA ONE\r
5772 FSTA CLOSNG\r
5773/ GOTO 19999\r
5774 JA #19999\r
5775\r
5776/C\r
5777/C ONCE HE'S PANICKED, AND CLOCK2 HAS RUN OUT, WE COME HERE TO SET UP THE\r
5778/C STORAGE ROOM. THE ROOM HAS TWO LOCS, HARDWIRED AS 115 (NE) AND 116 (SW).\r
5779/C AT THE NE END, WE PLACE EMPTY BOTTLES, A NURSERY OF PLANTS, A BED OF\r
5780/C OYSTERS, A PILE OF LAMPS, RODS WITH STARS, SLEEPING DWARVES, AND HIM. AND\r
5781/C THE SW END WE PLACE GRATE OVER TREASURES, SNAKE PIT, COVEY OF CAGED BIRDS,\r
5782/C MORE RODS, AND PILLOWS. A MIRROR STRETCHES ACROSS ONE WALL. MANY OF THE\r
5783/C OBJECTS COME FROM KNOWN LOCATIONS AND/OR STATES (E.G. THE SNAKE IS KNOWN TO\r
5784/C HAVE BEEN DESTROYED AND NEEDN'T BE CARRIED AWAY FROM ITS OLD "PLACE"),\r
5785/C MAKING THE VARIOUS OBJECTS BE HANDLED DIFFERENTLY. WE ALSO DROP ALL OTHER\r
5786/C OBJECTS HE MIGHT BE CARRYING (LEST HE HAVE SOME WHICH COULD CAUSE TROUBLE,\r
5787/C SUCH AS THE KEYS). WE DESCRIBE THE FLASH OF LIGHT AND TRUNDLE BACK.\r
5788/C\r
5789/11000 PROP(BOTTLE)=PUT(BOTTLE,115,1)\r
5790#11000, FLDA BOTTLE\r
5791 ATX 7\r
5792 JSR PUT\r
5793 JA .+10\r
5794 JA BOTTLE\r
5795 JA #LIT+165\r
5796 JA ONE\r
5797 FSTA PROP-3,7\r
5798/ PROP(PLANT)=PUT(PLANT,115,0)\r
5799 FLDA PLANT\r
5800 ATX 7\r
5801 JSR PUT\r
5802 JA .+10\r
5803 JA PLANT\r
5804 JA #LIT+165\r
5805 JA ZERO\r
5806 FSTA PROP-3,7\r
5807/ PROP(OYSTER)=PUT(OYSTER,115,0)\r
5808 FLDA OYSTER\r
5809 ATX 7\r
5810 JSR PUT\r
5811 JA .+10\r
5812 JA OYSTER\r
5813 JA #LIT+165\r
5814 JA ZERO\r
5815 FSTA PROP-3,7\r
5816/ PROP(LAMP)=PUT(LAMP,115,0)\r
5817 FLDA LAMP\r
5818 ATX 7\r
5819 JSR PUT\r
5820 JA .+10\r
5821 JA LAMP\r
5822 JA #LIT+165\r
5823 JA ZERO\r
5824 FSTA PROP-3,7\r
5825/ PROP(ROD)=PUT(ROD,115,0)\r
5826 FLDA ROD\r
5827 ATX 7\r
5828 JSR PUT\r
5829 JA .+10\r
5830 JA ROD\r
5831 JA #LIT+165\r
5832 JA ZERO\r
5833 FSTA PROP-3,7\r
5834/ PROP(DWARF)=PUT(DWARF,115,0)\r
5835 FLDA DWARF\r
5836 ATX 7\r
5837 JSR PUT\r
5838 JA .+10\r
5839 JA DWARF\r
5840 JA #LIT+165\r
5841 JA ZERO\r
5842 FSTA PROP-3,7\r
5843/ LOC=115\r
5844/ OLDLOC=115\r
5845/ NEWLOC=115\r
5846 FLDA #LIT+165\r
5847 FSTA LOC\r
5848 FSTA OLDLOC\r
5849 FSTA NEWLOC\r
5850/C\r
5851/C LEAVE THE GRATE WITH NORMAL (NON-NEGATIVE PROPERTY).\r
5852/C\r
5853/ I=PUT(GRATE,116,0)\r
5854 JSR PUT\r
5855 JA .+10\r
5856 JA GRATE\r
5857 JA #LIT+170\r
5858 JA ZERO\r
5859 FSTA I\r
5860/ PROP(SNAKE)=PUT(SNAKE,116,1)\r
5861 FLDA SNAKE\r
5862 ATX 7\r
5863 JSR PUT\r
5864 JA .+10\r
5865 JA SNAKE\r
5866 JA #LIT+170\r
5867 JA ONE\r
5868 FSTA PROP-3,7\r
5869/ PROP(BIRD)=PUT(BIRD,116,1)\r
5870 FLDA BIRD\r
5871 ATX 7\r
5872 JSR PUT\r
5873 JA .+10\r
5874 JA BIRD\r
5875 JA #LIT+170\r
5876 JA ONE\r
5877 FSTA PROP-3,7\r
5878/ PROP(CAGE)=PUT(CAGE,116,0)\r
5879 FLDA CAGE\r
5880 ATX 7\r
5881 JSR PUT\r
5882 JA .+10\r
5883 JA CAGE\r
5884 JA #LIT+170\r
5885 JA ZERO\r
5886 FSTA PROP-3,7\r
5887/ PROP(ROD2)=PUT(ROD2,116,0)\r
5888 FLDA ROD2\r
5889 ATX 7\r
5890 JSR PUT\r
5891 JA .+10\r
5892 JA ROD2\r
5893 JA #LIT+170\r
81e70d48 5894 JA MINUS1\r
84b5715c
PH		 5895 FSTA PROP-3,7\r
5896/ PROP(PILLOW)=PUT(PILLOW,116,0)\r
5897 FLDA PILLOW\r
5898 ATX 7\r
5899 JSR PUT\r
5900 JA .+10\r
5901 JA PILLOW\r
5902 JA #LIT+170\r
5903 JA ZERO\r
5904 FSTA PROP-3,7\r
5905/C\r
5906/ PROP(MIRROR)=PUT(MIRROR,115,0)\r
5907 FLDA MIRROR\r
5908 ATX 7\r
5909 JSR PUT\r
5910 JA .+10\r
5911 JA MIRROR\r
5912 JA #LIT+165\r
5913 JA ZERO\r
5914 FSTA PROP-3,7\r
5915/ FIXED(MIRROR)=116\r
5916 FLDA #LIT+170\r
5917 FSTA FIXED-3,7\r
5918/C\r
5919/ DO 11010 I=1,100\r
5920 FLDA ONE\r
5921 FSTA I\r
5922\r
5923/11010 IF(TOTING(I))CALL DSTROY(I)\r
5924#11010, FLDA I\r
5925 JSA TOTING\r
81e70d48
PH		 5926 JEQ .+10\r
5927 JSR DSTROY\r
5928 JA .+4\r
5929 JA I\r
84b5715c
PH		 5930 FLDA I\r
5931 FADD ONE\r
5932 FSTA I\r
5933 FSUB #LIT+154\r
5934 JLE #11010\r
5935/C\r
5936/ CALL RSPEAK(132)\r
5937 JSR RSPEAK\r
5938 JA .+4\r
5939 JA #LIT+215\r
5940/ CLOSED=.TRUE.\r
5941 FLDA ONE\r
5942 FSTA CLOSED\r
5943/ GOTO 2\r
5944 JA #2\r
5945\r
5946/C\r
5947/C ANOTHER WAY WE CAN FORCE AN END TO THINGS IS BY HAVING THE LAMP GIVE OUT.\r
5948/C WHEN IT GETS CLOSE, WE COME HERE TO WARN HIM. WE GO TO 12000 IF THE LAMP\r
5949/C AND FRESH BATTERIES ARE HERE, IN WHICH CASE WE REPLACE THE BATTERIES AND\r
5950/C CONTINUE. 12200 IS FOR OTHER CASES OF LAMP DYING.12400 IS WHEN IT GOES\r
5951/C OUT, AND 12600 IS IF HE'S WANDERED OUTSIDE AND THE LAMP IS USED UP, IN WHICH\r
5952/C CASE WE FORCE HIM TO GIVE UP.\r
5953/C\r
5954/12000 CALL RSPEAK(188)\r
5955#12000, JSR RSPEAK\r
5956 JA .+4\r
5957 JA #LIT+264\r
5958/ PROP(BATTER)=1\r
5959 FLDA BATTER\r
5960 ATX 7\r
5961 FLDA ONE\r
5962 FSTA PROP-3,7\r
5963/ IF(TOTING(BATTER))CALL DROP(BATTER,LOC)\r
5964 FLDA BATTER\r
5965 JSA TOTING\r
5966 JEQ .+12\r
5967 JSR DROP\r
5968 JA .+6\r
5969 JA BATTER\r
5970 JA LOC\r
5971/ LIMIT=LIMIT+2500\r
5972 FLDA #LIT+317\r
5973 FADDM LIMIT\r
5974/ LMWARN=.FALSE.\r
5975 FCLA\r
5976 FSTA LMWARN\r
5977/ GOTO 19999\r
5978 JA #19999\r
5979\r
5980/C\r
5981/12200 IF(LMWARN.OR..NOT.HERE(LAMP))GOTO 19999\r
5982#12200, FLDA LAMP\r
5983 JSA HERE\r
5984 JEQ #19999\r
5985 FLDA LMWARN\r
5986 JNE #19999\r
5987/ LMWARN=.TRUE.\r
5988 FLDA ONE\r
5989 FSTA LMWARN\r
5990/ SPK=187\r
81e70d48 5991 LDX 273,0 /187\r
84b5715c
PH		 5992 XTA 0\r
5993 FSTA SPK\r
5994/ IF(PLACE(BATTER).EQ.0)SPK=183\r
5995 FLDA BATTER\r
5996 ATX 7\r
5997 FLDA PLACE-3,7\r
5998 JNE .+6\r
81e70d48 5999 LDX 267,0 /183\r
84b5715c
PH		 6000 XTA 0\r
6001 FSTA SPK\r
6002/ IF(PROP(BATTER).EQ.1)SPK=189\r
6003 FLDA PROP-3,7\r
6004 FSUB ONE\r
6005 JNE .+6\r
81e70d48 6006 LDX 275,0 /189\r
84b5715c
PH		 6007 XTA 0\r
6008 FSTA SPK\r
6009/ CALL RSPEAK(SPK)\r
6010#H0214, JSR RSPEAK\r
6011 JA #19999\r
6012 JA SPK\r
6013/ GOTO 19999\r
6014\r
6015/C\r
6016/12400 LIMIT=-1\r
6017#12400, FLDA MINUS1\r
6018 FSTA LIMIT\r
6019/ PROP(LAMP)=0\r
6020 FLDA LAMP\r
6021 ATX 7\r
6022 FCLA\r
6023 FSTA PROP-3,7\r
6024/ IF(HERE(LAMP))CALL RSPEAK(184)\r
6025 FLDA LAMP\r
6026 JSA HERE\r
6027/ GOTO 19999\r
6028 JEQ #19999\r
6029 JSR RSPEAK\r
6030 JA #19999\r
6031 JA #LIT+253\r
6032\r
6033/C\r
6034/12600 CALL RSPEAK(185)\r
6035#12600, JSR RSPEAK\r
6036 JA .+4\r
6037 JA #LIT+256\r
6038/ GAVEUP=.TRUE.\r
6039 FLDA ONE\r
6040 FSTA GAVEUP\r
6041/ GOTO 20000\r
6042 JA #20000\r
6043\r
6044/C\r
6045/C\r
6046/C OH DEAR, HE'S DISTURBED THE DWARVES.\r
6047/C\r
6048/19000 CALL RSPEAK(136)\r
6049#19000, JSR RSPEAK\r
6050 JA .+4\r
6051 JA #LIT+220\r
6052\r
6053/C\r
6054/C EXIT CODE. WILL EVENTUALLY INCLUDE SCORING. FOR NOW, HOWEVER, ...\r
6055/C\r
6056/C THE PRESENT SCORING ALGORITHM IS AS FOLLOWS:\r
6057/C OBJECTIVE: POINTS: PRESENT TOTAL POSSIBLE:\r
6058/C GETTING WELL INTO CAVE 25 25\r
6059/C EACH TREASURE < CHEST 12 60\r
6060/C TREASURE CHEST ITSELF 14 14\r
6061/C EACH TREASURE > CHEST 16 144\r
6062/C SURVIVING (MAX-NUM)*10 30\r
6063/C NOT QUITTING 4 4\r
6064/C REACHING "CLOSNG" 25 25\r
6065/C "CLOSED": QUIT/KILLED 10\r
6066/C KLUTZED 25\r
6067/C WRONG WAY 30\r
6068/C SUCCESS 45 45\r
6069/C CAME TO WITT'S END 1 1\r
6070/C ROUND OUT THE TOTAL 2 2\r
6071/C TOTAL: 350\r
6072/20000 SCORE=0\r
6073#20000, FCLA\r
6074 FSTA SCORE\r
6075/ MXSCOR=0\r
6076 FSTA MXSCOR\r
6077/C\r
6078/C FIRST TALLY UP THE TREASURES. MUST BE IN BUILDING AND NOT BROKEN.\r
6079/C GIVE THE POOR GUY 2 POINTS JUST FOR FINDING EACH TREASURE.\r
6080/C\r
6081/ DO 20010 I=50,MAXTRS\r
6082 FLDA #LIT+110\r
6083 FSTA I\r
6084\r
6085/ IF(PTEXT(I).EQ.0)GOTO 20010\r
6086#H0216, FLDA I\r
6087 ATX 7\r
6088 FLDA PTEXT-3,7\r
6089 JEQ #20010\r
6090/ K=12\r
6091 FLDA #LIT+22\r
6092 FSTA K\r
6093/ IF(I.EQ.CHEST)K=14\r
6094 FLDA I\r
6095 FSUB CHEST\r
6096 JNE .+7\r
81e70d48 6097 LDX 16,0 /14\r
84b5715c
PH		 6098 XTA 0\r
6099 FSTA K\r
6100/ IF(I.GT.CHEST)K=16\r
6101 FLDA I\r
6102 FSUB CHEST\r
6103 JLE .+5\r
6104 FLDA #LIT+30\r
6105 FSTA K\r
6106/ IF(PROP(I).GE.0)SCORE=SCORE+2\r
6107 FLDA PROP-3,7\r
6108 JLT .+5\r
6109 FLDA TWO\r
6110 FADDM SCORE\r
6111/ IF(PLACE(I).EQ.3.AND.PROP(I).EQ.0)SCORE=SCORE+K-2\r
6112 FLDA PLACE-3,7\r
6113 FSUB THREE\r
6114 JNE #M100\r
6115 FLDA PROP-3,7\r
6116 JNE #M100\r
6117 FLDA SCORE\r
6118 FADD K\r
6119 FSUB TWO\r
6120 FSTA SCORE\r
6121/ MXSCOR=MXSCOR+K\r
6122#M100, FLDA K\r
6123 FADDM MXSCOR\r
6124\r
6125/20010 CONTINUE\r
6126#20010, FLDA I\r
6127 FADD ONE\r
6128 FSTA I\r
6129 FSUB MAXTRS\r
6130 JLE #H0216\r
6131/C\r
6132/C NOW LOOK AT HOW HE FINISHED AND HOW FAR HE GOT. MAXDIE AND NUMDIE TELL US\r
6133/C HOW WELL HE SURVIVED. GAVEUP SAYS WHETHER HE EXITED VIA QUIT. DFLAG WILL\r
6134/C TELL US IF HE EVER GOT SUITABLY DEEP INTO THE CAVE. CLOSNG STILL INDICATES\r
6135/C WHETHER HE REACHED THE ENDGAME. AND IF HE GOT AS FAR AS "CAVE CLOSED"\r
6136/C (INDICATED BY "CLOSED"), THEN BONUS IS ZERO FOR MUNDANE EXITS OR 133, 134,\r
6137/C 135 IF HE BLEW IT (SO TO SPEAK).\r
6138/C\r
6139/ SCORE=SCORE+(MAXDIE-NUMDIE)*10\r
6140 FLDA MAXDIE\r
6141 FSUB NUMDIE\r
6142 FMUL #LIT+17\r
6143 FADDM SCORE\r
6144/ MXSCOR=MXSCOR+MAXDIE*10\r
6145 FLDA MAXDIE\r
6146 FMUL #LIT+17\r
6147 FADDM MXSCOR\r
6148/ IF(.NOT.(SCORNG.OR.GAVEUP))SCORE=SCORE+4\r
6149 FLDA SCORNG\r
6150 FADD GAVEUP\r
6151 JNE .+5\r
6152 FLDA #LIT\r
6153 FADDM SCORE\r
6154/ MXSCOR=MXSCOR+4\r
6155 FLDA #LIT\r
6156 FADDM MXSCOR\r
6157\f\r
6158/ IF(DFLAG.NE.0)SCORE=SCORE+25\r
6159 FLDA DFLAG\r
6160 JEQ .+5\r
6161 FLDA #LIT+52\r
6162 FADDM SCORE\r
6163/ MXSCOR=MXSCOR+25\r
6164 FLDA #LIT+52\r
6165 FADDM MXSCOR\r
6166/ IF(CLOSNG)SCORE=SCORE+25\r
6167 FLDA CLOSNG\r
6168 JEQ .+5\r
6169 FLDA #LIT+52\r
6170 FADDM SCORE\r
6171/ MXSCOR=MXSCOR+25\r
6172 FLDA #LIT+52\r
6173 FADDM MXSCOR\r
6174/ IF(.NOT.CLOSED)GOTO 20020\r
6175 FLDA CLOSED\r
6176 JEQ #20020\r
6177/ IF(BONUS.EQ.0)SCORE=SCORE+10\r
6178 FLDA BONUS\r
6179 JNE .+5\r
6180 FLDA #LIT+17\r
6181 FADDM SCORE\r
6182/ IF(BONUS.EQ.135)SCORE=SCORE+25\r
81e70d48 6183 LDX 207,0 /135\r
84b5715c
PH		 6184 XTA 0\r
6185 FSUB BONUS\r
6186 JNE .+5\r
6187 FLDA #LIT+52\r
6188 FADDM SCORE\r
6189/ IF(BONUS.EQ.134)SCORE=SCORE+30\r
81e70d48 6190 LDX 206,0 /134\r
84b5715c
PH		 6191 XTA 0\r
6192 FSUB BONUS \r
6193 JNE .+5\r
6194 FLDA #LIT+63\r
6195 FADDM SCORE\r
6196/ IF(BONUS.EQ.133)SCORE=SCORE+45\r
81e70d48 6197 LDX 205,0 /133\r
84b5715c
PH		 6198 XTA 0\r
6199 FSUB BONUS\r
6200 JNE #20020\r
6201 FLDA #LIT+102\r
6202 FADDM SCORE\r
6203/20020 MXSCOR=MXSCOR+45\r
6204#20020, FLDA #LIT+102\r
6205 FADDM MXSCOR\r
6206/C\r
6207/C DID HE COME TO WITT'S END AS HE SHOULD?\r
6208/C\r
6209/ IF(PLACE(MAGZIN).EQ.108)SCORE=SCORE+1\r
6210 FLDA MAGZIN\r
6211 ATX 7\r
81e70d48 6212 LDX 154,0 /108\r
84b5715c
PH		 6213 XTA 0\r
6214 FSUB PLACE-3,7\r
6215 JNE .+5\r
6216 FLDA ONE\r
6217 FADDM SCORE\r
6218/ MXSCOR=MXSCOR+1\r
6219 FLDA ONE\r
6220 FADDM MXSCOR\r
6221/C\r
6222/C ROUND IT OFF.\r
6223/C\r
6224/ SCORE=SCORE+2\r
6225 FLDA TWO\r
6226 FADDM SCORE\r
6227/ MXSCOR=MXSCOR+2\r
6228 FADDM MXSCOR\r
6229/C\r
6230/C DEDUCT POINTS FOR HINTS. HINTS < 4 ARE SPECIAL; SEE DATABASE DESCRIPTION.\r
6231/C\r
6232/ DO 20030 I=1,HNTMAX\r
6233 FLDA ONE\r
6234 FSTA I\r
6235\r
6236/20030 IF(HINTED(I))SCORE=SCORE-HINTS(I,2)\r
6237#20030, FLDA I\r
6238 ATX 7\r
6239 FLDA HINTED-3,7\r
81e70d48
PH		 6240 JEQ .+15\r
6241 FLDA TWO\r
6242 FMUL #LIT+36\r
6243 FADD I\r
84b5715c
PH		 6244 ATX 6\r
6245 FLDA SCORE\r
81e70d48 6246 FSUB HINTS-0077,6\r
84b5715c
PH		 6247 FSTA SCORE\r
6248\r
6249 FLDA I\r
6250 FADD ONE\r
6251 FSTA I\r
6252 FSUB HNTMAX\r
6253 JLE #20030\r
6254/C\r
6255/C RETURN TO SCORE COMMAND IF THAT'S WHERE WE CAME FROM.\r
6256/C\r
6257/ IF(SCORNG)GOTO 8241\r
6258 FLDA SCORNG\r
6259 JNE #8241\r
6260/C\r
6261/C THAT SHOULD BE GOOD ENOUGH. LET'S TELL HIM ALL ABOUT IT.\r
6262/C\r
6263/ TYPE 20100,SCORE,MXSCOR,TURNS\r
81e70d48
PH		 6264 JSR SIXOUT\r
6265 JA .+10\r
84b5715c 6266 JA #20100\r
81e70d48 6267 JA ZERO\r
84b5715c
PH		 6268 JA TWO\r
6269\r
6270 TRAP3 #WRITO\r
6271 JA #LIT\r
6272 JA #2010A\r
6273 FLDA SCORE\r
6274 TRAP3 #RSVO\r
6275 TRAP3 #RENDO\r
6276\r
81e70d48
PH		 6277 JSR SIXOUT\r
6278 JA .+10\r
84b5715c 6279 JA #2010B\r
81e70d48 6280 JA ZERO\r
84b5715c
PH		 6281 JA THREE\r
6282\r
6283 TRAP3 #WRITO\r
6284 JA #LIT\r
6285 JA #2010A\r
6286 FLDA MXSCOR\r
6287 TRAP3 #RSVO\r
6288 TRAP3 #RENDO\r
6289\r
81e70d48
PH		 6290 JSR SIXOUT\r
6291 JA .+10\r
84b5715c 6292 JA #2010C\r
81e70d48 6293 JA ZERO\r
84b5715c
PH		 6294 JA THREE\r
6295\r
6296 TRAP3 #WRITO\r
6297 JA #LIT\r
6298 JA #2010D\r
6299\r
6300 FLDA TURNS\r
6301 TRAP3 #RSVO\r
6302 TRAP3 #RENDO\r
6303\r
81e70d48
PH		 6304 JSR SIXOUT\r
6305 JA .+10\r
84b5715c 6306 JA #2010E\r
81e70d48 6307 JA ZERO\r
84b5715c
PH		 6308 JA ONE\r
6309\r
6310/20100 FORMAT(/' You scored',I4,' out of a possible',I4,\r
6311/ 1 ', using',I5,' turns.')\r
6312/C\r
6313/ DO 20200 I=1,CLSSES\r
6314 FLDA ONE\r
6315 FSTA I\r
6316\r
6317/ IF(CVAL(I).GE.SCORE)GOTO 20210\r
6318#I0064, FLDA I\r
6319 ATX 7\r
6320 FLDA CVAL-3,7\r
6321 FSUB SCORE\r
6322 JGE #20210\r
6323\r
6324/20200 CONTINUE\r
6325#20200, FLDA I\r
6326 FADD ONE\r
6327 FSTA I\r
6328 FSUB CLSSES\r
6329 JLE #I0064\r
6330/ TYPE 20202\r
81e70d48
PH		 6331 JSR SIXOUT\r
6332 JA #25000\r
84b5715c
PH		 6333 JA #20202\r
6334 JA ZERO\r
81e70d48
PH		 6335 JA ZERO\r
6336\r
84b5715c
PH		 6337/20202 FORMAT(' You just went off my scale!!'/)\r
6338/ GOTO 25000\r
84b5715c
PH		 6339\r
6340/C\r
6341/20210 CALL SPEAK(CTEXT(I))\r
6342#20210, FLDA I\r
6343 ATX 7\r
6344 FLDA CTEXT-3,7 /GET CLASS MESSAGE\r
6345 FSTA #TMP+3\r
6346 JSR SPEAK\r
6347 JA .+4\r
6348 JA #TMP+3\r
6349/ IF(I.EQ.CLSSES-1)GOTO 20220\r
6350 FLDA CLSSES\r
6351 FSUB ONE\r
6352 FSUB I\r
6353 JEQ #20220\r
6354/ K=CVAL(I)+1-SCORE\r
6355 FLDA I\r
6356 ATX 7\r
6357 FLDA CVAL-3,7\r
6358 FADD ONE\r
6359 FSUB SCORE\r
6360 FSTA K\r
6361/ TYPE 20212,K\r
81e70d48
PH		 6362 JSR SIXOUT\r
6363 JA .+10\r
84b5715c 6364 JA #20212\r
81e70d48 6365 JA ZERO\r
84b5715c
PH		 6366 JA TWO\r
6367\r
84b5715c
PH		 6368 TRAP3 #WRITO\r
6369 JA #LIT\r
81e70d48 6370 JA #2021A\r
84b5715c
PH		 6371 FLDA K\r
6372 TRAP3 #RSVO\r
6373 TRAP3 #RENDO\r
6374\r
81e70d48
PH		 6375 JSR SIXOUT\r
6376 JA .+10\r
6377 JA #2021B\r
6378 JA ZERO\r
84b5715c
PH		 6379 JA THREE\r
6380 \r
6381/20212 FORMAT(' To achieve the next higher rating, you need',I3,\r
6382/ 1 ' more point',$)\r
6383/ IF(K.EQ.1) TYPE 20213\r
6384 FLDA K\r
6385 FSUB ONE\r
81e70d48
PH		 6386 JNE .+14\r
6387 JSR SIXOUT\r
6388 JA #25000\r
84b5715c 6389 JA #20213\r
81e70d48 6390 JA ZERO\r
84b5715c 6391 JA ONE\r
84b5715c
PH		 6392\r
6393/ IF(K.NE.1) TYPE 20214\r
81e70d48
PH		 6394 JSR SIXOUT\r
6395 JA #25000\r
84b5715c 6396 JA #20214\r
81e70d48 6397 JA ZERO\r
84b5715c
PH		 6398 JA ONE\r
6399/20213 FORMAT('+.'/)\r
6400\r
6401/20214 FORMAT('+s.'/)\r
6402/ GOTO 25000\r
81e70d48 6403\r
84b5715c
PH		 6404/C\r
6405/20220 TYPE 20222\r
81e70d48
PH		 6406#20220, JSR SIXOUT\r
6407 JA .+10\r
84b5715c 6408 JA #20222\r
81e70d48
PH		 6409 JA ZERO\r
6410 JA ZERO\r
6411 JSR SIXOUT\r
6412 JA #GOBAK\r
84b5715c
PH		 6413 JA #20223\r
6414 JA ZERO\r
81e70d48
PH		 6415 JA ZERO\r
6416\r
84b5715c
PH		 6417/20222 FORMAT(' To achieve the next higher rating ',\r
6418/ 1 'would be a neat trick!'/' Congratulations!!'/)\r
6419/ RETURN\r
84b5715c
PH		 6420/ END\r
6421/\r
6422/ Fortran Formats:\r
6423/\r
6424#67A, TEXT %T]HERE ARE @%\r
6425#67, TEXT %('+',I1,$)%\r
6426#67B, TEXT % T]HREATENING LITTLE DWARVES IN THE ROOM WITH YOU.@%\r
6427#68,\r
6428#78, TEXT %(1X,I1,$)%\r
6429#78B, TEXT % ]OF THEM THROW KNIVES AT YOU!@%\r
6430#68B, TEXT % ]OF THEM GET YOU!@%\r
6431#5015, TEXT %W]HAT DO YOU WANT TO DO WITH THE @%\r
6432#5199, TEXT %I] DON'T SEE ANY "@%\r
6433#8002, TEXT %I ]DON'T UNDERSTAND "@%\r
6434#9032, TEXT %O]KAY, "@%\r
6435#8243, TEXT %I]F YOU WERE TO QUIT NOW, YOU WOULD SCORE @%\r
6436#2010A,\r
81e70d48 6437#8243A, TEXT %('+',I4,$)%\r
84b5715c
PH		 6438#8243B, TEXT % ]OUT OF A POSSIBLE @%\r
6439#20213, \r
6440#8243C, TEXT %.@%\r
6441#40012, TEXT %I] AM PREPARED TO GIVE YOU A HINT, BUT IT WILL COST YOU @%\r
6442#4001A, TEXT %('+',I2,$)%\r
6443#4001B, TEXT % ]POINTS.@%\r
6444#20100, TEXT %Y]OU SCORED @%\r
81e70d48 6445#2010B, TEXT % ]OUT OF A POSSIBLE @%\r
84b5715c
PH		 6446#2010C, TEXT % ]USING @%\r
6447#2010D, TEXT %('+',I5,$)%\r
6448#2010E, TEXT % ]TURNS.@%\r
6449#20202, TEXT %Y]OU JUST WENT OFF MY SCALE!!@%\r
81e70d48
PH		 6450#20212, TEXT %T]O ACHIEVE THE NEXT HIGHER RATING, YOU NEED @%\r
6451#2021A, TEXT %('+',I3,$)%\r
6452#2021B, TEXT % ]MORE POINT@%\r
84b5715c 6453#20214, TEXT %]S.@%\r
81e70d48 6454#20222, TEXT %T]O ACHIEVE THE NEXT HIGHER RATING WOULD BE A NEAT TRICK!@%\r
84b5715c
PH		 6455#20223, TEXT %C]ONGRATULATIONS!!@%\r
6456 END\r
My complete PDP-8 universe