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