0100 ; VERB EXECUTORS 0110 ; -------------- 0120 ; 0130 ; ENTRY: Translated noun code in A 0140 ; and in NCODE; 0150 ; untranslated code in UCODE 0160 ; 0170 ; TAKE 0180 ; ---- 0190 DOTAKE 0200 LDA UCODE 0210 CMP #22 ; is it moveable? 0220 BCS DT0 ; yes 0230 JMP IMPOSS 0240 DT0 0250 LDA NCODE 0260 JSR OWNIT? ; already have it? 0270 BNE DT1 0280 JMP ALREADY 0290 DT1 0300 LDA NCODE 0310 JSR INROOM? ; is it here? 0320 BEQ DT2 0330 JMP NOTHERE 0340 DT2 0350 LDA NCODE 0360 CMP #20 ; bolted unit? 0370 BNE DT3 0380 PRINT T41 ; "Bolts are tight & rusty" 0390 JMP GOODPARSE 0400 DT3 0410 CMP #42 ; free unit? 0420 BNE DT3B 0430 LDA PLACE ; room 0? 0440 BNE DT3B 0450 LDA #27 ; got wrench? 0460 JSR OWNIT? 0470 BEQ DT3A 0480 PRINT T80 ; "Bolts won't let you" 0490 JMP GOODPARSE 0500 DT3A 0510 LDA #7 ; power cable 0520 JSR INROOM? 0530 BNE DT3B 0540 PRINT T83 ; "Connected to cable" 0550 JMP GOODPARSE 0560 DT3B 0570 JSR INVSPACE? ; arms full? 0580 BEQ DT4 0590 JMP ARMSFULL 0600 DT4 0610 LDX ROOMPOS ; get object position 0620 LDY INVPOS ; and inv position 0630 LDA CUROBJS,X ; pick it up 0640 STA HOLDINGS,Y ; add to inventory 0650 LDA #$FF 0660 STA CUROBJS,X ; leave a blank slot 0670 SHOWALL 0680 JSR SHOWVIS ; show room 0690 JSR SHOWINV ; and inventory 0700 JMP POKAY ; done! 0710 ; 0720 ; DROP 0730 ; ---- 0740 DODROP 0750 JSR OWNIT? ; do you have it? 0760 BEQ DD0 0770 JMP DONTHAVE 0780 DD0 0790 LDA PLACE 0800 CMP #17 ; is this room 17? 0810 BEQ DROP17 ; special handling 0820 DD1 0830 JSR ROOMSPACE? ; enough room for it? 0840 BEQ DROPIT 0850 JMP ROOMFULL 0860 DROPIT 0870 LDX ROOMPOS 0880 LDY INVPOS 0890 LDA HOLDINGS,Y 0900 STA CUROBJS,X 0910 LDA #$FF 0920 STA HOLDINGS,Y 0930 BNE SHOWALL 0940 ; 0950 ; Handle room 17 0960 ; 0970 DROP17 0980 JSR ROOMIN18? ; space in room 18? 0990 BNE DD1 ; no - drop it in 17 1000 LDY INVPOS ; get inv position 1010 LDX ROOMPOS ; and pos in room 18 1020 LDA HOLDINGS,Y ; pick up item 1030 STA OBJECTS,X ; and put in 18 1040 LDA #$FF ; clear inventory 1050 STA HOLDINGS,Y ; slot 1060 PRINT T68 ; "It falls down the pipe" 1070 LDA NCODE 1080 CMP #42 ; dropped the unit? 1090 BEQ DROPUNIT ; special handling 1100 D17B 1110 JSR SHOWVIS 1120 JSR SHOWINV 1130 JMP GOODPARSE 1140 ; 1150 ; Handle UNIT in 17 1160 ; 1170 DROPUNIT 1180 LDA UNIT ; init = 0 1190 BNE D17B 1200 LDA #38 ; update traitor 1210 LDX #5 ; status in 1220 STA UNIT ; unit flag, 1230 STA NTRANS,X ; translation matrix 1240 LDX #108 ; and object 1250 STA OBJECTS,X ; matrix 1260 JSR ROOMIN18? ; find room 1270 LDX ROOMPOS ; for pistol 1280 LDA #21 ; and 1290 STA OBJECTS,X ; drop it in 18 1300 BNE D17B 1310 ; 1320 ; Find empty slot in room 18 1330 ; 1340 ROOMIN18? 1350 LDX #109 ; skip 1st object 1360 RN18 1370 LDA OBJECTS,X 1380 BMI RN18A ; found a blank! 1390 INX 1400 CPX #113 ; scan to end 1410 BCC RN18 ; of room 1420 TXA ; return NZ status 1430 RTS 1440 RN18A 1450 STX ROOMPOS ; save room pos 1460 LDA #0 ; set zero status 1470 RTS 1480 ; 1490 ; REMOVE 1500 ; ------ 1510 DOREMOVE 1520 CMP #22 ; moveable? 1530 BCS DRM 1540 JMP IMPOSS 1550 DRM 1560 CMP #28 ; mask? 1570 BEQ GODROP 1580 CMP #32 ; suit? 1590 BEQ GODROP 1600 CMP #42 ; unit? 1610 BEQ GOGRAB 1620 JMP BESPEC 1630 GOGRAB 1640 JMP DOTAKE 1650 GODROP 1660 JMP DODROP 1670 ; 1680 ; LOOK/EXAM 1690 ; --------- 1700 DOLOOK 1710 JSR INROOM? ; is it in room? 1720 BEQ LOOKOK ; if not, 1730 LDA NCODE 1740 JSR OWNIT? ; do you have it? 1750 BEQ LOOKOK 1760 JMP NOTHERE ; guess not 1770 LOOKOK 1780 LDA NCODE 1790 CMP #9 ; captain? 1800 BNE LK0 1810 ; 1820 ; Search captain 1830 ; 1840 EXAMCAP 1850 LDA CAPTAIN 1860 BEQ EC0 1870 JMP SEEMSORD 1880 EC0 1890 JSR ROOMSPACE? 1900 BEQ EC1 1910 JMP ROOMFULL 1920 EC1 1930 PRINT T35 ; "Found something!" 1940 LDA #24 1950 STA CAPTAIN 1960 LDX ROOMPOS 1970 STA CUROBJS,X 1980 JSR SHOWVIS 1990 JMP GOODPARSE 2000 ; 2010 LK0 2020 CMP #15 ; gauge? 2030 BNE LK1 2040 ; 2050 ; Read depth gauge 2060 ; 2070 READGAUGE 2080 JSR ZFR0 2090 LDA DEPTH 2100 STA FR0 2110 JSR VPRINT 2120 PRINT T55 ; "Fathoms" 2130 JMP GOODPARSE 2140 ; 2150 LK1 2160 CMP #17 ; display? 2170 BNE LK2 2180 ; 2190 ; Read navigation displays 2200 ; 2210 READISP 2220 LDA PLACE 2230 CMP #11 ; missile room? 2240 BEQ SHOWMD 2250 LDA SLAT 2260 LDX SLON 2270 BNE DISHOW 2280 SHOWMD 2290 LDA MLAT 2300 LDX MLON 2310 DISHOW 2320 STA LATSHOW 2330 STX LONSHOW 2340 PRINT T53 ; "X =" 2350 POSITION 17,9 2360 JSR ZFR0 2370 LDA LATSHOW 2380 STA FR0 2390 JSR VPRINT 2400 PRINT T54 ; "Y =" 2410 POSITION 17,10 2420 JSR ZFR0 2430 LDA LONSHOW 2440 STA FR0 2450 JSR VPRINT 2460 BNE LKX 2470 ; 2480 LK2 2490 CMP #32 ; suit? 2500 BNE LK3 2510 ; 2520 ; Examine suit 2530 ; 2540 EXAMSUIT 2550 LDA SUIT 2560 BEQ ES0 2570 JMP SEEMSORD 2580 ES0 2590 JSR ROOMSPACE? 2600 BEQ ES1 2610 JMP ROOMFULL ; "Not enough room here." 2620 ES1 2630 PRINT T35 ; "Found something!" 2640 LDA #33 ; key 2650 STA SUIT 2660 LDX ROOMPOS 2670 STA CUROBJS,X 2680 JSR SHOWVIS 2690 JMP GOODPARSE 2700 ; 2710 LK3 2720 CMP #21 ; pistol? 2730 BNE LK4 2740 ; 2750 ; Examine pistol 2760 ; 2770 EXAMPIST 2780 LDA BULLET 2790 BNE PX0 ; init = 1 2800 PRINT T52 ; "No bullets" 2810 BNE LKX 2820 PX0 2830 PRINT T51 ; "Only 1 bullet" 2840 BNE LKX 2850 ; 2860 LK4 2870 ASL A ; * 2 2880 TAX ; use as an index 2890 LDA LKLK,X ; fetch lsb 2900 INX ; and 2910 LDY LKLK,X ; msb of text addr 2920 JSR EPRINT ; print text 2930 LKX 2940 JMP GOODPARSE ; and exit 2950 ; 2960 ; EXAM TEXT LOOKUP TABLE 2970 ; ---------------------- 2980 LKLK 2990 .WORD T36,T64,T34,T38 3000 .WORD T39,T34,T64,T39 3010 .WORD T42,T34,T34,T34 3020 .WORD T34,T34,T39,T34 3030 .WORD T37,T34,T34,T46 3040 .WORD T41,T34,T34,T48 3050 .WORD T48,T34,T49,T34 3060 .WORD T34,T34,T48,T48 3070 .WORD T34,T34,T34,T34 3080 .WORD T37,T34,T34,T49 3090 .WORD T39,T34,T47 3100 ; 3110 ; READ 3120 ; ---- 3130 DOREAD 3140 LDX #9 3150 RDLOOP 3160 CMP READS,X 3170 BEQ READOK 3180 DEX 3190 BPL RDLOOP 3200 JMP IMPOSS 3210 READOK 3220 JMP DOLOOK 3230 ; 3240 ; READable nouns 3250 ; 3260 READS 3270 .BYTE 2,36,8,15,17 3280 .BYTE 23,24,26,30,31 3290 ; 3300 ; PUSH 3310 ; ---- 3320 DOPUSH 3330 JSR OWNIT? 3340 BNE DPH 3350 JMP WHYBOTH 3360 DPH 3370 LDA NCODE 3380 JSR INROOM? 3390 BEQ DPH0 3400 JMP NOTHERE 3410 DPH0 3420 LDA NCODE 3430 CMP #10 ; green button? 3440 BNE DPH1 3450 ; 3460 ; Handle green button push 3470 ; 3480 LDX #3 3490 LDA GREEN 3500 BEQ SCANON 3510 LDA #0 3520 STA GREEN 3530 LDA #2 ; blank scanner 3540 SCANNER 3550 STA NTRANS,X 3560 STA CUROBJS 3570 JSR SHOWVIS 3580 JMP GOODPARSE 3590 SCANON 3600 LDA OBJECTS+1 ; check cable 3610 CMP #7 3620 BEQ ONGREEN 3630 JMP NOTHAP ; "Nothing happens" 3640 ONGREEN 3650 STX GREEN 3660 LDA #36 ; active scanner 3670 BNE SCANNER 3680 ; 3690 DPH1 3700 CMP #11 ; red button? 3710 BNE DPH2 3720 ; 3730 ; Handle red button push 3740 ; 3750 LDX RED 3760 BEQ REDON 3770 LDA #0 3780 STA RED 3790 PRINT T59 ; "Sub levels off" 3800 BNE REDX 3810 REDON 3820 INX ; = 1 3830 STX RED 3840 PRINT T60 ; "Sub dives!" 3850 REDX 3860 JMP GOODPARSE 3870 ; 3880 DPH2 3890 CMP #12 ; gold button? 3900 BNE DPH3 3910 ; 3920 ; Handle gold button 3930 ; 3940 LDA MLAT 3950 CLD 3960 CLC 3970 ADC #8 3980 STA MLAT 3990 JMP SHOWMD 4000 ; 4010 DPH3 4020 CMP #13 ; silver button? 4030 BNE DPH4 4040 ; 4050 ; Handle silver button 4060 ; 4070 LDA MLON 4080 SEC 4090 CLD 4100 SBC #8 4110 STA MLON 4120 JMP SHOWMD 4130 ; 4140 DPH4 4150 CMP #14 ; white button? 4160 BNE SORRY 4170 ; 4180 ; Handle white button 4190 ; 4200 PUSHWHITE 4210 LDA MLAT ; missile = 4220 CMP SLAT ; sub? 4230 BNE SORRY 4240 LDA MLON ; missile = 4250 CMP SLON ; sub? 4260 BNE SORRY 4270 LDA SWITCH ; missile armed? 4280 BEQ SORRY 4290 JSR NEWSCREEN 4300 LDA #14 4310 STA COLOR2 4320 STA COLOR4 4330 LDA #0 4340 STA COLOR1 4350 POSITION 12,11 4360 PRINT T81 ; "Congratulations!" 4370 LDA #$22 4380 STA SDMCTL 4390 SOLVED 4400 JMP SOLVED 4410 SORRY 4420 JMP NOTHAP ; "Nothing happens." 4430 ; 4440 ; OPEN 4450 ; ---- 4460 DOOPEN 4470 CMP #6 ; can't be OPENed 4480 BCC OP0 ; if NCODE > 6 4490 JMP IMPOSS 4500 OP0 4510 JSR INROOM? ; is it here? 4520 BEQ OP1 4530 JMP NOTHERE ; nope 4540 OP1 4550 LDA NCODE ; hatch? 4560 BNE OP2 4570 HOPEN 4580 LDA #34 4590 STA HATCH ; mark hatch as opened 4600 STA CUROBJS ; change in current objects 4610 LDA #4 ; open path to 4620 STA CURVECT+5 ; room 4 4630 JSR SHOWVIS 4640 JSR SHOWVECTS 4650 JMP POKAY 4660 OP2 4670 CMP #1 ; door? 4680 BNE OP3 4690 PRINT T64 ; "Lock is very secure" 4700 BNE OPX 4710 OP3 4720 CMP #3 ; grate? 4730 BNE OP4 4740 PRINT T38 ; "Screwed in place" 4750 BNE OPX 4760 OP4 4770 CMP #5 ; airlock? 4780 BNE OP5 4790 PRINT T23 ; "Can't do that yet" 4800 BNE OPX 4810 OP5 4820 CMP #34 ; open hatch? 4830 BEQ ALOPEN 4840 CMP #35 ; open door? 4850 BEQ ALOPEN 4860 CMP #37 ; open grate? 4870 BEQ ALOPEN 4880 CMP #39 ; open airlock? 4890 BNE OP6 4900 ALOPEN 4910 PRINT T65 ; "Already open!" 4920 OPX 4930 JMP GOODPARSE 4940 OP6 4950 JMP IMPOSS 4960 ; 4970 ; SHOOT 4980 ; ----- 4990 DOSHOOT 5000 LDA #21 ; do you have 5010 JSR OWNIT? ; the pistol? 5020 BEQ SHT0 5030 JMP EASIER 5040 SHT0 5050 LDA NCODE 5060 JSR INROOM? 5070 BEQ SHT1 5080 LDA NCODE 5090 JSR OWNIT? 5100 BEQ SHT1 5110 JMP NOTHERE 5120 SHT1 5130 LDA BULLET 5140 BNE SHT3 5150 PRINT T52 ; "No bullets" 5160 JMP GOODPARSE 5170 SHT3 5180 PRINT T45 ; "BANG!" 5190 LDA #0 5200 STA BULLET 5210 LDA NCODE 5220 CMP #1 ; Locked door? 5230 BNE SHOOTX 5240 PRINT T71 ; "Lock destroyed!" 5250 LDA #35 ; change door status in 5260 STA CUROBJS ; object matrix 5270 LDX #1 ; and 5280 STA NTRANS,X ; in the 5290 INX ; translation 5300 STA NTRANS,X ; table 5310 LDA #3 ; open west wall 5320 STA CURVECT+3 ; to room #5 5330 JSR SHOWVIS ; show door change 5340 JSR SHOWVECTS ; and new vector 5350 SHOOTX 5360 JMP GOODPARSE 5370 ; 5380 ; INSERT 5390 ; ------ 5400 DOINSERT 5410 JSR OWNIT? 5420 BEQ INS0 5430 JMP DONTHAVE 5440 INS0 5450 LDA NCODE 5460 CMP #26 ; card? 5470 BNE INS1 5480 PRINT T72 ; "Try examining things" 5490 JMP GOODPARSE 5500 INS1 5510 CMP #24 ; ID? 5520 BEQ INS2 5530 INSX 5540 JMP BESPEC 5550 INS2 5560 LDA PLACE 5570 CMP #19 ; room 19? 5580 BNE INSX 5590 LDA #39 ; update object 5600 STA CUROBJS ; matrix 5610 LDX #6 ; and 5620 STA NTRANS,X ; translator 5630 LDA #21 ; open south wall 5640 STA CURVECT+1 ; to room 21 5650 INEXIT 5660 JSR SHOWVIS 5670 JSR SHOWVECTS 5680 JMP POKAY 5690 ; 5700 ; UNSCREW 5710 ; ------- 5720 DOUNSCREW 5730 JSR INROOM? 5740 BEQ UNS0 5750 JMP NOTHERE 5760 UNS0 5770 LDA UCODE 5780 CMP #24 ; nothing you can carry 5790 BCC UNS1 ; is unscrewable 5800 JMP WHYBOTH 5810 UNS1 5820 LDA NCODE 5830 CMP #20 ; bolted unit? 5840 BNE UNS2 5850 JMP DOTAKE 5860 UNS2 5870 CMP #3 ; closed grate? 5880 BEQ UNS3 5890 JMP IMPOSS 5900 UNS3 5910 LDA #29 ; do you have 5920 JSR OWNIT? ; the knife? 5930 BNE UNS4 ; nope 5940 LDA #37 ; patch 5950 STA CUROBJS ; object 5960 LDX #4 ; and 5970 STA NTRANS,X ; translator tables 5980 LDA #17 ; open south wall to 5990 STA CURVECT+1 ; room 17 6000 BNE INEXIT 6010 UNS4 6020 LDA #22 ; screwdriver? 6030 JSR OWNIT? 6040 BNE UNSX 6050 PRINT T73 ; "Blade's too tiny" 6060 JMP GOODPARSE 6070 UNSX 6080 JMP EASIER 6090 ; 6100 ; HOLD 6110 ; ---- 6120 DOHOLD 6130 LDA UCODE 6140 CMP #38 ; breath? 6150 BEQ DHLD0 6160 JMP BESPEC 6170 DHLD0 6180 LDA BREATH ; already 6190 BNE DHLD1 ; holding 6200 LDA #9 ; it? 6210 STA BREATH ; if not, set timer 6220 STA BHOLD ; to 8 events 6230 JMP POKAY 6240 DHLD1 6250 JMP ALREADY 6260 ; 6270 ; UNLOCK 6280 ; ------ 6290 DOUNLOCK 6300 LDA #33 ; key? 6310 JSR OWNIT? 6320 BEQ UNL0 6330 JMP EASIER 6340 UNL0 6350 LDA NCODE 6360 JSR INROOM? 6370 BEQ UNL1 6380 JMP NOTHERE 6390 UNL1 6400 LDA NCODE 6410 CMP #1 ; locked door? 6420 BNE UNL2 6430 PRINT T75 ; "Key doesn't fit" 6440 JMP GOODPARSE 6450 UNL2 6460 CMP #6 ; locked switch? 6470 BEQ UNL3 6480 JMP IMPOSS 6490 UNL3 6500 LDA #40 ; unlocked 6510 STA CUROBJS 6520 LDX #7 6530 STA NTRANS,X 6540 STA SWITCH 6550 JMP INEXIT 6560 ; 6570 ; CUT 6580 ; --- 6590 DOCUT 6600 JSR INROOM? 6610 BEQ DCT0 6620 JMP NOTHERE 6630 DCT0 6640 LDA NCODE 6650 CMP #7 ; hummer? 6660 BEQ DCT1 6670 JMP IMPOSS 6680 DCT1 6690 LDA #25 ; cutters? 6700 JSR OWNIT? 6710 BNE DCT2 6720 LDA GREEN 6730 BEQ CUTIT 6740 JSR NEWSCREEN 6750 POSITION 9,3 6760 PRINT T76 ; "A jolt of high voltage" 6770 JMP KILLS 6780 CUTIT 6790 LDA #41 ; severed 6800 STA CUROBJS+1 6810 LDX #8 6820 STA NTRANS,X 6830 LDA #2 ; blank scanner 6840 STA OBJECTS+42 6850 LDX #3 6860 STA NTRANS,X 6870 JMP INEXIT 6880 DCT2 6890 JMP EASIER 6900 ; 6910 ; POUR 6920 ; ---- 6930 DOPOUR 6940 JSR OWNIT? 6950 BEQ DPR 6960 JMP DONTHAVE 6970 DPR 6980 LDA NCODE 6990 CMP #30 ; shampoo? 7000 BEQ DOSHAM 7010 JMP IMPOSS 7020 DOSHAM 7030 LDY INVPOS ; remove 7040 LDA #$FF ; shampoo from 7050 STA HOLDINGS,Y ; inventory 7060 PRINT T44 ; "Shampoo all used up" 7070 LDA #20 ; is bolted unit 7080 JSR INROOM? ; nearby? 7090 BNE POURX ; nope 7100 LDX ROOMPOS ; else change to 7110 LDA #42 ; free unit 7120 STA CUROBJS,X 7130 LDX #22 ; patch 7140 STA NTRANS,X ; translation 7150 INX ; table 7160 STA NTRANS,X 7170 POURX 7180 JSR SHOWVIS 7190 JSR SHOWINV 7200 JMP GOODPARSE 7210 ; 7220 ; LUBRICATE 7230 ; --------- 7240 DOLUBE 7250 JSR OWNIT? 7260 BNE DOL 7270 JMP WHYBOTH 7280 DOL 7290 LDA #30 ; got the shampoo? 7300 JSR OWNIT? 7310 BEQ DOL1 7320 DOL0 7330 JMP EASIER 7340 DOL1 7350 LDA NCODE 7360 JSR INROOM? 7370 BEQ DOSHAM 7380 JMP NOTHERE 7390 ; 7400 ; WEAR 7410 ; ---- 7420 DOWEAR 7430 CMP #28 ; mask? 7440 BEQ WEAROK 7450 CMP #32 ; suit? 7460 BEQ WEAROK 7470 JMP IMPOSS 7480 WEAROK 7490 JMP DOTAKE 7500 ; 7510 IMPOSS 7520 PRINT T17 ; "That's impossible." 7530 BNE GOODPARSE 7540 ; 7550 NOTYET 7560 PRINT T23 ; "You can't do that yet." 7570 BNE GOODPARSE 7580 ; 7590 BESPEC 7600 PRINT T26 ; "Be more specific." 7610 BNE GOODPARSE 7620 ; 7630 ARMSFULL 7640 PRINT T24 ; "You're carrying too much!" 7650 BNE BADPARSE 7660 ; 7670 ROOMFULL 7680 PRINT T25 ; "Not enough room here." 7690 BNE BADPARSE 7700 ; 7710 NOTHERE 7720 PRINT T22 ; "It isn't here." 7730 BNE BADPARSE 7740 ; 7750 ALREADY 7760 PRINT T21 ; "You already have it." 7770 BNE BADPARSE 7780 ; 7790 DONTHAVE 7800 PRINT T27 ; "You don't have it." 7810 BNE BADPARSE 7820 ; 7830 NOHELP 7840 PRINT T32 ; "Doesn't help." 7850 BNE GOODPARSE 7860 ; 7870 WHYBOTH 7880 PRINT T33 ; "Why bother?" 7890 BNE GOODPARSE 7900 ; 7910 SEEMSORD 7920 PRINT T34 ; "Seems ordinary." 7930 BNE GOODPARSE 7940 ; 7950 NOTHAP 7960 PRINT T56 ; "Nothing happens." 7970 BNE GOODPARSE 7980 ; 7990 EASIER 8000 PRINT T50 ; "Easier said than done" 8010 ; 8020 GOODPARSE 8030 JSR BEEP 8040 JMP NEXTEVENT 8050 ; 8060 BADPARSE 8070 JSR BOOP 8080 JMP PARSER 8090 ; 8100 ; SUBROUTINES 8110 ; ----------- 8120 ; 8130 ; DLI ROUTINE 8140 ; ----------- 8150 DLI 8160 PHA ; save A, 8170 TXA 8180 PHA ; X 8190 TYA ; and 8200 PHA ; Y registers 8210 LDX DLICOL ; fetch color index 8220 LDA DCOLS,X ; fetch new color 8230 LDY CURSES,X ; and cursor shape 8240 STA WSYNC ; wait for scan 8250 STA COLPF2 ; change color 8260 STY GRAFP0 ; and player shape 8270 INC DLICOL ; update index 8280 PLA 8290 TAY ; restore Y, 8300 PLA ; X 8310 TAX ; and 8320 PLA ; A registers 8330 RTI ; back to mainline 8340 ; 8350 DCOLS 8360 .BYTE $70,$60,$70,$60,$70,$00,$60 8370 CURSES 8380 .BYTE $00,$00,$00,$00,$00 8390 CURSOR 8400 .BYTE $00,$00 8410 ; 8420 ; PRINT MACRO SUBROUTINE 8430 ; ---------------------- 8440 ; ENTRY: Addr of EOL-terminated string 8450 ; in A/Y registers (LSB/MSB). 8460 ; 8470 EPRINT 8480 LDX #0 ; IOCB #0 (E:) 8490 STA ICBADR ; lsb of string addr 8500 STY ICBADR+1 ; msb of string addr 8510 LDA #$09 ; PUT LINE command 8520 STA ICCOM 8530 LDA #$7F 8540 STA ICBLEN ; lsb max string length 8550 STX ICBLEN+1 ; msb (0) 8560 JMP CIOV 8570 ; 8580 ; POSITION MACRO ROUTINE 8590 ; ---------------------- 8600 ; ENTRY: X-pos in X, Y-pos in Y. 8610 ; 8620 POSIT13 8630 LDX #13 8640 POSIT 8650 STX COLCRS 8660 STY ROWCRS 8670 RTS 8680 ; 8690 ; AUDIO PROMPTS 8700 ; ------------- 8710 BEEP 8720 LDA #25 ; high tone 8730 BNE BTONE 8740 ; 8750 BOOP 8760 LDA #100 ; low tone 8770 BTONE 8780 STA AUDF1 8790 LDA #$AA ; dist/vol = 10 8800 STA AUDC1 8810 LDA #0 8820 STA RTCLOK 8830 SOUND 8840 LDA RTCLOK 8850 CMP #5 ; 5 jiffies 8860 BNE SOUND 8870 LDX #0 8880 STX AUDC1 ; silence! 8890 DEX 8900 STX CH ; clear last key 8910 RTS 8920 ; 8930 ; ERASE A STATUS LINE 8940 ; ------------------- 8950 ; ENTRY: Target line (0-18) in X. 8960 ; 8970 ERASE 8980 LDA LADRSL,X ; lsb of line addr 8990 STA CLPOINT 9000 LDA LADRSH,X ; msb of addr 9010 STA CLPOINT+1 9020 LDY #24 ; clear 25 characters 9030 LDA #0 9040 CLLOOP 9050 STA (CLPOINT),Y 9060 DEY 9070 BPL CLLOOP 9080 RTS 9090 ; 9100 ; INIT SCREEN 9110 ; ----------- 9120 NEWSCREEN 9130 LDA #$40 9140 STA NMIEN 9150 STA RAMTOP ; set system to 16K 9160 ; 9170 ; Close IOCB #0 (E:) 9180 ; 9190 LDX #0 ; IOCB #0 (E:) 9200 LDA #$0C ; CLOSE command 9210 STA ICCOM 9220 JSR CIOV ; slam! 9230 ; 9240 ; Re-open E: with new RAM size 9250 ; 9260 LDX #0 ; E: again 9270 STX ICAUX2 ; zero this byte 9280 LDA #3 ; OPEN command 9290 STA ICCOM 9300 LDA # EADR 9330 STA ICBADR+1 9340 LDA #$0C ; allow read/write 9350 STA ICAUX1 9360 JSR CIOV ; do the OPEN 9370 ; 9380 LDA #0 9390 STA DMACTL 9400 STA SDMCTL ; shut off ANTIC 9410 STA GRAFP0 9420 STA GRAFP1 9430 STA GRAFP2 9440 STA GRAFP3 ; blank out borders 9450 ; 9460 LDX #8 ; all colors black 9470 COLOFF 9480 STA PCOLR0,X 9490 DEX 9500 BPL COLOFF 9510 LDA #14 9520 STA COLOR1 ; except text 9530 LDA #$74 9540 STA COLOR0 9550 ; 9560 LDX #1 9570 STX CRSINH ; disable system cursor 9580 INX ; = 2 9590 STX LMARGN ; fix margin 9600 LDA #$70 9610 STA POKMSK 9620 STA IRQEN ; disable BREAK key 9630 RTS ; and return 9640 ; 9650 ; BLANK BAR 9660 ; --------- 9670 BAR 9680 PRINT T9 9690 RTS 9700 ; 9710 ; "WHAT" BAR 9720 ; --------- 9730 SAYWHAT 9740 PRINT T10 9750 RTS 9760 ; 9770 ; KEYBOARD INPUT HANDLER 9780 ; ---------------------- 9790 ; These routines are based in part on 9800 ; Steve Howard's "Alternative Keyboard Handler" 9810 ; (ANALOG Computing #15, pp. 96-103). 9820 ; 9830 ; FETCH A KEYPRESS 9840 ; ---------------- 9850 GETKEY 9860 LDA CH 9870 CMP #$FF ; key pressed? 9880 BEQ GETKEY ; not yet - keep scanning 9890 ; 9900 ; Analyze keycode 9910 ; 9920 ANALYZE 9930 TAY ; save key for later 9940 LDX #$FF 9950 STX CH ; reset key 9960 AND #$C0 ; bit 6 or 7 set? 9970 BEQ LEGAL? ; nope 9980 ; 9990 ; Handle a bad keypress 010000 ; 010010 BADKEY 010020 JSR BOOP ; razz user and 010030 JMP GETKEY ; try again 010040 ; 010050 ; Look for illegal keys 010060 ; 010070 LEGAL? 010080 TYA ; restore keycode 010090 LDX #13 010100 KLOOP 010110 CMP ILLEGAL,X 010120 BEQ BADKEY ; razz if illegal key 010130 DEX 010140 BPL KLOOP 010150 ; 010160 ; Get ATASCII equivalent 010170 ; 010180 LDA ATASCI,Y 010190 ; 010200 ; Screen out numbers, pass EOL and BS 010210 ; 010220 CMP #SPACE ; space bar? 010230 BEQ CLK1 ; that's okay 010240 CMP #EOL ; RETURN? 010250 BEQ CLK1 ; fine by me 010260 CMP #$7E ; backspace? 010270 BEQ CLK1 ; love 'em 010280 CMP #'a 010290 BCC BADKEY 010300 CLD 010310 SEC 010320 SBC #$20 ; convert to upper case 010330 ; 010340 ; Click the speaker 010350 ; 010360 CLK1 010370 LDY #$7F 010380 STY CLICK 010390 CLK2 010400 LDY CLICK 010410 STY CONSOL ; tick! 010420 LDX #8 ; click freq 010430 DELAY 010440 DEX 010450 BPL DELAY 010460 DEC CLICK 010470 BPL CLK2 ; 128 times 010480 ; 010490 RTS ; ATASCII code in A 010500 ; 010510 ; ILLEGAL KEYS 010520 ; ------------ 010530 ILLEGAL 010540 .BYTE $1C ; escape 010550 .BYTE $2C ; tab 010560 .BYTE $27 ; atari 010570 .BYTE $3C ; caps 010580 .BYTE $36 ; < 010590 .BYTE $37 ; > 010600 .BYTE $0F ; = 010610 .BYTE $20 ; , 010620 .BYTE $02 ; ; 010630 .BYTE $22 ; . 010640 .BYTE $26 ; / 010650 .BYTE $06 ; + 010660 .BYTE $07 ; * 010670 .BYTE $0E ; - 010680 ; 010690 ; ATASCII CONVERSION TABLE 010700 ; ------------------------ 010710 ; We use our own table because the 010720 ; location of the ROM-based table varies 010730 ; depending on which computer you have. 010740 ; 010750 ATASCI 010760 .BYTE $6C,$6A,$3B,$8A,$8B,$6B,$2B,$2A 010770 .BYTE $6F,$80,$70,$75,$9B,$69,$2D,$3D 010780 .BYTE $76,$80,$63,$8C,$8D,$62,$78,$7A 010790 .BYTE $34,$80,$33,$36,$1B,$35,$32,$31 010800 .BYTE $2C,$20,$2E,$6E,$80,$6D,$2F,$81 010810 .BYTE $72,$80,$65,$79,$7F,$74,$77,$71 010820 .BYTE $39,$80,$30,$37,$7E,$38,$3C,$3E 010830 .BYTE $66,$68,$64,$80,$82,$67,$73,$61 010840 ; 010850 ; INTERNAL CONVERSION TABLE 010860 ; ------------------------- 010870 INTATA 010880 .BYTE $20,$40,$00,$60 010890 ; 010900 ; Y-OFFSET TABLES 010910 ; --------------- 010920 ; These two tables contain the 010930 ; starting address of each status line 010940 ; (absolute screen line address + 13). 010950 ; LADRSL holds the LSBs, LADRSH the MSBs. 010960 ; 010970 LADRSL 010980 .BYTE SCREEN+53, >SCREEN+53, >SCREEN+93, >SCREEN+133 011050 .BYTE >SCREEN+173, >SCREEN+213, >SCREEN+253, >SCREEN+293 011060 .BYTE >SCREEN+333, >SCREEN+373, >SCREEN+413, >SCREEN+453 011070 .BYTE >SCREEN+493, >SCREEN+533, >SCREEN+573, >SCREEN+613 011080 .BYTE >SCREEN+653, >SCREEN+693, >SCREEN+733 011090 ; 011100 ; FETCH INPUT LINE 011110 ; ---------------- 011120 GETLINE 011130 ; 011140 ; Clear line input buffer 011150 ; 011160 CLD 011170 LDX #24 011180 LDA #SPACE 011190 CLINL 011200 STA INLINE,X 011210 DEX 011220 BPL CLINL 011230 ; 011240 ; Get first character of line 011250 ; 011260 GETONE 011270 POSITION 13,12 011280 LDX #$FF 011290 STX CURSEN ; turn on PMG cursor 011300 STX CH ; clear key 011310 INX 011320 STX LENGTH ; zero line length 011330 JSR GETKEY ; fetch a keycode 011340 CMP #SPACE ; first char not be 011350 BEQ BADONE ; a space 011360 CMP #$7E ; a backspace 011370 BEQ BADONE 011380 CMP #EOL ; or an EOL 011390 BNE PUT1 011400 ; 011410 ; Handle bad first character 011420 ; 011430 BADONE 011440 JSR BOOP ; razz user and 011450 JMP GETONE ; try again 011460 ; 011470 ; Print 1st char 011480 ; 011490 PUT1 011500 JSR SETCIO ; to E: 011510 JSR CIOV 011520 INC LENGTH 011530 ; 011540 ; Get rest of input line 011550 ; 011560 REST 011570 JSR GETKEY ; grab another keycode 011580 CMP #EOL ; if it's an EOL, 011590 BEQ GOTEOL ; line entry complete 011600 CMP #$7E ; backspace? 011610 BNE PUTNEXT ; no - send to screen 011620 ; 011630 ; Handle a backspace 011640 ; 011650 BACKS 011660 DEC LENGTH ; if 1st char of line 011670 BMI BADONE ; signal error 011680 JSR SETCIO ; E: 011690 JSR CIOV ; let CIO do backspace 011700 LDA LENGTH ; if length=0, 011710 BEQ GETONE ; handle as 1st char 011720 BNE REST ; else continue 011730 ; 011740 ; Print latest character 011750 ; 011760 PUTNEXT 011770 JSR SETCIO 011780 JSR CIOV ; print character 011790 INC LENGTH ; next position 011800 LDA LENGTH 011810 CMP #24 ; end of line? 011820 BCC REST ; not yet - get another key 011830 ; 011840 ; Too many chars in line! 011850 ; 011860 GETLAST 011870 JSR BOOP ; a warning razz 011880 JSR GETKEY 011890 CMP #EOL ; must have an EOL 011900 BEQ GOTEOL 011910 CMP #$7E ; or a backspace 011920 BEQ BACKS 011930 BNE GETLAST ; insist! 011940 ; 011950 ; EOL recieved 011960 ; 011970 GOTEOL 011980 JSR SETCIO ; specify E: 011990 STX CURSEN ; shut off cursor 012000 JSR CIOV ; and send EOL 012010 ; 012020 ; Convert screen bytes to ATASCII 012030 ; and move to INLINE 012040 ; 012050 LDY #24 012060 TOBUFF 012070 CLC 012080 LDA SCREEN+493,Y ; grab screen byte 012090 STA SCREEN+453,Y ; move to upper line 012100 ROL A 012110 ROL A 012120 ROL A 012130 ROL A 012140 AND #3 ; transform byte, and 012150 TAX ; use as an index 012160 LDA SCREEN+453,Y ; restore original value 012170 AND #$1F ; clear bits 5-7 012180 ORA INTATA,X ; merge with code table 012190 STA INLINE,Y ; send to buffer 012200 LDA #0 012210 STA SCREEN+493,Y ; clear response line 012220 DEY 012230 BPL TOBUFF 012240 RTS 012250 ; 012260 ; IMMEDIATE VBI ROUTINE 012270 ; --------------------- 012280 ; Positions and blinks cursor, 012290 ; resets DLI color index 012300 ; 012310 IMMVBI 012320 ; 012330 ; Reset DLI color index 012340 ; 012350 LDA #0 012360 STA DLICOL 012370 ; 012380 ; Okay to update cursor? 012390 ; 012400 LDA CURSEN ; if enable flag = 0, 012410 BEQ VEXIT ; don't redraw cursor 012420 ; 012430 ; Calculate cursor X-position: 012440 ; XNEW = ( XOLD * 4 ) + 48 012450 ; 012460 CLD 012470 LDA COLCRS 012480 ASL A 012490 ASL A ; times 4 012500 CLC 012510 ADC #48 ; plus 48 012520 STA HPOSP0 ; use as h-pos 012530 ; 012540 ; Don't blink cursor if a key 012550 ; is being pressed. 012560 ; 012570 LDA SRTIMR ; 0 = no press 012580 BEQ BLINK? 012590 ; 012600 LDA #$F0 012610 STA CURSOR 012620 STA CSHAPE ; force cursor on 012630 LDA #60 ; for at least 012640 STA BLINK ; 1 second 012650 ; 012660 BLINK? 012670 LDA CSHAPE 012680 DEC BLINK ; next jiffy 012690 BNE VEXIT ; don't blink until 0 012700 ; 012710 ; Blink the cursor 012720 ; 012730 LDY #30 012740 STY BLINK ; reset timer 012750 EOR #$F0 ; flip the cursor shape 012760 STA CSHAPE ; and save it for later 012770 VEXIT 012780 STA CURSOR ; plot the cursor 012790 JMP SYSVBV ; sayonara 012800 ; 012810 ; DISPLAY EVENT COUNTER 012820 ; --------------------- 012830 SHOWEV 012840 ; 012850 ; Initialize EBUFF 012860 ; 012870 LDA #'0 012880 STA EBUFF 012890 STA EBUFF+1 012900 STA EBUFF+2 012910 LDA #EOL 012920 STA EBUFF+4 012930 ; 012940 ; Convert event # to ATASCII 012950 ; 012960 ECON 012970 LDA EVENT 012980 STA FR0 012990 LDA EVENT+1 013000 STA FR0+1 013010 JSR IFP ; convert to floating point 013020 JSR FASC ; then to ATASCII 013030 CLD 013040 ; 013050 ; Determine length of number 013060 ; 013070 LDY #$FF ; init loop index 013080 FINDE 013090 INY 013100 LDA (INBUFF),Y ; check characters 013110 BPL FINDE 013120 ; 013130 ; Change # to inverse video and 013140 ; move to EBUFF 013150 ; 013160 LDX #3 ; move 3 chars maximum 013170 TOEB 013180 LDA (INBUFF),Y 013190 ORA #$80 ; set msb 013200 STA EBUFF,X ; put in EBUFF 013210 DEX 013220 DEY 013230 BPL TOEB 013240 ; 013250 ; Display contents of EBUFF 013260 ; 013270 POSITION 33,0 013280 PRINT EBUFF 013290 RTS 013300 ; 013310 ; SET CIO TO PUT CHAR MODE 013320 ; ------------------------ 013330 SETCIO 013340 LDX #$0B 013350 STX ICCOM 013360 LDX #0 013370 STX ICBLEN 013380 STX ICBLEN+1 013390 RTS 013400 ;