10
20
30 :
40
50
60
70
80
90
100
110
120 :
130
140
150
160
170 :
180
190
200
210
220
230
240
250
260 :
270 OSBYTE=&FFF4:OSARGS=&FFDA
280 IRQ1V=&204:BYTEV=&20A:WORDV=&20C
290 DIM mcode% &200:norm%=&FFFF0933
300 PRINT"Normal: &";~norm%
310 INPUT"Start: &"A$:IF A$="":A$=STR$~norm%
320 load%=EVAL("&FFFF0"+RIGHT$(A$,3))
330 posn=&DA6:oldvecs=&D99
340 :
350 FOR P=0 TO 1
360 P%=load%:O%=mcode%
370 [OPT P*3+4
380 EQUS "v1.21":EQUB 13
390 .newvecs
400 EQUW newirq:EQUW newbyte:EQUW newword
410 .exec%
420 LDA #1:LDY #0:LDX #&A8
430 JSR OSARGS:PHP:SEI :\ Disable IRQs while changing vectors
440 LDA IRQ1V+0:CMP #newirq AND 255:BNE chkVector
450 LDA IRQ1V+1:AND #&FC:CMP #(newirq DIV 256) AND &FC
460 .chkVector
470 PHP :\ EQ=Already installed, NE=Not installed
480 LDA (&A8),Y:AND #&DF
490 CMP #ASC"O":BNE mouseOn :\ *Mouse On
500 INY:LDA (&A8),Y:AND #&DF
510 CMP #ASC"F":BNE mouseOn :\ Not *Mouse Off
520 :
530 .mouseOff
540 PLP:BNE exit1 :\ NE=Mouse not installed
550 LDX #5:LDY #WORDV+1-&200 :\ Initially copy BYTEV+WORDV
560 .oldveclp
570 LDA oldvecs,X:STA &200,Y :\ Restore old vector
580 CPX #2:BNE oldvec2
590 LDY #IRQ1V+2-&200 :\ Now copy IRQ1V
600 .oldvec2
610 DEY:DEX:BPL oldveclp
620 .exit1
630 PLP:RTS
640 :
650 .mouseOn
660 PLP:BEQ exit3 :\ EQ=Mouse already installed
670 CLC:ADC #2:AND #&E4:PHA :\ Save *Mouse parameter
680 LDX #5:LDY #WORDV+1-&200 :\ Initially copy BYTEV+WORDV
690 .newveclp
700 LDA &200,Y:STA oldvecs,X :\ Copy old vector
710 LDA newvecs,X:STA &200,Y :\ Set new vector
720 CPX #2:BCC newvec3:BNE newvec2
730 LDY #IRQ1V+2-&200 :\ Now copy IRQ1V
740 .newvec2
750 TXA:AND #1:ASL A:STA posn-2,X :\ Set initial position
760 .newvec3
770 DEY:DEX:BPL newveclp
780 SEC:ROR posn+0 :\ Initial X=&280
790 LDA #0:JSR OSBYTE :\ Read MOS, X=&FF from above
800 TXA:BNE NotElectron:LDA #&FC
810 .ElectronLp
820 LDY ld1%,X:CPY #&FE:BNE P%+5:STA ld1%,X
830 LDY ld2%,X:CPY #&FE:BNE P%+5:STA ld2%,X
840 INX:BNE ElectronLp :\ Finished with X=0 again
850 .NotElectron
860 PLA:CMP #ASC"D":BEQ mousePins :\ Marconi/RB5 override
870 CPX #5:BNE exit2 :\ Not Compact
880 .mousePins
890 \ Compact not Compact
900 \ chk_dir=NOP leave as LSR
910 \ change+1=8 leave as 1
920 \ rd_buttons=ROR Ax4 leave as NOP
930 \ rd_key3=NOPx4 leave as ROR
940 LDY #3
950 .mousePinLp
960 LDA #&6A:STA rd_buttons,Y :\ Change to ROR A
970 LDA #&EA:STA chk_dir,Y :\ Change to NOP
980 DEY:BPL mousePinLp
990 STA chk_dir:LDA #8:STA change+1
1000 .exit2
1010 LDX #&00:STX &FE62 :\ Data Direction=Input
1020 LDX #&98:STX &FE6E :\ Enable CB1+CB2 IRQs
1030 .exit3
1040 PLP:RTS
1050 :
1060 \ Interrupt routine
1070 .newirq
1080 LDA &FE6D:BPL do_old
1090 AND #&18:BNE mouse_via :\ Mouse movement
1100 .do_old
1110 JMP (oldvecs)
1120 .mouse_via
1130 CLD:LDA &FC:PHA
1140 TXA:PHA:TYA:PHA
1150 LDA &FE6D:LDY &FE60 :\ Get axis again+direction
1160 AND #&18:STA &FE6D :\ Ack. mouse IRQ
1170 CMP #&10:BCS do_X :\ %xxx0xxxx - must be move X
1180 PHA:TYA:LSR A
1190 .chk_dir
1200 LSR A :\ NOP out with Compact
1210 LDX #2:SEC:JSR change :\ Update Y position
1220 PLA:CMP #&18:BNE done :\ %xxx10xxx - no X movement
1230 .do_X
1240 TYA:LDX #0:CLC:JSR change :\ Update X position
1250 .done
1260 PLA:TAY:PLA:TAX:PLA:RTI
1270 :
1280 \ Update position
1290 \ A=direction, X=posn offset, CC=max=&500, CS=max=&400
1300 .change
1310 AND #1:BEQ chg_decr :\ AND #1 for BBC/M, AND #8 for Compact
1320 .chg_incr
1330 PHP:CLC
1340 LDA posn+0,X:ADC #4:STA posn+0,X
1350 LDA posn+1,X:ADC #0:STA posn+1,X
1360 PLP:ADC #0:CMP #5:BNE chg_ok
1370 .chg_decr
1380 SEC
1390 LDA posn+0,X:SBC #4:STA posn+0,X
1400 LDA posn+1,X:SBC #0:STA posn+1,X
1410 BMI chg_incr
1420 .chg_ok
1430 RTS
1440 :
1450 \ Routines to read mouse
1460 .read_mouse
1470 TXA:PHA:TYA:PHA
1480 LDA #&86:JSR OSBYTE :\ Get text X,Y
1490 PLA:STA &F1:PLA:STA &F0
1500 TYA:LDY #5:STA (&F0),Y :\ Store text X,Y
1510 TXA:DEY:STA (&F0),Y:DEY
1520 PHP:SEI :\ Prevent IRQs while reading position
1530 .rd_ms_lp
1540 LDA posn,Y:STA (&F0),Y :\ Copy mouse X,Y
1550 DEY:BPL rd_ms_lp
1560 PLP:LDY #6:LDA &FE60 :\ Get mouse buttons
1570 .rd_buttons
1580 NOP:NOP:NOP:NOP :\ Change to ROR A when Compact
1590 AND #&E0:STA (&F0),Y
1600 LDA #64:LDX &F0:LDY &F1
1610 RTS
1620 :
1630 .newword
1640 CMP #64:BEQ read_mouse
1650 JMP (oldvecs+4)
1660 .newbyte
1670 CMP #&80:BEQ rd_posn :\ ADVAL
1680 CMP #&81:BEQ rd_key :\ INKEY
1690 .do_old_byte
1700 JMP (oldvecs+2)
1710 :
1720 .rd_posn
1730 \ Bug in documentation, BASIC only passes X, Y must be ignored
1740 CPX #7:BCC do_old_byte :\ ADVAL<7
1750 CPX #9:BCS do_old_byte :\ ADVAL>8
1760 PHP:SEI:TXA:ASL A:TAX :\ Prevent IRQs while reading position
1770 LDY posn-13,X :\ ADVAL(7)/ADVAL(8)
1780 LDA posn-14,X:TAX
1790 PLP:RTS
1800 .rd_key
1810 CPY #&FF:BNE do_old_byte
1820 CPX #&93:BCC do_old_byte
1830 CPX #&96:BCC rd_key2
1840 CPX #&F4:BCC do_old_byte
1850 CPX #&F7:BCS do_old_byte
1860 DEX:.rd_key2
1870 TXA:AND #&9F:SBC #&92:EOR #3
1880 CMP #3:ADC #0
1890 .rd_key3
1900 ROR A:ROR A:ROR A:ROR A :\ NOP these out for Compact
1910 AND &FE60
1920 CMP #1:LDA #0:ADC #&FF
1930 TAX:TAY:RTS
1940 ]:ld1%=exit2:ld2%=P%-256
1950 NEXT
1960 B%=0:FOR A%=exit2-(load%AND&FFFF)+mcode% TO O%-1:IF ?A%=&FE:B%=B%+1:NEXT ELSE NEXT
1970 IF B%<>8:PRINT"ERROR: Too many &FE bytes":END
1980 PRINT"*SAVE Mouse ";~mcode%;" ";~O%;" ";~exec%OR&FFFF0000;" ";~load%