10 ; VERB EXECUTORS 20 ; -------------- 30 ; 40 ; ENTRY: Translated noun code in A 50 ; and in NCODE; 60 ; untranslated code in UCODE 70 ; 80 ; TAKE 90 ; ---- 0100 DOTAKE 0110 LDA UCODE 0120 CMP #21 ; is it moveable? 0130 BCS DT0 ; yes 0140 JMP IMPOSS 0150 DT0 0160 LDA NCODE 0170 JSR OWNIT? ; already have it? 0180 BNE DT1 0190 JMP ALREADY 0200 DT1 0210 LDA NCODE 0220 JSR INROOM? ; is it here? 0230 BEQ DT3 0240 JMP NOTHERE 0250 DT3 0260 JSR INVSPACE? ; arms full? 0270 BEQ DT4 0280 JMP ARMSFULL 0290 DT4 0300 LDX ROOMPOS ; get object position 0310 LDY INVPOS ; and inv position 0320 LDA CUROBJS,X ; pick it up 0330 STA HOLDINGS,Y ; add to inventory 0340 LDA #$FF 0350 STA CUROBJS,X ; leave a blank slot 0360 SHOWALL 0370 JSR SHOWVIS ; show room 0380 JSR SHOWINV ; and inventory 0390 JMP POKAY ; done! 0400 ; 0410 ; DROP 0420 ; ---- 0430 DODROP 0440 JSR OWNIT? ; do you have it? 0450 BEQ DD0 0460 JMP DONTHAVE 0470 DD0 0480 JSR ROOMSPACE? ; enough room for it? 0490 BEQ DD1 0500 JMP ROOMFULL 0510 DD1 0520 LDA NCODE 0530 CMP #19 ; robe? 0540 BNE DD2 ; no 0550 LDA #0 0560 STA ROBE ; turn off flag 0570 BEQ DROPIT 0580 DD2 0590 CMP #25 ; dynamite? 0600 BNE DROPIT ; no 0610 LDA PLACE ; keep track of where 0620 STA DPLACE ; the dynamite is 0630 DROPIT 0640 LDX ROOMPOS 0650 LDY INVPOS 0660 LDA HOLDINGS,Y 0670 STA CUROBJS,X 0680 LDA #$FF 0690 STA HOLDINGS,Y 0700 BNE SHOWALL 0710 ; 0720 ; KICK 0730 ; ---- 0740 DOKICK 0750 CMP #1 ; cabinet? 0760 BNE DK1 ; no 0770 LDA PLACE 0780 BNE DK0 0790 LDA CABINET ; already open? 0800 BNE DK1 ; sure is! 0810 LDA #1 0820 STA CABINET ; set flag 0830 PRINT T43 ; "Ouch! But it opens" 0840 JMP GOODPARSE 0850 DK0 0860 JMP NOTHERE 0870 DK1 0880 JMP WHYBOTH 0890 ; 0900 ; LOOK/EXAM 0910 ; --------- 0920 DOLOOK 0930 LDA UCODE 0940 CMP #39 ; button? 0950 BEQ CABC ; yep 0960 CMP #41 ; cord? 0970 BEQ CABC ; yep 1005 LDA NCODE 1010 DLRF1 1015 CMP #22 ; raft? 1020 BNE DOLK1 ; no 1030 LDA PLACE 1040 CMP #2 ; in raft? 1050 BNE DOLK 1060 JMP LK4 1070 DOLK 1080 LDA NCODE 1090 DOLK1 1100 JSR INROOM? ; is it in room? 1110 BEQ LOOKOK 1120 LDA NCODE ; if not, 1130 JSR OWNIT? ; do you have it? 1140 BEQ LOOKOK 1150 JMP NOTHERE ; guess not 1160 LOOKOK 1170 LDA NCODE 1180 CMP #1 ; cabinet? 1190 BNE LK0 1200 LDA CABINET ; already open? 1210 BNE CAB0 ; yep! 1220 PRINT T26 ; "It's stuck" 1230 JMP GOODPARSE 1240 CAB0 1250 LDA RAFTFND ; found raft? 1260 BEQ CAB1 ; nope 1261 CABC 1270 JMP SEEMSORD ; yep 1280 CAB1 1290 JSR ROOMSPACE? ; room for raft? 1300 BEQ CAB2 ; sure is! 1310 JMP ROOMFULL ; guess not 1320 CAB2 1330 PRINT T35 ; "Found something!" 1340 LDA #22 ; raft 1350 STA RAFTFND ; set flag 1360 LDX ROOMPOS 1370 STA CUROBJS,X ; put raft in room 1380 JSR SHOWVIS 1390 JMP GOODPARSE 1400 LK0 1410 CMP #2 ; chest? 1420 BNE LK1 ; no 1430 LDA CHEST ; already open? 1440 BNE CH0 ; yes 1450 PRINT T42 ; "From your boat" 1460 JMP GOODPARSE 1470 CH0 1480 LDA DYNAFND ; found dynamite? 1490 BEQ CH1 ; not yet 1500 JMP SEEMSORD 1510 CH1 1520 JSR ROOMSPACE? ; room for dynamite? 1530 BEQ CH2 ; yep! 1540 JMP ROOMFULL ; no way 1550 CH2 1560 PRINT T35 ; "Found something!" 1570 LDA #25 ; dynamite 1580 STA DYNAFND ; set flag 1590 LDX ROOMPOS 1600 STA CUROBJS,X ; put dynamite in room 1610 JSR SHOWVIS 1620 JMP GOODPARSE 1630 LK1 1640 CMP #15 ; jug? 1650 BNE LK2 ; no 1660 LDA JUG ; already open? 1670 BNE J0 ; yes 1680 PRINT T51 ; "Tightly corked" 1690 JMP GOODPARSE 1700 J0 1710 PRINT T54 ; "Filled with oil" 1720 JMP GOODPARSE 1730 LK2 1740 CMP #14 ; machine? 1750 BNE LK3 ; no 1760 LDA PLACE 1770 CMP #14 ; in stone house? 1780 BNE M0 ; no 1790 PRINT T50 ; "Has a button" 1800 JMP GOODPARSE 1810 M0 1820 CMP #20 ; in secret room? 1830 BNE LK3 ; no 1840 PRINT T62 ; "Has button and slot" 1850 JMP GOODPARSE 1860 LK3 1870 CMP #17 ; wallet 1880 BNE LK4 1890 LDX WALLET ; already looked? 1900 BNE LK4 ; yep 1910 JSR INVSPACE? 1920 BNE WL0 1930 LDA #20 ; photo 1940 STA WALLET ; set flag 1950 LDX INVPOS 1960 STA HOLDINGS,X ; give player the photo 1970 PRINT T35 ;"Found Something!" 1980 JSR SHOWINV 1990 JMP GOODPARSE 2000 WL0 2010 JMP ROOMFULL 2020 LK4 2030 ASL A ; * 2 2040 TAX ; use as an index 2050 LDA LKLK,X ; fetch lsb 2060 INX ; and 2070 LDY LKLK,X ; msb of text addr 2080 JSR EPRINT ; print text 2090 LKX 2100 JMP GOODPARSE ; and exit 2110 ; 2120 ; EXAM TEXT LOOKUP TABLE 2130 ; ---------------------- 2140 LKLK 2150 .WORD T34,T34,T34,T41 2160 .WORD T83,T34,T49,T34 2170 .WORD T34,T34,T52,T34 2180 .WORD T84,T34,T34,T34 2190 .WORD T34,T34,T34,T34 2200 .WORD T68,T60,T36,T34 2210 .WORD T34,T45,T34,T34 2220 .WORD T34,T34,T34,T34 2230 .WORD T34,T34,T34 2240 ; 2250 ; READ 2260 ; ---- 2270 DOREAD 2280 JMP IMPOSS 2290 ; 2300 ; PULL 2310 ; ---- 2320 ; 2330 DOPULL 2340 LDA UCODE 2341 CMP #18 ; door? 2342 BEQ DP2 2350 CMP #41 ; cord? 2360 BNE DP0 ; no 2370 LDA #22 ; raft 2380 JSR OWNIT? 2390 BNE DP1 2400 LDA INFLATE ; already inflated? 2410 BNE DP2 ; yes 2420 LDA #1 2430 STA INFLATE ; set flag 2440 PRINT T37 ; "Raft inflates" 2450 JMP GOODPARSE 2460 DP0 2470 JMP WHYBOTH 2480 DP1 2490 JMP DONTHAVE 2500 DP2 2510 JMP NOTHAP 2520 ; 2530 ; PUSH 2540 ; ---- 2550 DOPUSH 2560 JSR OWNIT? 2570 BNE DPH 2580 JMP WHYBOTH 2590 DPH 2600 LDA PLACE 2610 CMP #14 ; in room 14? 2620 BEQ DPH0 ; yes 2630 CMP #20 ; in room 20? 2640 BEQ DPH1 ; yes 2650 JMP WHYBOTH 2660 DPH0 2670 LDA SACRIF ; sacrifice performed? 2680 BEQ DPH3 ; no 2690 LDA #28 ; goblet 2700 JSR OWNIT? 2710 BNE DPH4 2720 LDA GOBLET ; already filled? 2730 BNE DPH4 ; yes 2740 LDA #1 2750 STA GOBLET ; set flag 2760 PRINT T59 ; "Liquid fills goblet" 2770 JMP GOODPARSE 2780 DPH1 2790 LDA SACRIF ; sacrifice performed? 2800 BEQ DPH3 ; no 2810 LDA DRINK ; drank liquid? 2820 BEQ DPH5 ; nope, trouble! 2830 LDA PAPER ; paper inserted? 2840 BNE DPH2 ; yes 2850 LDA PHOTO ; photo inserted? 2860 BEQ DPH5 ; no, too bad! 2870 JSR FLASH 2880 JSR FLASH 2890 JSR NEWSCREEN 2900 POSITION 13,10 2910 PRINT T86 ; "You are home!" 2920 LDA #$22 2930 STA SDMCTL ; turn on screen 2940 SOLVED 2950 JMP SOLVED 2960 DPH2 2970 JSR FLASH 2980 JSR FLASH 2990 LDA #0 3000 STA PAPER ; turn off flag 3010 LDA #14 3020 JMP EXMOVE 3030 DPH3 3040 JMP NOTHAP 3050 DPH4 3060 PRINT T44 ; "Liquid spills" 3070 JMP GOODPARSE 3080 DPH5 3090 JSR NEWSCREEN 3100 POSITION 8,3 3110 PRINT T76 ; "Blast of energy" 3120 JMP KILLS 3130 ; 3140 ; OPEN 3150 ; ---- 3160 DOOPEN 3170 JSR INROOM? 3180 BEQ OPENOK 3190 LDA NCODE 3200 JSR OWNIT? 3210 BEQ OPENOK 3220 JMP NOTHERE 3230 OPENOK 3240 LDA NCODE 3250 CMP #1 ; cabinet? 3260 BNE OP0 ; no 3262 LDA CABINET ; already open? 3263 BNE OPC ; yep! 3270 PRINT T26 ; "It's stuck" 3280 JMP GOODPARSE 3290 OP0 3300 CMP #2 ; chest? 3310 BNE OP1 ; no 3320 LDX CHEST ; already open? 3330 BEQ CHE1 ; no 3335 OPC 3340 PRINT T80 ; "Already did that!" 3350 JMP BADPARSE 3360 CHE1 3370 STA CHEST ; set flag 3380 PRINT T58 ; "You open it" 3390 JMP GOODPARSE 3400 OP1 3410 CMP #15 ; jug? 3420 BNE OP2 ; no 3430 LDX JUG ; already open? 3440 BEQ JU0 ; no 3450 PRINT T80 ; "Already did that!" 3460 JMP GOODPARSE 3470 JU0 3480 PRINT T53 ; "With what?" 3490 JMP GOODPARSE 3500 OP2 3510 JMP IMPOSS 3520 ; 3530 ; KILL 3540 ; ---- 3550 DOKILL 3560 CMP #4 ; snake? 3570 BNE DKI0 ; no 3580 LDA SNAKE ; already dead? 3590 BNE DKI0 ; yep 3600 LDA #27 ; coconut 3610 JSR OWNIT? 3620 BNE DKI1 3630 LDA #4 ; snake 3640 JSR INROOM? 3650 BNE DKI0 3660 PRINT T47 ; "Coconut clobbers him!" 3670 LDA #23 ; dead snake 3680 LDX ROOMPOS 3690 STA CUROBJS,X ; put in room 3700 STA SNAKE 3710 JSR SHOWVIS 3720 JMP GOODPARSE 3730 DKI0 3740 JMP IMPOSS 3750 DKI1 3760 JSR NEWSCREEN 3770 POSITION 14,3 3780 PRINT T78 ; "Snake bite" 3790 JMP KILLS 3800 ; 3810 ; INSERT 3820 ; ------ 3830 ; 3840 DOINSERT 3850 JSR OWNIT? 3860 BNE DIN2 3870 LDA NCODE 3880 CMP #20 ; photo? 3890 BNE DIN0 ; no 3900 STA PHOTO ; set flag 3910 LDA #0 3920 STA PAPER ; turn off other flag 3930 BEQ DIN1 3940 DIN0 3950 CMP #21 ; paper? 3960 BNE DIN3 3970 STA PAPER ; set flag 3980 DIN1 3990 LDA #$FF 4000 STA HOLDINGS,X ; remove from inv 4010 PRINT T57 ; "Into the slot" 4020 JSR SHOWINV 4030 JMP GOODPARSE 4040 DIN2 4050 JMP DONTHAVE 4060 DIN3 4070 JMP IMPOSS 4080 ; 4090 ; CLIMB 4100 ; ----- 4110 DOCLIMB 4120 CMP #6 ; gate? 4130 BNE DC1 ; no 4140 LDA PLACE 4150 CMP #11 ; in room 11? 4160 BNE DC0 ; no 4170 LDA #12 ; room 12 4180 JMP EXMOVE ; move to new room 4190 DC0 4200 CMP #12 ; in room 12? 4210 BNE DC2 ; nope 4220 LDA #11 ; room 11 4230 JMP EXMOVE ; move to new room 4240 DC1 4250 JMP IMPOSS 4260 DC2 4270 JMP NOTHERE 4280 ; 4290 ; DRINK 4300 ; ----- 4310 ; 4320 DODRINK 4330 LDA UCODE 4340 CMP #43 ; liquid? 4350 BNE DDRK ; no 4360 LDA #28 ; goblet 4370 JSR OWNIT? 4380 BNE DDRK0 4390 LDA GOBLET ; goblet filled? 4400 BEQ DDRK0 ; no 4410 LDA DRINK ; already drank? 4420 BNE DDRK1 ; yep! Trouble! 4430 LDA #4 ; # turns to survive 4440 STA DRINK ; set counter 4450 LDA #0 4460 STA GOBLET ; goblet now empty 4470 PRINT T64 ; "One for the Road!" 4480 JMP GOODPARSE 4490 DDRK 4500 JMP IMPOSS 4510 DDRK0 4520 JMP DONTHAVE 4530 DDRK1 4540 JSR NEWSCREEN 4550 POSITION 11,3 4560 PRINT T32 ; "The strange liquid" 4570 JMP KILLS 4580 ; 4590 ; ROW 4600 ; --- 4610 DOROW 4620 CMP #22 ; raft? 4630 BNE DR0 ; no 4640 LDA #18 ; oars 4650 JSR OWNIT? 4660 BNE DR1 4670 LDA PLACE 4680 CMP #2 ; in raft? 4690 BNE DR0 ; no 4700 LDA #3 ; room 3 4710 JMP EXMOVE 4720 DR0 4730 JMP IMPOSS 4740 DR1 4750 JMP NOTYET 4760 ; 4770 ; POUR 4780 ; ---- 4790 ; 4800 DOPOUR 4810 LDA UCODE 4820 CMP #42 ; oil? 4830 BNE DPR0 ; no 4840 LDA #15 ; jug 4850 JSR OWNIT? 4860 BNE DPR1 4870 LDA JUG ; is it open? 4880 BEQ DPR2 ; no 4890 LDA OIL ; already poured? 4900 BNE DPR3 ; yes 4910 LDA PLACE 4920 CMP #18 ; player in room 18? 4930 BNE DPR4 ; no 4940 STA OIL ; set flag 4950 PRINT T74 ; "On the carcass" 4960 JMP GOODPARSE 4970 DPR0 4980 JMP IMPOSS 4990 DPR1 5000 JMP DONTHAVE 5010 DPR2 5020 JMP NOTYET 5030 DPR3 5040 PRINT T80 ; "Already did that" 5050 JMP BADPARSE 5060 DPR4 5070 PRINT T85 ; "Don't do that here!" 5080 JMP GOODPARSE 5090 ; 5100 ; THROW 5110 ; ----- 5120 DOTHROW 5121 CMP #25 ; dynamite? 5122 BNE DTH 5123 JMP DODROP 5125 DTH 5130 JSR OWNIT? 5140 BNE DTH1 5150 LDA NCODE 5160 CMP #22 ; raft? 5170 BNE DTH0 ; no 5180 LDA PLACE 5190 CMP #1 ; in room 1? 5200 BNE DTH0 ; no 5210 LDA #$FF 5220 STA RAFTIN ; set flag 5230 STA HOLDINGS,X ; remove raft from inv 5240 PRINT T39 ; "Into the ocean" 5250 JSR SHOWINV 5260 JMP GOODPARSE 5270 DTH0 5280 JMP WHYBOTH 5290 DTH1 5300 JMP DONTHAVE 5310 ; 5320 ; WEAR 5330 ; ---- 5340 DOWEAR 5350 CMP #19 ; robe? 5360 BNE DWR1 ; no 5370 LDA ROBE ; already wearing it? 5380 BNE DWR ; yes 5390 LDA NCODE 5400 JSR OWNIT? 5410 BNE DWR0 5420 LDA #1 5430 STA ROBE ; set flag 5440 PRINT T70 ; "You put on the robe" 5450 JMP GOODPARSE 5460 DWR 5470 PRINT T80 ; "Already did that" 5480 JMP BADPARSE 5490 DWR0 5500 JMP DONTHAVE 5510 DWR1 5520 JMP IMPOSS 5530 ; 5540 ; WITH 5550 ; ---- 5560 ; 5570 DOWITH 5580 CMP #16 ; knife 5590 BNE DWTH 5600 JSR OWNIT? 5610 BNE DWTH1 5620 LDA #15 ; jug 5630 JSR OWNIT? 5640 BNE DWTH 5650 LDA JUG ; already open? 5660 BNE DWTH0 ; yes 5670 LDA #1 5680 STA JUG ; set flag 5690 PRINT T58 ; "You open it" 5700 JMP GOODPARSE 5710 DWTH 5720 JMP WHYBOTH 5730 DWTH0 5740 PRINT T80 ; "Already did that" 5750 JMP BADPARSE 5760 DWTH1 5770 JMP NOTYET 5780 ; 5790 ; LIGHT 5800 ; ----- 5810 ; 5820 DOLIGHT 5830 CMP #26 ; match? 5840 BNE DLT2 ; no 5850 JSR OWNIT? 5860 BNE DLT0 5870 LDA MATCNT ; have matches left? 5880 BEQ DLT1 ; all gone 5890 DEC MATCNT ; use 1 match 5900 STA LIT ; set flag 5910 LDA #2 5920 STA LITCNT ; life of burning match 5930 PRINT T88 ; "Don't get burned!" 5940 JMP GOODPARSE 5950 DLT0 5960 JMP DONTHAVE 5970 DLT1 5980 PRINT T79 ; "None left" 5990 JMP GOODPARSE 6000 DLT2 6010 CMP #25 ; dynamite? 6020 BNE DLT4 ; no 6030 JSR INROOM? 6040 BEQ DLT3 6050 LDA #25 6060 JSR OWNIT? 6070 BNE DLT6 6080 DLT3 6090 LDA LIT ; match lit? 6100 BEQ DLT6 ; no 6110 LDA #3 6120 STA BLAST ; set counter 6130 JMP POKAY 6140 DLT4 6150 LDA UCODE 6160 CMP #42 ; oil 6170 BEQ DLTO 6171 CMP #32 ; carcass? 6172 BNE DLT6 6179 DLTO 6180 LDA PLACE 6190 CMP #18 ; in room 18? 6200 BNE DLT6 6210 LDA #23 ; carcass 6220 JSR INROOM? 6230 BNE DLT6 6240 LDA OIL ; oil poured? 6250 BEQ DLT6 6260 LDA LIT ; match lit? 6270 BEQ DLT6 6280 LDA ROBE ; wearing robe? 6290 BEQ DLT7 ; no, too bad! 6300 STA SACRIF ; set flag 6310 PRINT T55 ; "A fiery sacrifice!" 6320 LDA #23 ; carcass 6330 JSR INROOM? 6340 LDA #$FF 6350 STA CUROBJS,X ; get rid of carcass 6360 JSR SHOWVIS 6370 JMP GOODPARSE 6380 DLT5 6390 JMP IMPOSS 6400 DLT6 6410 JMP NOTYET 6420 DLT7 6430 JSR NEWSCREEN 6440 POSITION 6,3 6450 PRINT T75 ; "Blasphemy!" 6460 JMP KILLS 6470 ; 6480 ; LASSO 6490 ; ----- 6500 ; 6510 DOLASSO 6520 CMP #27 ; coconut? 6530 BNE DLA0 ; no 6540 LDA #24 ; rope 6550 JSR OWNIT? 6560 BNE DLA1 6570 LDA PLACE 6580 CMP #6 ; in room 6? 6590 BNE DLA2 ; no 6600 LDA LASSO ; already got one? 6610 BNE DLA3 ; yep 6620 JSR ROOMSPACE? ; someplace to put it? 6630 BNE DLA4 ; all filled up! 6640 LDA #27 ; coconut 6650 STA CUROBJS,X ; put in room 6660 JSR SHOWVIS 6670 JMP POKAY 6680 DLA0 6690 JMP IMPOSS 6700 DLA1 6710 PRINT T53 ; "With what?" 6720 JMP GOODPARSE 6730 DLA2 6740 PRINT T40 ; "Too high" 6750 JMP GOODPARSE 6760 DLA3 6770 JMP WHYBOTH 6780 DLA4 6790 JMP ROOMFULL 6800 ; 6810 ; MOVE 6820 ; ---- 6830 ; 6840 DOMOVE 6850 CMP #12 ; shelves? 6860 BNE DMV ; no 6870 JSR INROOM? 6880 BNE DMV0 6890 LDA SHELVES ; already moved? 6900 BNE DMV1 ; yep 6910 JSR ROOMSPACE? 6920 BNE DMV2 6930 LDA #13 ; secret doorway 6940 STA SHELVES ; set flag 6950 STA CUROBJS,X ; put door in room 6960 PRINT T35 ; "Found something!" 6970 LDA #20 ; new room vector 6980 STA CURVECT+1 ; add new exit 6990 JSR SHOWVECTS 7000 JSR SHOWVIS 7010 JMP GOODPARSE 7020 DMV 7030 JMP IMPOSS 7040 DMV0 7050 JMP NOTHERE 7060 DMV1 7070 JMP WHYBOTH 7080 DMV2 7090 JMP ROOMFULL 7100 ; 7110 IMPOSS 7120 PRINT T17 ; "That's impossible." 7130 BNE GOODPARSE 7140 ; 7150 NOTYET 7160 PRINT T23 ; "You can't do that yet." 7170 BNE GOODPARSE 7180 ; 7190 ARMSFULL 7200 PRINT T24 ; "You're carrying too much!" 7210 BNE BADPARSE 7220 ; 7230 ROOMFULL 7240 PRINT T25 ; "Not enough room here." 7250 BNE BADPARSE 7260 ; 7270 NOTHERE 7280 PRINT T22 ; "It isn't here." 7290 BNE BADPARSE 7300 ; 7310 ALREADY 7320 PRINT T21 ; "You already have it." 7330 BNE BADPARSE 7340 ; 7350 DONTHAVE 7360 PRINT T27 ; "You don't have it." 7370 BNE BADPARSE 7380 ; 7390 ; 7400 WHYBOTH 7410 PRINT T33 ; "Why bother?" 7420 BNE GOODPARSE 7430 ; 7440 SEEMSORD 7450 PRINT T34 ; "Seems ordinary." 7460 BNE GOODPARSE 7470 ; 7480 NOTHAP 7490 PRINT T56 ; "Nothing happens." 7500 BNE GOODPARSE 7510 ; 7520 GOODPARSE 7530 JSR BEEP 7540 JMP NEXTEVENT 7550 ; 7560 BADPARSE 7570 JSR BOOP 7580 JMP PARSER 7590 ; 7600 ; SUBROUTINES 7610 ; ----------- 7620 ; 7630 ; DLI ROUTINE 7640 ; ----------- 7650 DLI 7660 PHA ; save A, 7670 TXA 7680 PHA ; X 7690 TYA ; and 7700 PHA ; Y registers 7710 LDX DLICOL ; fetch color index 7720 LDA DCOLS,X ; fetch new color 7730 LDY CURSES,X ; and cursor shape 7740 STA WSYNC ; wait for scan 7750 STA COLPF2 ; change color 7760 STY GRAFP0 ; and player shape 7770 INC DLICOL ; update index 7780 PLA 7790 TAY ; restore Y, 7800 PLA ; X 7810 TAX ; and 7820 PLA ; A registers 7830 RTI ; back to mainline 7840 ; 7850 DCOLS 7860 .BYTE $70,$60,$70,$60,$70,$00,$60 7870 CURSES 7880 .BYTE $00,$00,$00,$00,$00 7890 CURSOR 7900 .BYTE $00,$00 7910 ; 7920 ; PRINT MACRO SUBROUTINE 7930 ; ---------------------- 7940 ; ENTRY: Addr of EOL-terminated string 7950 ; in A/Y registers (LSB/MSB). 7960 ; 7970 EPRINT 7980 LDX #0 ; IOCB #0 (E:) 7990 STA ICBADR ; lsb of string addr 8000 STY ICBADR+1 ; msb of string addr 8010 LDA #$09 ; PUT LINE command 8020 STA ICCOM 8030 LDA #$7F 8040 STA ICBLEN ; lsb max string length 8050 STX ICBLEN+1 ; msb (0) 8060 JMP CIOV 8070 ; 8080 ; POSITION MACRO ROUTINE 8090 ; ---------------------- 8100 ; ENTRY: X-pos in X, Y-pos in Y. 8110 ; 8120 POSIT13 8130 LDX #13 8140 POSIT 8150 STX COLCRS 8160 STY ROWCRS 8170 RTS 8180 ; 8190 ; AUDIO PROMPTS 8200 ; ------------- 8210 BEEP 8220 LDA #25 ; high tone 8230 BNE BTONE 8240 ; 8250 BOOP 8260 LDA #100 ; low tone 8270 BTONE 8280 STA AUDF1 8290 LDA #$AA ; dist/vol = 10 8300 STA AUDC1 8310 LDA #0 8320 STA RTCLOK 8330 SOUND 8340 LDA RTCLOK 8350 CMP #5 ; 5 jiffies 8360 BNE SOUND 8370 LDX #0 8380 STX AUDC1 ; silence! 8390 DEX 8400 STX CH ; clear last key 8410 RTS 8420 ; 8430 ; ERASE A STATUS LINE 8440 ; ------------------- 8450 ; ENTRY: Target line (0-18) in X. 8460 ; 8470 ERASE 8480 LDA LADRSL,X ; lsb of line addr 8490 STA CLPOINT 8500 LDA LADRSH,X ; msb of addr 8510 STA CLPOINT+1 8520 LDY #24 ; clear 25 characters 8530 LDA #0 8540 CLLOOP 8550 STA (CLPOINT),Y 8560 DEY 8570 BPL CLLOOP 8580 RTS 8590 ; 8600 ; INIT SCREEN 8610 ; ----------- 8620 NEWSCREEN 8630 LDA #$40 8640 STA NMIEN 8650 STA RAMTOP ; set system to 16K 8660 ; 8670 ; Close IOCB #0 (E:) 8680 ; 8690 LDX #0 ; IOCB #0 (E:) 8700 LDA #$0C ; CLOSE command 8710 STA ICCOM 8720 JSR CIOV ; slam! 8730 ; 8740 ; Re-open E: with new RAM size 8750 ; 8760 LDX #0 ; E: again 8770 STX ICAUX2 ; zero this byte 8780 LDA #3 ; OPEN command 8790 STA ICCOM 8800 LDA # EADR 8830 STA ICBADR+1 8840 LDA #$0C ; allow read/write 8850 STA ICAUX1 8860 JSR CIOV ; do the OPEN 8870 ; 8880 LDA #0 8890 STA DMACTL 8900 STA SDMCTL ; shut off ANTIC 8910 STA GRAFP0 8920 STA GRAFP1 8930 STA GRAFP2 8940 STA GRAFP3 ; blank out borders 8950 ; 8960 LDX #8 ; all colors black 8970 COLOFF 8980 STA PCOLR0,X 8990 DEX 9000 BPL COLOFF 9010 LDA #14 9020 STA COLOR1 ; except text 9030 LDA #$74 9040 STA COLOR0 9050 ; 9060 LDX #1 9070 STX CRSINH ; disable system cursor 9080 INX ; = 2 9090 STX LMARGN ; fix margin 9100 LDA #$70 9110 STA POKMSK 9120 STA IRQEN ; disable BREAK key 9130 LDA # >NEWSET ; addr char set 9140 STA CHBAS ; point to char set 9150 RTS ; and return 9160 ; 9170 ; FLASH ROUTINE 9180 ; ------------- 9190 ; 9200 FLASH 9210 LDA #0 ; black 9220 LP1 JSR CLRCHG ; change colors 9230 LDX #$FF ; delay loop 9240 LP2 DEX 9250 BNE LP2 9260 CLC 9270 ADC #1 ; next color 9280 BEQ FLH ; all done 9290 BNE LP1 ; change colors again 9300 FLH 9310 STA DRINK ; turn off counter 9320 LDX PLACE ; get current room # 9330 JSR CHGCLR ; restore screen colors 9340 RTS 9350 ; 9360 ; EXPLOSION ROUTINE 9370 ; ----------------- 9380 ; 9390 BOOM 9400 LDA #150 9410 STA AUDF1 9420 LDA #$4A 9430 SND 9440 STA AUDC1 9450 LDX #0 9460 STX RTCLOK 9470 SND0 9480 LDX RTCLOK 9490 CPX #10 9500 BNE SND0 9510 SEC 9520 SBC #$01 9530 CMP #$40 9540 BNE SND 9550 LDA #0 9560 STA AUDC1 9570 RTS 9580 ; 9590 CLRCHG 9600 LDY #0 ; y is index 9610 NXCLR STA $02C1,Y ; change color 9620 INY ; point to next register 9630 CPY #8 ; done? 9640 BNE NXCLR ; no 9650 RTS 9660 ; 9670 ; SET SCREEN COLORS 9680 ; ----------------- 9690 ; 9700 CHGCLR 9710 LDA RMCOLS,X ; get room color 9720 STA COLOR2 ; set colors 9730 STA COLOR4 9740 STA PCOLR1 9750 STA PCOLR2 9760 STA PCOLR3 9770 LDA #14 ; white 9780 STA COLOR1 ; text color 9790 STA PCOLR0 ; cursor color 9800 LDA #$74 9810 STA COLOR0 9820 RTS 9830 ; 9840 ; color table for rooms 9850 ; 9860 RMCOLS 9870 .BYTE $34,$34,$72,$08,$08,$08,$C6,$C6 9880 .BYTE $C6,$04,$00,$14,$20,$20,$A6,$20 9890 .BYTE $64,$56,$64,$56,$56,$36 9900 ; BLANK BAR 9910 ; --------- 9920 BAR 9930 PRINT T9 9940 RTS 9950 ; 9960 ; "WHAT" BAR 9970 ; --------- 9980 SAYWHAT 9990 PRINT T10 010000 RTS 010010 ; 010020 ; KEYBOARD INPUT HANDLER 010030 ; ---------------------- 010040 ; These routines are based in part on 010050 ; Steve Howard's "Alternative Keyboard Handler" 010060 ; (ANALOG Computing #15, pp. 96-103). 010070 ; 010080 ; FETCH A KEYPRESS 010090 ; ---------------- 010100 GETKEY 010110 LDA CH 010120 CMP #$FF ; key pressed? 010130 BEQ GETKEY ; not yet - keep scanning 010140 ; 010150 ; Analyze keycode 010160 ; 010170 ANALYZE 010180 TAY ; save key for later 010190 LDX #$FF 010200 STX CH ; reset key 010210 AND #$C0 ; bit 6 or 7 set? 010220 BEQ LEGAL? ; nope 010230 ; 010240 ; Handle a bad keypress 010250 ; 010260 BADKEY 010270 JSR BOOP ; razz user and 010280 JMP GETKEY ; try again 010290 ; 010300 ; Look for illegal keys 010310 ; 010320 LEGAL? 010330 TYA ; restore keycode 010340 LDX #13 010350 KLOOP 010360 CMP ILLEGAL,X 010370 BEQ BADKEY ; razz if illegal key 010380 DEX 010390 BPL KLOOP 010400 ; 010410 ; Get ATASCII equivalent 010420 ; 010430 LDA ATASCI,Y 010440 ; 010450 ; Screen out numbers, pass EOL and BS 010460 ; 010470 CMP #SPACE ; space bar? 010480 BEQ CLK1 ; that's okay 010490 CMP #EOL ; RETURN? 010500 BEQ CLK1 ; fine by me 010510 CMP #$7E ; backspace? 010520 BEQ CLK1 ; love 'em 010530 CMP #'a 010540 BCC BADKEY 010550 CLD 010560 SEC 010570 SBC #$20 ; convert to upper case 010580 ; 010590 ; Click the speaker 010600 ; 010610 CLK1 010620 LDY #$7F 010630 STY CLICK 010640 CLK2 010650 LDY CLICK 010660 STY CONSOL ; tick! 010670 LDX #8 ; click freq 010680 DELAY 010690 DEX 010700 BPL DELAY 010710 DEC CLICK 010720 BPL CLK2 ; 128 times 010730 ; 010740 RTS ; ATASCII code in A 010750 ; 010760 ; ILLEGAL KEYS 010770 ; ------------ 010780 ILLEGAL 010790 .BYTE $1C ; escape 010800 .BYTE $2C ; tab 010810 .BYTE $27 ; atari 010820 RTS 010830 .BYTE $3C ; caps 010840 .BYTE $36 ; < 010850 .BYTE $37 ; > 010860 .BYTE $0F ; = 010870 .BYTE $20 ; , 010880 .BYTE $02 ; ; 010890 .BYTE $22 ; . 010900 .BYTE $26 ; / 010910 .BYTE $06 ; + 010920 .BYTE $07 ; * 010930 .BYTE $0E ; - 010940 ; 010950 ; ATASCII CONVERSION TABLE 010960 ; ------------------------ 010970 ; We use our own table because the 010980 ; location of the ROM-based table varies 010990 ; depending on which computer you have. 011000 ; 011010 ATASCI 011020 .BYTE $6C,$6A,$3B,$8A,$8B,$6B,$2B,$2A 011030 .BYTE $6F,$80,$70,$75,$9B,$69,$2D,$3D 011040 .BYTE $76,$80,$63,$8C,$8D,$62,$78,$7A 011050 .BYTE $34,$80,$33,$36,$1B,$35,$32,$31 011060 .BYTE $2C,$20,$2E,$6E,$80,$6D,$2F,$81 011070 .BYTE $72,$80,$65,$79,$7F,$74,$77,$71 011080 .BYTE $39,$80,$30,$37,$7E,$38,$3C,$3E 011090 .BYTE $66,$68,$64,$80,$82,$67,$73,$61 011100 ; 011110 ; INTERNAL CONVERSION TABLE 011120 ; ------------------------- 011130 INTATA 011140 .BYTE $20,$40,$00,$60 011150 ; 011160 ; Y-OFFSET TABLES 011170 ; --------------- 011180 ; These two tables contain the 011190 ; starting address of each status line 011200 ; (absolute screen line address + 13). 011210 ; LADRSL holds the LSBs, LADRSH the MSBs. 011220 ; 011230 LADRSL 011240 .BYTE SCREEN+53, >SCREEN+53, >SCREEN+93, >SCREEN+133 011310 .BYTE >SCREEN+173, >SCREEN+213, >SCREEN+253, >SCREEN+293 011320 .BYTE >SCREEN+333, >SCREEN+373, >SCREEN+413, >SCREEN+453 011330 .BYTE >SCREEN+493, >SCREEN+533, >SCREEN+573, >SCREEN+613 011340 .BYTE >SCREEN+653, >SCREEN+693, >SCREEN+733 011350 ; 011360 ; FETCH INPUT LINE 011370 ; ---------------- 011380 GETLINE 011390 ; 011400 ; Clear line input buffer 011410 ; 011420 CLD 011430 LDX #24 011440 LDA #SPACE 011450 CLINL 011460 STA INLINE,X 011470 DEX 011480 BPL CLINL 011490 ; 011500 ; Get first character of line 011510 ; 011520 GETONE 011530 POSITION 13,12 011540 LDX #$FF 011550 STX CURSEN ; turn on PMG cursor 011560 STX CH ; clear key 011570 INX 011580 STX LENGTH ; zero line length 011590 JSR GETKEY ; fetch a keycode 011600 CMP #SPACE ; first char not be 011610 BEQ BADONE ; a space 011620 CMP #$7E ; a backspace 011630 BEQ BADONE 011640 CMP #EOL ; or an EOL 011650 BNE PUT1 011660 ; 011670 ; Handle bad first character 011680 ; 011690 BADONE 011700 JSR BOOP ; razz user and 011710 JMP GETONE ; try again 011720 ; 011730 ; Print 1st char 011740 ; 011750 PUT1 011760 JSR SETCIO ; to E: 011770 JSR CIOV 011780 INC LENGTH 011790 ; 011800 ; Get rest of input line 011810 ; 011820 REST 011830 JSR GETKEY ; grab another keycode 011840 CMP #EOL ; if it's an EOL, 011850 BEQ GOTEOL ; line entry complete 011860 CMP #$7E ; backspace? 011870 BNE PUTNEXT ; no - send to screen 011880 ; 011890 ; Handle a backspace 011900 ; 011910 BACKS 011920 DEC LENGTH ; if 1st char of line 011930 BMI BADONE ; signal error 011940 JSR SETCIO ; E: 011950 JSR CIOV ; let CIO do backspace 011960 LDA LENGTH ; if length=0, 011970 BEQ GETONE ; handle as 1st char 011980 BNE REST ; else continue 011990 ; 012000 ; Print latest character 012010 ; 012020 PUTNEXT 012030 JSR SETCIO 012040 JSR CIOV ; print character 012050 INC LENGTH ; next position 012060 LDA LENGTH 012070 CMP #24 ; end of line? 012080 BCC REST ; not yet - get another key 012090 ; 012100 ; Too many chars in line! 012110 ; 012120 GETLAST 012130 JSR BOOP ; a warning razz 012140 JSR GETKEY 012150 CMP #EOL ; must have an EOL 012160 BEQ GOTEOL 012170 CMP #$7E ; or a backspace 012180 BEQ BACKS 012190 BNE GETLAST ; insist! 012200 ; 012210 ; EOL recieved 012220 ; 012230 GOTEOL 012240 JSR SETCIO ; specify E: 012250 STX CURSEN ; shut off cursor 012260 JSR CIOV ; and send EOL 012270 ; 012280 ; Convert screen bytes to ATASCII 012290 ; and move to INLINE 012300 ; 012310 LDY #24 012320 TOBUFF 012330 CLC 012340 LDA SCREEN+493,Y ; grab screen byte 012350 STA SCREEN+453,Y ; move to upper line 012360 ROL A 012370 ROL A 012380 ROL A 012390 ROL A 012400 AND #3 ; transform byte, and 012410 TAX ; use as an index 012420 LDA SCREEN+453,Y ; restore original value 012430 AND #$1F ; clear bits 5-7 012440 ORA INTATA,X ; merge with code table 012450 STA INLINE,Y ; send to buffer 012460 LDA #0 012470 STA SCREEN+493,Y ; clear response line 012480 DEY 012490 BPL TOBUFF 012500 RTS 012510 ; 012520 ; IMMEDIATE VBI ROUTINE 012530 ; --------------------- 012540 ; Positions and blinks cursor, 012550 ; resets DLI color index 012560 ; 012570 IMMVBI 012580 ; 012590 ; Reset DLI color index 012600 ; 012610 LDA #0 012620 STA DLICOL 012630 ; 012640 ; Okay to update cursor? 012650 ; 012660 LDA CURSEN ; if enable flag = 0, 012670 BEQ VEXIT ; don't redraw cursor 012680 ; 012690 ; Calculate cursor X-position: 012700 ; XNEW = ( XOLD * 4 ) + 48 012710 ; 012720 CLD 012730 LDA COLCRS 012740 ASL A 012750 ASL A ; times 4 012760 CLC 012770 ADC #48 ; plus 48 012780 STA HPOSP0 ; use as h-pos 012790 ; 012800 ; Don't blink cursor if a key 012810 ; is being pressed. 012820 ; 012830 LDA SRTIMR ; 0 = no press 012840 BEQ BLINK? 012850 ; 012860 LDA #$F0 012870 STA CURSOR 012880 STA CSHAPE ; force cursor on 012890 LDA #60 ; for at least 012900 STA BLINK ; 1 second 012910 ; 012920 BLINK? 012930 LDA CSHAPE 012940 DEC BLINK ; next jiffy 012950 BNE VEXIT ; don't blink until 0 012960 ; 012970 ; Blink the cursor 012980 ; 012990 LDY #30 013000 STY BLINK ; reset timer 013010 EOR #$F0 ; flip the cursor shape 013020 STA CSHAPE ; and save it for later 013030 VEXIT 013040 STA CURSOR ; plot the cursor 013050 JMP SYSVBV ; sayonara 013060 ; 013070 ; DISPLAY EVENT COUNTER 013080 ; --------------------- 013090 SHOWEV 013100 ; 013110 ; Initialize EBUFF 013120 ; 013130 LDA #'0 013140 STA EBUFF 013150 STA EBUFF+1 013160 STA EBUFF+2 013170 LDA #EOL 013180 STA EBUFF+4 013190 ; 013200 ; Convert event # to ATASCII 013210 ; 013220 ECON 013230 LDA EVENT 013240 STA FR0 013250 LDA EVENT+1 013260 STA FR0+1 013270 JSR IFP ; convert to floating point 013280 JSR FASC ; then to ATASCII 013290 CLD 013300 ; 013310 ; Determine length of number 013320 ; 013330 LDY #$FF ; init loop index 013340 FINDE 013350 INY 013360 LDA (INBUFF),Y ; check characters 013370 BPL FINDE 013380 ; 013390 ; Change # to inverse video and 013400 ; move to EBUFF 013410 ; 013420 LDX #3 ; move 3 chars maximum 013430 TOEB 013440 LDA (INBUFF),Y 013450 ORA #$80 ; set msb 013460 STA EBUFF,X ; put in EBUFF 013470 DEX 013480 DEY 013490 BPL TOEB 013500 ; 013510 ; Display contents of EBUFF 013520 ; 013530 POSITION 33,0 013540 PRINT EBUFF 013550 RTS 013560 ; 013570 ; SET CIO TO PUT CHAR MODE 013580 ; ------------------------ 013590 SETCIO 013600 LDX #$0B 013610 STX ICCOM 013620 LDX #0 013630 STX ICBLEN 013640 STX ICBLEN+1 013650 RTS 013660 ;