10 REM > ROMMouse/s 1.00
   20 REM Add mouse code to spare area in a ROM image
   30 REM 1.00 17-Mar-2006 J.G.Harston
   40 :
   50 DIM A%(4096):CLEAR:DIM mcode% &40FF
   60 rompath$=":System.ROMs.Filing.Disk.Acorn."
   70 OSASCI=&FFE3:OSNEWL=&FFE7:OSBYTE=&FFF4
   80 BYTEV=&20A:XBYTEV=&DAE:oldBYTEV=&D9B
   90 status=&DA5:posn=&DA6:flag=&DAA
  100 REM status: b7=enabled, b3-b0=speed
  110 REM flag:   b7=Compact, b3/b0=movement bits
  120 :
  130 INPUT "Source ROM: (RETURN for none) "rom$
  140 IF rom$<>"":IF INSTR(rom$,":"):rompath$=""
  150 IF rom$<>"":OSCLI"LOAD "+rompath$+rom$+" "+STR$~mcode%
  160 IF rom$<>"":OldService=mcode%!4 AND &FFFF
  170 IF rom$<>"":spare%=&4000:REPEAT:spare%=spare%-1:UNTILmcode%?spare%<>mcode%?&3FFF
  180 IF rom$="":spare%=-1
  190 spare%=spare%+&8001:PRINT"ROM space starts at &";~spare%
  200 IF spare%>&BCC9:PRINT"Not enough space":END
  210 header%=(spare%<&BCC9-49) OR rom$=""
  220 :
  230 len%=0:FOR pass%=((rom$<>""AND 2) TO 3
  240   P%=spare%+&100-128*(pass%AND2)
  250   O%=mcode%+spare%-&8000+len%*(pass%AND2)DIV2
  260   opt%=VALMID$("4647",pass%+1,1)
  270   PROCROMHeader
  280   [OPT opt%
  290   .Service%
  300   CMP #4:BNE P%+5:JMP Serv4
  310   CMP #5:BNE P%+5:JMP Serv5
  320   CMP #8:BNE P%+5:JMP Serv8
  330   CMP #9:BNE ServExit
  340   :
  350   .Serv9
  360   .Serv4
  370   PHA:TYA:PHA:LDX #0                    :\ Save registers
  380   LDA (&F2),Y:CMP #13:CLC:BEQ Serv9Help :\ *Help<cr>
  390   .Serv4Lp
  400   LDA (&F2),Y:INY
  410   CMP #ASC".":BEQ Serv4Found
  420   CMP HelpText+1,X:BEQ Serv4Next
  430   EOR #32
  440   CMP HelpText+1,X:BNE ServQuit
  450   .Serv4Next
  460   INX:CPX #5:BNE Serv4Lp                :\ Loop to match 5 characters
  470   LDA (&F2),Y:CMP #ASC"!":BCS ServQuit  :\ Not Mouse<cr> or Mouse<spc>
  480   .Serv4Found
  490   TSX:LDA &102,X:CMP #9:BNE Serv4Command:\ Not *Help Mouse
  500   .Serv9Help
  510   PHP                                   :\ Save short/full flag
  520   LDX #0:JSR PrintHelpText              :\ Print help title
  530   PLP:BCC ServQuit:JSR PrintHelpText    :\ Print detailed help
  540   .ServQuit
  550   PLA:TAY:PLA                           :\ Restore registers
  560   .ServExit
  570   RTS
  580   :
  590   .Serv4Command
  600   PLA:PLA:DEY                           :\ Drop saved Y, A
  610   .Serv4Spc
  620   INY:LDA (&F2),Y:CMP #32:BEQ Serv4Spc
  630   AND #&DF:CMP #ASC"O":BNE MouseOn
  640   INY:LDA (&F2),Y
  650   AND #&DF:CMP #ASC"F":BNE MouseOn
  660   :
  670   .MouseOff
  680   JSR ChkVector:BNE MouseOffExit  :\ Vector not claimed
  690   PHP:SEI
  700   LDA oldBYTEV+0:STA BYTEV+0      :\ Restore vector
  710   LDA oldBYTEV+1:STA BYTEV+1
  720   LDA #&18:STA &FE6E              :\ Disable CB1+CB2 IRQs
  730   LDA status:AND #&3F             :\ Flag mouse turned off
  740   BPL MouseDone
  750   .MouseOffExit
  760   BNE MouseExit
  770   :
  780   .MouseOn
  790   CLC:ADC #2:AND #&E4:TAY
  800   JSR ChkVector:BEQ MouseExit     :\ Vector already claimed
  810   LDX #3:.InitPosn
  820   TXA:AND #1:ASL A:STA posn,X     :\ Initialise position
  830   DEX:BPL InitPosn
  840   SEC:ROR posn                    :\ X=&280, Y=&200
  850   :
  860   LDA BYTEV+0:STA oldBYTEV+0      :\ Save old vectors
  870   LDA BYTEV+1:STA oldBYTEV+1
  880   :
  890   PHP:SEI                         :\ Disable IRQs while changing vectors
  900   LDA #15:STA BYTEV:LDA #&FF:STA BYTEV+1
  910   LDA MouseByteV+0:STA XBYTEV+0
  920   LDA MouseByteV+1:STA XBYTEV+1
  930   LDA &F4:STA XBYTEV+2
  940   :
  950   LDA #&98:STA &FE6E              :\ Enable CB1+CB2 IRQs
  960   LDA #&18:STA &FE6D              :\ Clear any pending CB1+2 IRQs
  970   LDA #&00:STA &FE62              :\ Data Direction=Input
  980   CPY #ASC"D":BEQ Compact         :\ Marconi is same pinout as Compact
  990   LDX #&FF:JSR OSBYTE             :\ A still &00 from above
 1000   LDA #&01:CPX #5:BNE NotCompact  :\ Not Master Compact
 1010   .Compact
 1020   LDA #&88                        :\ Set b7, Compact uses different pins
 1030   .NotCompact
 1040   STA flag                        :\ Save mouse flag
 1050   \ b7 = Compact/Marconi
 1060   \ b0 = AND #&01 for BBC/Master movement
 1070   \ b3 = AND #&08 for Compact movement
 1080   LDA #&92                        :\ Mouse on, speed=2
 1090   :
 1100   .MouseDone
 1110   STA status:PLP                  :\ Set mouse status, restore IRQs
 1120   \ b7    = Mouse ON
 1130   \ b0-b3 = Mouse Speed (unused)
 1140   .MouseExit
 1150   LDA #0:RTS                      :\ Claim call
 1160   :
 1170   .ChkVector
 1180   LDA BYTEV+0:CMP #&0F:BNE ChkOff
 1190   LDA BYTEV+1:CMP #&FF:BNE ChkOff
 1200   LDA XBYTEV+0:CMP MouseByteV+0:BNE ChkOff
 1210   LDA XBYTEV+1:CMP MouseByteV+1:BNE ChkOff
 1220   LDA XBYTEV+2:CMP &F4
 1230   .ChkOff
 1240   RTS
 1250   :
 1260   .PrintHelpText
 1270   LDA HelpText,X:BEQ PrintHelpOk
 1280   JSR OSASCI:INX:BNE PrintHelpText
 1290   .PrintHelpOk
 1300   INX:RTS
 1310   :
 1320   .HelpText
 1330   EQUB 13
 1340   EQUS "Mouse 1.00":EQUB 13:BRK
 1350   EQUS "  MOUSE [ON|OFF]":EQUB 13
 1360   EQUS "  ADVAL(7) returns mouse X position":EQUB 13
 1370   EQUS "  ADVAL(8) returns mouse Y position":EQUB 13
 1380   EQUS "  ADVAL(9) returns mouse buttons %rml":EQUB 13
 1390   EQUS "  INKEY-10,-11,-12 return mouse buttons l,m,r":EQUB 13
 1400   EQUS "  OSWORD 64 returns mouse X,Y text X,Y buttons":EQUB 13
 1410   BRK
 1420   :
 1430   INTERUPT - MOUSE MAY HAVE MOVED
 1440   \ ===============================
 1450   .Serv5
 1460   LDA status:BMI MouseIRQ  :\ Mouse enabled, check VIA
 1470   .Serv5Quit
 1480   LDA #5:RTS
 1490   .MouseIRQ
 1500   LDA &FE6D:LDY &FE60      :\ Get axis+direction
 1510   AND #&18:BEQ Serv5Quit   :\ Not mouse movement, ignore it
 1520   STA &FE6D                :\ Ack. mouse IRQ
 1530   \ Rest of code from *Mouse transient command
 1540   CMP #&10:BCS do_X
 1550   PHA:LDX #2:TYA:LSR A     :\ X=2 for Y coord
 1560   BIT flag:BMI dir_compact :\ Compact
 1570   LSR A
 1580   .dir_compact
 1590   SEC:JSR change
 1600   PLA:CMP #&18:BNE done
 1610   .do_X
 1620   LDX #0:TYA:CLC:JSR change :\ X=0 for X coord
 1630   .done
 1640   LDA #0:RTS
 1650   :
 1660   .change
 1670   PHP:AND flag:AND #&09:BEQ chg_decr
 1680   .chg_incr
 1690   CLC
 1700   LDA posn+0,X:ADC #4:STA posn+0,X  :\ inc position
 1710   LDA posn+1,X:ADC #0:STA posn+1,X
 1720   PLP:PHP:ADC #0:CMP #5:BNE chg_ok  :\ dec if out of range
 1730   .chg_decr
 1740   SEC
 1750   LDA posn+0,X:SBC #4:STA posn+0,X  :\ dec position
 1760   LDA posn+1,X:SBC #0:STA posn+1,X
 1770   BMI chg_incr                      :\ inc if out of range
 1780   .chg_ok
 1790   PLP:RTS
 1800   :
 1810   \ Mouse OSBYTE routine to read postion and buttons
 1820   \ ================================================
 1830   .MouseByteV
 1840   EQUW MouseByte
 1850   .MouseByte
 1860   CMP #&80:BEQ rd_posn     :\ ADVAL
 1870   CMP #&81:BEQ rd_key      :\ INKEY
 1880   .do_old_byte
 1890   JMP (oldBYTEV)
 1900   .rd_posn
 1910   \ Bug in documentation, BASIC only passes X, Y must be ignored
 1920   CPX #7:BCC do_old_byte   :\ ADVAL<7
 1930   CPX #9:BEQ rd_buttons    :\ ADVAL(9) - button state
 1940   BCS do_old_byte          :\ ADVAL>9
 1950   PHP:SEI:TXA:ASL A:TAX
 1960   LDY posn-13,X            :\ ADVAL(7)/ADVAL(8)
 1970   LDA posn-14,X:TAX
 1980   PLP:RTS
 1990   .rd_buttons              :\ ADVAL(9)
 2000   LDA &FE60:BIT flag:BMI rd_buttons_comp
 2010   ROL A:ROL A:ROL A:ROL A
 2020   .rd_buttons_comp
 2030   AND #7:EOR #7:TAX:LDY #0:RTS
 2040   .rd_key
 2050   CPY #&FF:BNE do_old_byte
 2060   CPX #&93:BCC do_old_byte
 2070   CPX #&96:BCC rd_key2
 2080   CPX #&F4:BCC do_old_byte
 2090   CPX #&F7:BCS do_old_byte
 2100   DEX:.rd_key2
 2110   TXA:AND #&9F:SBC #&92:EOR #3
 2120   CMP #3:ADC #0
 2130   .rd_key3
 2140   BIT flag:BMI rd_key_comp
 2150   ROR A:ROR A:ROR A:ROR A
 2160   .rd_key_comp
 2170   AND &FE60
 2180   CMP #1:LDA #0:ADC #&FF
 2190   TAX:TAY:RTS
 2200   :
 2210   \ SERVICE 8 - OSWORD
 2220   \ ==================
 2230   .Serv8
 2240   LDA &EF:CMP #64:BEQ read_mouse
 2250   .Serv8Quit
 2260   LDA #8:RTS
 2270   .read_mouse
 2280   LDA status:BPL Serv8Quit
 2290   LDA &F0:PHA:LDA &F1:PHA
 2300   LDA #&86:JSR OSBYTE
 2310   PLA:STA &F1:PLA:STA &F0
 2320   TYA:LDY #5:STA (&F0),Y
 2330   TXA:DEY:STA (&F0),Y:DEY
 2340   PHP:SEI
 2350   .rd_ms_lp
 2360   LDA posn,Y:STA (&F0),Y:DEY
 2370   BPL rd_ms_lp:PLP
 2380   LDY #6:LDA &FE60
 2390   BIT flag:BPL rd_ms_bbc
 2400   ROR A:ROR A:ROR A:ROR A
 2410   .rd_ms_bbc
 2420   STA (&F0),Y
 2430   LDA #0:RTS
 2440   :
 2450   .CodeEnd
 2460   ]
 2470   IF rom$="":len%=CodeEnd-Start%
 2480 NEXT
 2490 sfx$=""
 2500 IF rom$<>"":mcode%?4=Start%:mcode%?5=Start%DIV256
 2510 IF rom$="" :PROCMakeRelocTable:sfx$="ROM"
 2520 PRINT"*SAVE ";rom$;"Mse";sfx$;" ";~mcode%+len%;" ";STR$~O%;" 0 FFFBBC00"
 2530 END
 2540 :
 2550 DEFPROCROMHeader
 2560 [OPT opt%:.Start%:]
 2570 IF rom$="" :[OPT opt%:BRK:EQUW CodeEnd:]
 2580 IF rom$<>"":[OPT opt%:JSR OldService:]
 2590 IF NOT header%:ENDPROC
 2600 [OPT opt%
 2610 JMP Service%
 2620 EQUB &82:EQUB Copyright-Start%:EQUB &01
 2630 EQUS "Mouse":BRK:EQUS "1.00 (12 Mar 2006)"
 2640 .Copyright
 2650 BRK:EQUS "(C)J.G.Harston":BRK
 2660 ]:ENDPROC
 2670 :
 2680 DEFPROCMakeRelocTable
 2690 base80%=mcode%+len%:base81%=mcode%:byte%=0:count%=0:off%=0:REPEAT
 2700   byte80%=base80%?off%:byte81%=base81%?off%:IF off%>=len%:byte80%=&80:byte81%=&80
 2710   IF ((byte81%-byte80%) AND &FE)<>0 THEN PRINT "ERROR: Offset by more than one page at &";~&8000+off%
 2720   IF (byte80% AND &C0)=&80:byte%=byte%DIV2+128*(byte81%-byte80%):count%=count%+1
 2730   IF count%=8:?O%=byte%:O%=O%+1:byte%=0:count%=0
 2740 off%=off%+1:UNTILoff%>=len% AND count%=0
 2750 ENDPROC