10 ; ------------------------ 20 ; ONE FOR THE ROAD 30 ; by Clayton Walnum 40 ; ANALOG Computing # 50 ; (C)1985 ANALOG Computing 60 ; ------------------------ 70 ; 80 ; MACRO DEFINITIONS 90 ; ----------------- 0100 ; 0110 ; POSITION MACRO 0120 ; -------------- 0130 ; SYNTAX: 0140 ; POSITION xpos,ypos 0150 ; 0160 .MACRO POSITION 0170 .IF %0<>2 .OR %1>39 .OR %2>23 0180 .ERROR "POS parameters" 0190 .ELSE 0200 .IF %1=13 0210 LDY #%2 0220 JSR POSIT13 0230 .ELSE 0240 LDX #%1 0250 LDY #%2 0260 JSR POSIT 0270 .ENDIF 0280 .ENDIF 0290 .ENDM 0300 ; 0310 ; PRINT MACRO 0320 ; ----------- 0330 ; SYNTAX: 0340 ; PRINT 0350 ; 0360 .MACRO PRINT 0370 .IF %0<>1 0380 .ERROR "PRINTE parameters" 0390 .ELSE 0400 LDA # <%1 0410 LDY # >%1 0420 JSR EPRINT 0430 .ENDIF 0440 .ENDM 0450 ; 0460 ; TEXT MACRO 0470 ; ---------- 0480 ; SYNTAX: 0490 ; TEXT <"string"> 0500 ; 0510 .MACRO TEXT 0520 .IF %0<>1 .OR %1>127 0530 .ERROR "TEXT parameters" 0540 .ELSE 0550 .BYTE %$1,EOL 0560 .ENDIF 0570 .ENDM 0580 ; 0590 ; SYSTEM EQUATES 0600 ; --------------- 0610 ; 0620 ; ZERO-PAGE 0630 ; --------- 0640 BOOT? = $09 ; OS boot flag 0650 POKMSK = $10 ; interrupt mask 0660 RTCLOK = $14 ; system clock 0670 LMARGN = $52 ; left margin 0680 RMARGN = $53 ; right margin 0690 ROWCRS = $54 ; cursor row 0700 COLCRS = $55 ; cursor column 0710 RAMTOP = $6A ; # pages of RAM 0720 FR0 = $D4 ; floating point register 0730 CIX = $F2 ; FP index register 0740 INBUFF = $F3 ; FP pointer 0750 ; 0760 ; PAGES 2-3 0770 ; --------- 0780 VDSLST = $0200 ; DLI vector 0790 SRTIMR = $022B ; key repeat timer 0800 SDMCTL = $022F ; DMA control 0810 SDLSTL = $0230 ; D-list addr 0820 COLDST = $0244 ; coldstart flag 0830 GPRIOR = $026F ; PMG priority 0840 PCOLR0 = $02C0 ; player 0 color 0850 PCOLR1 = $02C1 ; player 1 color 0860 PCOLR2 = $02C2 ; player 2 color 0870 PCOLR3 = $02C3 ; player 3 color 0880 COLOR0 = $02C4 ; playfield 0 color 0890 COLOR1 = $02C5 ; playfield 1 color 0900 COLOR2 = $02C6 ; playfield 2 color 0910 COLOR4 = $02C8 ; background color 0920 CRSINH = $02F0 ; cursor inhibit 0930 CHBAS = $02F4 ; adr of char set 0940 CH = $02FC ; keypress register 0950 ICCOM = $0342 ; CIO command 0960 ICBADR = $0344 ; CIO addr 0970 ICBLEN = $0348 ; CIO length 0980 ICAUX1 = $034A ; AUX byte 1 0990 ICAUX2 = $034B ; AUX byte 2 1000 ; 1010 ; CTIA/GTIA 1020 ; --------- 1030 HPOSP0 = $D000 ; h-pos player 0 1040 HPOSP1 = $D001 ; " " 1 1050 HPOSP2 = $D002 ; " " 2 1060 HPOSP3 = $D003 ; " " 3 1070 SIZEP0 = $D004 ; width player 0 1080 SIZEP1 = $D009 ; " " 1 1090 SIZEP2 = $D00A ; " " 2 1100 SIZEP3 = $D00B ; " " 3 1110 GRAFP0 = $D00D ; graphics player 0 1120 GRAFP1 = $D00E ; " " 1 1130 GRAFP2 = $D00F ; " " 2 1140 GRAFP3 = $D010 ; " " 3 1150 COLPF2 = $D018 ; color register 2 1160 CONSOL = $D01F ; console keys 1170 ; 1180 ; POKEY 1190 ; ----- 1200 AUDF1 = $D200 ; frequency channel 1 1210 AUDC1 = $D201 ; vol/dist channel 1 1220 AUDCTL = $D208 ; audio control 1230 RANDOM = $D20A ; random # generator 1240 IRQEN = $D20E ; interrupt enable 1250 ; 1260 ; ANTIC 1270 ; ----- 1280 DMACTL = $D400 ; DMA control 1290 WSYNC = $D40A ; wait for horz sync 1300 NMIEN = $D40E ; NMI enable 1310 ; 1320 ; FLOATING POINT 1330 ; -------------- 1340 FASC = $D8E6 ; FP-to-ATASCII 1350 IFP = $D9AA ; integer-to-FP 1360 ZFR0 = $DA44 ; clear FR0 1370 ; 1380 ; OS ROUTINES 1390 ; ----------- 1400 CIOV = $E456 ; CIO entry 1410 SETVBV = $E45C ; set v-blank vector 1420 SYSVBV = $E45F ; OS VBI entry 1430 SIOINV = $E465 ; SIO init 1440 ; 1450 ; INTERNAL EQUATES 1460 ; ---------------- 1470 ; 1480 ; MEMORY ALLOCATION 1490 ; ----------------- 1500 INLINE = $0600 ; text input buffer 1510 GAMEDATA = $3AC0 ; working area 1520 EDLIST = $3C20 ; start of E: display list 1530 SCREEN = $3C40 ; start of screen RAM 1540 ; 1550 ; Game play database 1560 ; 1570 *= GAMEDATA 1580 ; 1590 EVENT *= *+2 ; event # 1600 PLACE *= *+1 ; location 1610 CABINET *= *+1 ; cabibet opened 1620 RAFTIN *= *+1 ; raft in the water 1630 INFLATE *= *+1 ; raft inflated? 1640 CHEST *= *+1 ; chest open? 1650 JUG *= *+1 ; jug open? 1660 ROBE *= *+1 ; wearing robe? 1670 SACRIF *= *+1 ; sacrifice performed? 1680 GOBLET *= *+1 ; goblet filled? 1690 SHELVES *= *+1 ; shelves moved? 1700 DRINK *= *+1 ; liquid consumed? 1710 PAPER *= *+1 ; paper inserted? 1720 PHOTO *= *+1 ; photo inserted? 1730 DPLACE *= *+1 ; location of dynamite 1740 OIL *= *+1 ; oil poured? 1750 LIT *= *+1 ; match lit? 1760 MATCNT *= *+1 ; # of matches 1770 CHECNT *= *+1 ; chest turn counter 1780 WALLET *= *+1 1790 ROCKCNT *= *+1 ; hit rocks counter 1800 CORD *= *+1 ; cord pulled? 1810 RAFTFND *= *+1 ; raft found? 1820 DYNAFND *= *+1 ; dynamite found? 1830 SNAKE *= *+1 ; snake dead? 1840 LASSO *= *+1 ; got coconut? 1850 LITCNT *= *+1 ; match counter 1860 BLAST *= *+1 ; dynamite lit? 1870 HOLDINGS *= *+6 ; current inventory 1880 VECTORS *= *+132 ; current vector table 1890 OBJECTS *= *+132 ; current object table 1900 NTRANS *= *+38 ; current translation matrix 1910 ; 1920 ; MISCELLANEOUS 1930 ; ------------- 1940 EOL = $9B 1950 SPACE = $20 1960 SETPNT = $CD 1970 OFFCNT = $CF 1980 NEWSET = $4400 1990 ROMSET = $E000 2000 ; 2010 ; ZERO-PAGE 2020 ; --------- 2030 *= $80 2040 ; 2050 ; Cursor control 2060 ; 2070 CURSEN *= *+1 ; cursor on/off flag 2080 CSHAPE *= *+1 ; current cursor shape 2090 BLINK *= *+1 ; cursor blink timer 2100 ; 2110 ; Keyboard handler 2120 ; 2130 CLICK *= *+1 ; key click counter 2140 LENGTH *= *+1 ; line length register 2150 ; 2160 ; DLI control 2170 ; 2180 DLICOL *= *+1 ; DLI color index 2190 ; 2200 ; Screen clearing 2210 ; 2220 CLPOINT *= *+2 ; screen clear pointer 2230 CINDEX *= *+1 ; window clear index 2240 ; 2250 ; Parser 2260 ; 2270 PBUFF *= *+3 ; parsing buffer 2280 PDEX *= *+1 ; scanning index 2290 LBREAK *= *+1 ; pos. of space char 2300 VCODE *= *+1 ; verb code # 2310 UCODE *= *+1 ; untranslated noun code # 2320 NCODE *= *+1 ; translated noun code # 2330 DOVECT *= *+2 ; verb execution vector 2340 CURVECT *= *+6 ; current room vectors 2350 CUROBJS *= *+6 ; current room objects 2360 NEWPLACE *= *+1 ; next room code # 2370 VPNT *= *+2 ; addr of current v-buffer 2380 OPNT *= *+2 ; addr of current o-buffer 2390 INVPOS *= *+1 ; position in inventory buffer 2400 ROOMPOS *= *+1 ; position in room buffer 2410 ANY? *= *+1 ; flag for empty room/inv 2420 VLAST *= *+1 ; last verb 2430 ULAST *= *+1 ; last noun 2440 ; 2450 ; Event counter 2460 ; 2470 EBUFF *= *+5 ; printing buffer 2480 ; 2490 ; INITIALIZATION 2500 ; -------------- 2510 ; 2520 *= $1F80 2530 ; 2540 ENTRY 2550 LDX #0 2560 STX COLDST 2570 INX ; = 1 2580 STX BOOT? 2590 JSR MOVESET ; redefine char set 2600 JSR SIOINV ; for sound init 2610 JMP TITLE 2620 ; 2630 ; CUSTOM DISPLAY LIST 2640 ; ------------------- 2650 DLIST 2660 .BYTE $70,$70,$70,$70 ; blank 32 lines 2670 .BYTE $42, SCREEN ; text w/LMS 2680 .BYTE $90,$10 ; blank 4 w/DLI 2690 .BYTE $02 ; text (location) 2700 .BYTE $90,$10 ; blank 4 w/DLI 2710 .BYTE $02 ; text (exits) 2720 .BYTE $90,$10 ; blank 4 w/DLI 2730 .BYTE $02,$02,$02,$02,$02,$02 ; text (v-items) 2740 .BYTE $90,$10 ; blank 4 w/DLI 2750 .BYTE $02,$02 ; text (events) 2760 .BYTE $90,$10 ; blank 4 w/DLI 2770 .BYTE $02,$02 ; text (response) 2780 .BYTE $80,$80,$10 ; blank 4 w/DLIs 2790 .BYTE $02,$02,$02,$02,$02,$02 ; text (i-items) 2800 .BYTE $70 ; blank 8 2810 .BYTE $41, DLIST ; JVB 2820 ; 2830 ; TITLE SCREEN 2840 ; ------------ 2850 TITLE 2860 LDX #$FF 2870 TXS 2880 JSR NEWSCREEN ; reset E: 2890 POSITION 12,6 2900 PRINT T0 ; "Clayton Walnum's" 2910 POSITION 22,7 2920 PRINT T1 ; "ONE FOR THE ROAD" 2930 POSITION 8,9 2940 PRINT T2 ; "(C)1985 ANALOG Computing" 2950 ; 2960 STARTOP 2970 POSITION 5,16 2980 PRINT T3 ; "Press START to play new game" 2990 POSITION 3,18 3000 PRINT T4 ; "Press OPTION to restore old game" 3010 ; 3020 LDA #6 3030 STA EDLIST+12 ; modify 3040 STA EDLIST+13 ; display list 3050 ; 3060 LDA #$22 3070 STA SDMCTL ; restore screen 3080 JSR BEEP 3090 ; 3100 ; Wait for selection 3110 ; 3120 POLL 3130 LDA CONSOL 3140 CMP #7 ; scan until a 3150 BEQ POLL ; key is pressed 3160 LETGO 3170 LDX CONSOL 3180 CPX #7 3190 BNE LETGO 3200 CMP #6 ; START pressed? 3210 BEQ NEWGAME ; yes, do a new game 3220 CMP #3 ; OPTION pressed? 3230 BEQ RESTORE ; yes, restore old game 3240 BADPOLL 3250 JSR BOOP ; else 3260 JMP POLL ; resume scan 3270 ; 3280 ; Start new game 3290 ; 3300 NEWGAME 3310 JSR INITDATA 3320 JMP PLAYSCREEN 3330 ; 3340 ; Restore a previous game 3350 ; 3360 RESTORE 3370 POSITION 5,20 3380 PRINT T5 ; "Restore from Disk or Tape?" 3390 JSR BEEP 3400 DORT 3410 JSR GETKEY 3420 CMP #'D ; disk? 3430 BEQ GETDISK 3440 CMP #'C ; tape? 3450 BEQ GETAPE 3460 DORTERR 3470 JSR CLOSE1 3480 JSR BOOP 3490 JMP DORT 3500 ; 3510 ; Get game from disk 3520 ; 3530 GETDISK 3540 JSR DPOINT 3550 JMP READOPEN 3560 ; 3570 ; Get game from tape 3580 ; 3590 GETAPE 3600 JSR TPOINT 3610 ; 3620 READOPEN 3630 LDA #3 ; OPEN command 3640 STA ICCOM,X 3650 LDA #4 ; READ 3660 STA ICAUX1,X 3670 LDA #0 3680 STA ICAUX2,X 3690 JSR CIOV 3700 BMI DORTERR 3710 ; 3720 ; Get game data thru IOCB #1 3730 ; 3740 GETDATA 3750 LDX #$10 3760 LDA # GAMEDATA 3790 STA ICBADR+1,X 3800 LDA #$51 3810 STA ICBLEN,X 3820 LDA #$01 3830 STA ICBLEN+1,X 3840 LDA #7 ; GET RECORD 3850 STA ICCOM,X 3860 JSR CIOV 3870 BMI DORTERR 3880 JSR CLOSE1 3890 ; 3900 ; PLAYSCREEN INIT 3910 ; --------------- 3920 PLAYSCREEN 3930 JSR NEWSCREEN ; reset E: 3940 ; 3950 ; Enable custom display list 3960 ; 3970 LDA # DLIST 4000 STA SDLSTL+1 4010 ; 4020 ; Print title & labels 4030 ; 4040 PRINT T6 ; "ONE FOR THE ROAD EVENT #" 4050 LDA #12 ; set right margin 4060 STA RMARGN ; for wraparound 4070 PRINT T7 ; "LOCATION/EXITS" 4080 PRINT T8 ; "VISIBLE ITEMS" 4090 JSR BAR 4100 JSR BAR 4110 JSR BAR 4120 JSR BAR ; 4 blank bars 4130 JSR SAYWHAT ; "WHAT" 4140 PRINT T11 ; "HAPPENS/YOUR RESPONSE" 4150 JSR SAYWHAT ; "WHAT" 4160 PRINT T12 ; "YOU ARE CARRYING" 4170 JSR BAR 4180 JSR BAR ; more blank bars 4190 LDA #39 4200 STA RMARGN ; reset 4210 ; 4220 LDA #$0C ; white 4230 STA PCOLR0 ; cursor 4240 ; 4250 ; Setup P/M borders & mask 4260 ; 4270 LDA #48 4280 STA HPOSP1 ; position left 4290 LDA #202 ; and 4300 STA HPOSP2 ; right borders 4310 LDA #64 ; and 4320 STA HPOSP3 ; title cover 4330 LDX #255 4340 STX GRAFP1 ; set up 4350 STX GRAFP2 ; side borders and 4360 STX GRAFP3 ; title mask 4370 INX ; = 0 4380 STX SIZEP0 ; set cursor width 4390 INX ; = 1 4400 STX GPRIOR ; set player priority 4410 LDA #3 4420 STA SIZEP1 ; set border 4430 STA SIZEP2 ; and mask 4440 STA SIZEP3 ; widths 4450 ; 4460 LDA #$F0 ; init 4470 STA CSHAPE ; cursor shape 4480 LDA #30 ; and 4490 STA BLINK ; blink timer 4500 ; 4510 LDA #13 4520 STA LMARGN ; init left margin 4530 ; 4540 LDY # IMMVBI ; specifying 4560 LDA #6 ; immediate-mode 4570 JSR SETVBV 4580 ; 4590 LDA # DLI ; we put our 4620 STA VDSLST+1 ; DLI service routine 4630 LDA #$C0 ; set bits 6 & 7 of NMIEN 4640 STA NMIEN ; to enable DLIs and VBIs 4650 ; 4660 LDA PLACE 4670 JMP REENTRY 4680 ; 4690 ; EVENT GENERATOR 4700 ; --------------- 4710 ; 4720 NEXTEVENT 4730 LDX #$FF ; empty stack 4740 TXS ; just in case! 4750 JSR SHOWEV ; show event # 4760 INC EVENT ; update 4770 BNE HITROCKS ; event 4780 INC EVENT+1 ; counter 4790 ; 4800 ; Handle rocks 4810 ; 4820 HITROCKS 4830 LDA PLACE 4840 CMP #3 4850 BCC R1 4860 JMP EXPLODE 4870 R1 4880 DEC ROCKCNT 4890 LDA ROCKCNT 4900 BNE EXPLODE 4910 JSR NEWSCREEN 4920 POSITION 9,3 4930 PRINT T77 ; "Crashing into the rocks" 4940 JMP KILLS 4950 ; 4960 ; Handle explosion 4970 ; 4980 EXPLODE 4990 LDA BLAST ; counter set? 5000 BEQ CHESTRTN ; no 5010 DEC BLAST ; -1 from counter 5020 LDA BLAST ; time to explode? 5030 BNE CHESTRTN ; no 5040 LDA PLACE 5050 CMP DPLACE ; player in same room as dynamite? 5060 BEQ EXP4 ; yes, too bad! 5070 LDA #25 ; dynamite 5080 JSR OWNIT? 5090 BEQ EXP4 ; deep trouble! 5100 LDA DPLACE ; room with dynamite 5110 ASL A ; * 2 ; calculate position 5120 STA NCODE ; in objects buffer 5130 ASL A ; * 4 5140 CLC 5150 ADC NCODE ; *2 + *4 = *6 5160 ADC #5 5170 TAY ; use Y as index 5180 EXP0 5190 LDA OBJECTS,Y ; get object 5200 CMP #25 ; dynamite? 5210 BEQ EXP1 ; sure is! 5220 DEY 5230 BNE EXP0 ; try next object 5240 EXP1 5250 LDA DPLACE 5260 CMP #9 ; explosion in room 9? 5270 BNE EXP3 ; nope 5280 LDA #0 ; cave 5290 STA OBJECTS,Y ; put in room 9 5300 LDA #10 ; new room vector 5310 STA VECTORS+57 5320 EXP2 5330 POSITION 13,10 5340 PRINT T48 ; "Booooommmmm!!" 5350 JSR BOOM 5360 JMP CHESTRTN 5370 EXP3 5380 LDA #255 5390 STA OBJECTS,Y ; get rid of dynamite 5400 BNE EXP2 5410 EXP4 5420 JSR NEWSCREEN 5430 POSITION 12,3 5440 PRINT T73 ; "Huge explosion" 5450 JSR BOOM 5460 JMP KILLS 5470 ; 5480 ; handle chest 5490 ; 5500 CHESTRTN 5510 LDA CHECNT 5520 CMP #255 ; chest already placed? 5530 BEQ MATCHRTN ; yes 5540 CMP #0 ; time for chest to show up? 5550 BNE CRTN1 ; nope 5560 LDA PLACE ; current room 5570 CMP #3 ; is it room 3? 5580 BEQ MATCHRTN ; yes 5590 LDY #23 ; point to room 3 object buffer 5600 CRTN 5610 LDA OBJECTS,Y 5620 CMP #255 ; got space? 5630 BEQ CRTN0 ; yes! 5640 DEY 5650 CPY #17 ; end of room 3 buffer? 5660 BNE CRTN ; no, try again 5670 BEQ MATCHRTN ; no space yet 5680 CRTN0 5690 LDA #2 ; chest 5700 STA OBJECTS,Y ; put in room 5710 CRTN1 5720 DEC CHECNT 5730 ; 5740 ; handle matches 5750 ; 5760 MATCHRTN 5770 LDA LIT ; match lit? 5780 BEQ DRNKRTN ; nope 5790 DEC LITCNT ; -1 from counter 5800 BNE DRNKRTN ; still lit 5810 LDA #0 5820 STA LIT ; match goes out 5821 POSITION 13,10 5822 PRINT T29 ; "Match goes out" 5900 ; 5910 ; handle liquid 5920 ; 5930 DRNKRTN 5940 LDA DRINK ; drank liquid? 5950 BEQ PARSER ; no 5960 DEC DRINK ; yes, decrement counter 5970 LDA DRINK ; time up? 5980 BNE PARSER ; no, whew! 5990 JSR NEWSCREEN 6000 POSITION 11,3 6010 PRINT T32 ; "Strange liquid" 6020 JMP KILLS 6030 ; 6040 ; INPUT PARSER 6050 ; ------------ 6060 ; 6070 PARSER 6080 LDA #$22 6090 STA SDMCTL 6100 JSR GETLINE ; put line into INLINE 6110 JSR CLWH 6120 LDX LENGTH 6130 CPX #1 ; if length is 1 6140 BNE DOCLAUSE ; check for legality 6150 ; 6160 ; Check for a legal single-char command 6170 ; 6180 LDA INLINE ; get the character 6190 LDX #8 ; init search index 6200 LEGSING 6210 CMP SCOMS,X 6220 BEQ EXSING ; matched! go do it 6230 DEX ; otherwise 6240 BPL LEGSING ; keep searching 6250 JSR SYNERR ; error, so print 6260 PRINT T14 ; "Invalid command" 6270 JMP BADPARSE ; and try again 6280 ; 6290 ; Execute a single-char command 6300 ; 6310 EXSING 6320 LDA SVECTL,X ; fetch the lsb 6330 STA DOVECT ; and 6340 LDA SVECTH,X ; msb of the 6350 STA DOVECT+1 ; execution addr 6360 JMP (DOVECT) ; and do it! 6370 ; 6380 ; Find the 1st space character 6390 ; in the user's response 6400 ; 6410 DOCLAUSE 6420 LDA #SPACE 6430 STA PBUFF+1 6440 STA PBUFF+2 6450 LDX #1 6460 FIND1 6470 LDA INLINE,X ; length is in X 6480 CMP #SPACE ; is it a space? 6490 BEQ ENDV ; yes! 6500 INX ; else keep scanning 6510 CPX LENGTH 6520 BCC FIND1 6530 BADVERB 6540 JSR SYNERR ; verb is no good, so print 6550 PRINT T15 ; "Verb not recognized" 6560 JMP BADPARSE ; and try again 6570 ; 6580 ; Space char found, so record its 6590 ; position and move the first half 6600 ; of the clause into the parsing buffer 6610 ; 6620 ENDV 6630 STX LBREAK 6640 CPX #2 6650 BCC TOVB 6660 LDX #2 6670 TOVB 6680 LDA INLINE,X 6690 STA PBUFF,X 6700 DEX 6710 BPL TOVB 6720 ; 6730 ; Check for a legal verb 6740 ; 6750 LDX #0 ; init verb index 6760 STX VCODE 6770 VNEXT 6780 STX PDEX 6790 LDY #0 ; init buffer char index 6800 VSCAN 6810 LDA PBUFF,Y ; get a char from buffer 6820 CMP VERBS,X ; match? 6830 BNE NEXTRY ; nope - try another verb 6840 INX 6850 INY 6860 CPY #3 6870 BCC VSCAN ; if all 3 chars match 6880 BCS LEGALV ; the verb is legal 6890 NEXTRY 6900 INC VCODE 6910 LDX PDEX 6920 INX 6930 INX 6940 INX 6950 CPX #NV*3+3 ; out of verbs? 6960 BCC VNEXT ; nope - keep scanning 6970 BCS BADVERB ; else verb is worthless 6980 ; 6990 ; Verb is legal, so fetch its execution 7000 ; vector 7010 ; 7090 ; Move the second half of the 7100 ; clause into the parsing buffer 7110 ; 7120 LEGALV 7130 LDX LBREAK ; fetch pos. of space char 7140 INX ; plus 1 7150 LDY #0 ; init buffer char index 7160 MOVEN 7170 LDA INLINE,X ; fetch character 7180 STA PBUFF,Y ; stuff into buffer 7190 INX 7200 INY 7210 CPY #3 ; until 3 characters 7220 BCC MOVEN ; have been moved 7230 ; 7240 ; Check for a legal noun 7250 ; 7260 LDX #0 ; init noun index 7270 STX UCODE 7280 NNEXT 7290 STX PDEX 7300 LDY #0 ; init buffer char index 7310 NSCAN 7320 LDA PBUFF,Y ; get a char from buffer 7330 CMP NOUNS,X ; match? 7340 BNE NEXTRY2 ; nope - try another noun 7350 INX 7360 INY 7370 CPY #3 7380 BCC NSCAN ; if all 3 chars match 7390 BCS LEGALN ; the noun is legal 7400 NEXTRY2 7410 INC UCODE 7420 LDX PDEX 7430 INX 7440 INX 7450 INX 7460 CPX #NN*3+3 ; out of nouns? 7470 BCC NNEXT ; nope - keep scanning 7480 JSR SYNERR ; else noun is garbage 7490 PRINT T16 ; "Bad noun" 7500 JMP BADPARSE 7510 ; 7520 ; Noun's code # is in UCODE; 7530 ; verb's code # is in VCODE; 7540 ; verb execution addr is in DOVECT 7550 ; 7560 LEGALN 7570 LDA VCODE ; fetch 7580 STA VLAST 7590 ASL A ; execution addr 7600 TAX ; and 7610 LDA VVECTS,X ; save it 7620 STA DOVECT ; in DOVECT 7630 INX 7640 LDA VVECTS,X 7650 STA DOVECT+1 7660 LDA UCODE 7670 STA ULAST 7700 TAX 7710 LDA NTRANS,X ; translate noun 7720 STA NCODE 7730 JMP (DOVECT) ; execute verb 7800 ; 7810 ; EXECUTE SINGLE-CHAR COMMANDS 7820 ; ---------------------------- 7830 ; 7840 ; COMMAND VECTOR TABLES 7850 ; --------------------- 7860 SVECTL 7870 .BYTE DOM, >DOM, >DOM, >DOM, >DOM 7910 .BYTE >DOM, >DOQ, >DOX, >DOA 7920 ; 7930 ; HANDLE "Q" (QUIT) 7940 ; ----------------- 7950 DOQ 7960 POSITION 13,12 7970 PRINT T19 ; "Type Y to quit game:" 7980 POSITION 34,12 7990 STX CURSEN ; enable cursor 8000 JSR BEEP 8010 JSR GETKEY 8020 CMP #'Y 8030 BEQ DOQUIT 8040 LDX #12 8050 JSR ERASE 8060 JMP BADPARSE 8070 DOQUIT 8080 JMP TITLE 8090 ; 8100 ; HANDLE MOVEMENT 8110 ; --------------- 8120 ; ENTRY: Vector (0-5) in X 8130 ; 8140 DOM 8150 LDA CURVECT,X 8160 BPL EXMOVE 8170 CANTGO 8180 PRINT T18 ; "You can't go that way." 8190 JMP BADPARSE 8200 EXMOVE 8210 CLD ; for safety 8220 STA NEWPLACE ; save destination 8230 CMP #2 ; going to room 2? 8240 BNE EXMV0 ; no 8250 LDA INFLATE ; raft inflated? 8260 BEQ EXMV3 ; no 8270 LDX RAFTIN ; raft in the water? 8280 BEQ EXMV3 ; no 8290 BNE EXMV2 8300 EXMV0 8310 CMP #1 ; going to room 1? 8320 BNE EXMV1 ; no 8330 LDX INFLATE ; raft inflated? 8340 BEQ EXMV2 ; no 8350 LDA #22 ; raft 8360 JSR OWNIT? 8370 BEQ EXMV4 8380 EXMV1 8390 CMP #9 ; going to room 9? 8400 BNE EXMV2 ; no 8410 LDA SNAKE ; snake dead? 8420 BNE EXMV2 ; yes 8430 PRINT T46 ; "Snake won't let you!" 8440 JMP GOODPARSE 8450 EXMV2 8460 JSR SAVELOC ; save status 8470 LDA NEWPLACE ; get destination, 8480 STA PLACE ; make it current, and 8490 REENTRY 8500 JSR BPOINT ; point to the new buffers 8510 ; 8520 ; Get new buffer data 8530 ; 8540 LDY #5 8550 RLOOP 8560 LDA (VPNT),Y 8570 STA CURVECT,Y 8580 LDA (OPNT),Y 8590 STA CUROBJS,Y 8600 DEY 8610 BPL RLOOP 8620 ; 8630 ; Refresh screen 8640 ; 8650 SHOWPLACE 8660 LDX #1 8670 JSR ERASE ; clear location window 8680 POSITION 13,1 8690 LDX PLACE ; get loc # 8700 JSR CHGCLR ; set screen colors 8710 LDA RDLS,X ; fetch lsb and 8720 LDY RDHS,X ; msb of text addr and 8730 JSR EPRINT ; print it 8740 ; 8750 JSR SHOWVIS ; display visible items 8760 JSR SHOWVECTS ; display new vectors 8770 JSR SHOWINV ; show inventory 8780 JMP POKAY ; congratulations! 8790 EXMV3 8800 JSR NEWSCREEN 8810 POSITION 9,3 8820 PRINT T71 ; "Storm tossed ocean" 8830 JMP KILLS 8840 EXMV4 8850 PRINT T38 ; "Raft's too big" 8860 JMP GOODPARSE 8870 ; 8880 ; POINT TO NEW BUFFERS 8890 ; -------------------- 8900 ; ENTRY: Buffer # (0-23) in A 8910 ; 8920 BPOINT 8930 ASL A ; * 2 8940 STA NCODE ; save it 8950 ASL A ; * 4 8960 CLC 8970 ADC NCODE ; *2 + *4 = *6 8980 STA NCODE ; save it 8990 CLC 9000 ADC # VECTORS 9030 ADC #0 9040 STA VPNT+1 9050 CLC 9060 LDA NCODE 9070 ADC # OBJECTS 9100 ADC #0 9110 STA OPNT+1 9120 RTS 9130 ; 9140 ; HANDLE "X" (SAVE GAME) 9150 ; ---------------------- 9160 DOX 9170 JSR SAVELOC ; save current status 9180 JSR NEWSCREEN 9190 POSITION 5,11 9200 PRINT T82 ; "Save game to Disk or Cassette?" 9210 LDA #$22 9220 STA SDMCTL 9230 JSR BEEP 9240 SAVEPOLL 9250 JSR GETKEY 9260 CMP #'D 9270 BEQ DSAVE 9280 CMP #'C 9290 BEQ CSAVE 9300 BADWRITE 9310 JSR CLOSE1 9320 JSR BOOP 9330 JMP SAVEPOLL 9340 ; 9350 ; Save to disk 9360 ; 9370 DSAVE 9380 JSR DPOINT 9390 JMP GSAVE 9400 ; 9410 ; Save to cassette 9420 ; 9430 CSAVE 9440 JSR TPOINT 9450 ; 9460 GSAVE 9470 LDA #3 9480 STA ICCOM,X 9490 LDA #8 9500 STA ICAUX1,X 9510 LDA #0 9520 STA ICAUX2,X 9530 JSR CIOV 9540 BMI BADWRITE 9550 ; 9560 ; Write out game data 9570 ; 9580 WRITE 9590 LDX #$10 9600 LDA # GAMEDATA 9630 STA ICBADR+1,X 9640 LDA #$51 9650 STA ICBLEN,X 9660 LDA #$01 9670 STA ICBLEN+1,X 9680 LDA #11 9690 STA ICCOM,X 9700 JSR CIOV 9710 BMI BADWRITE 9720 JSR CLOSE1 9730 JMP PLAYSCREEN 9740 ; 9750 ; HANDLE "A" (AGAIN) 9760 ; ------------------ 9770 DOA 9780 LDA VLAST ; restore old verb 9790 STA VCODE 9800 LDA ULAST ; and noun 9810 STA UCODE 9820 JMP LEGALN ; and do it again! 9830 ; 9840 ; SAVE LOC STATUS 9850 ; --------------- 9860 SAVELOC 9870 LDA PLACE 9880 JSR BPOINT 9890 LDY #5 9900 SLOOP 9910 LDA CURVECT,Y 9920 STA (VPNT),Y 9930 LDA CUROBJS,Y 9940 STA (OPNT),Y 9950 DEY 9960 BPL SLOOP 9970 RTS 9980 ;