Glitch-free controller reads with DMC?

Discuss technical or other issues relating to programming the Nintendo Entertainment System, Famicom, or compatible systems. See the NESdev wiki for more information.

Moderator: Moderators

Pokun
Posts: 2681
Joined: Tue May 28, 2013 5:49 am
Location: Hokkaido, Japan

Re: Glitch-free controller reads with DMC?

Post by Pokun »

Ah I see, that's really too bad.
User avatar
rainwarrior
Posts: 8734
Joined: Sun Jan 22, 2012 12:03 pm
Location: Canada
Contact:

Re: Glitch-free controller reads with DMC?

Post by rainwarrior »

Ben Boldt wrote: Fri Feb 18, 2022 4:51 am
rainwarrior wrote: Fri Feb 18, 2022 12:17 am For NESert Golfing I had it look for the mouse on both d0 and d1 on both ports at startup, and just use the one it found after that.
I was thinking of doing exactly that. It makes it so that you can’t hot-plug the mouse, but I think it’s probably not a great idea to hot-plug it anyway.

Did you initialize the tracking speed as part of this process? Would like to see and use your code into this Shanghai II hack with your permission.
The relevant code is here, if you want to review/borrow it: https://github.com/bbbradsmith/NESertGo ... olf.s#L948

I did set the speed to medium during initialization, but it was important to have it give up after a few tries because the hyperkin mouse's sensitivity can't be software cycled. (It has two sensitivities, toggled by a button on the bottom of the mouse.)

I don't have any suggestions about how to support the hyperkin with active DPCM, though. That problem seems a bit difficult.
Fiskbit
Posts: 891
Joined: Sat Nov 18, 2017 9:15 pm

Re: Glitch-free controller reads with DMC?

Post by Fiskbit »

Here's another attempt at synced mouse reading code. It requires page crossing, so keep that in mind. It can work with whatever mouse bit has been set in mouse_mask, but additional initialization code needs to be run that will find where the mouse is mapped, presumably by looking for 8 0's, ignoring 4 bits, and then the 0001 signature. The code also has appropriate delays for the Hyperkin mouse of at least 14 cycles between each read and 28 cycles between the middle 2 bytes. So, assuming this works correctly, it should be compatible with any mouse configuration.

Because the code is so much longer, it now has to deal with desyncs from both rate F and rate E. These are set to avoid the read cycle, which will be a put instead of get in these desync cases.

Code: Select all

; These must be zero page and contiguous.
mouse_x: .res 1
mouse_y: .res 1
mouse_buttons: .res 1

mouse_mask: .res 1

  LDX #$01
  STX mouse_x
  STX mouse_y
  STX mouse_buttons
  STX JOYPAD1
  LDA #$00
  STA JOYPAD1

  INX  ; LDX #$02
  LDY #$08

  LDA #>oam_buffer
  STA OAM_DMA

  ; X == 2.

  ; Rate F has a bad cycle 432 cycles from here.
  ; Rate E has a bad cycle 576 cycles from here.
               ; PUT GET PUT GET

  BIT $00      ; get put get

 :
  LDA JOYPAD2          ; put get put GET
  AND mouse_mask       ; put get put
  BNE MouseReadFailed  ; get put
  DEY                  ; get put
  BNE :-               ; get put (get)

  BIT $00              ; get put get
  NOP                  ; put get
  NOP                  ; put get

  ; 121 cycles so far. 125 in the bad case.

 :
  LDA JOYAPD2     ; put get put GET  ; Desynced rate F lands on the 2nd cycle.
  AND mouse_mask  ; put get put
  CMP #$01        ; get put
  ROL <>mouse_x,X ; get put get put get PUT get
  BCC :-          ; put get (put get)  MUST CROSS PAGE BOUNDARY  ; Desynced rate E lands on the 4th cycle.
  NOP             ; put get
  DEX             ; put get
  BPL :-          ; put get (put get)  MUST CROSS PAGE BOUNDARY

  ; Synced region is 597 cycles, plus any DMA time.
User avatar
Ben Boldt
Posts: 1149
Joined: Tue Mar 22, 2016 8:27 pm
Location: Minnesota, USA

Re: Glitch-free controller reads with DMC?

Post by Ben Boldt »

I will give this a try. Are page boundaries every $100 bytes if I recall? For example, $90FF to $9100 would cross a page boundary?
Fiskbit
Posts: 891
Joined: Sat Nov 18, 2017 9:15 pm

Re: Glitch-free controller reads with DMC?

Post by Fiskbit »

Yes. Any forward or backward branch that results in a different page number for the next instruction as compared to the branch not being taken is a page crossing.
User avatar
Jarhmander
Formerly ~J-@D!~
Posts: 569
Joined: Sun Mar 12, 2006 12:36 am
Location: Rive nord de Montréal

Re: Glitch-free controller reads with DMC?

Post by Jarhmander »

IIRC, if the branch instruction is the last of its page, there's no forward page crossing, because then PC point to the new page after fetching the instruction?
((λ (x) (x x)) (λ (x) (x x)))
User avatar
Ben Boldt
Posts: 1149
Joined: Tue Mar 22, 2016 8:27 pm
Location: Minnesota, USA

Re: Glitch-free controller reads with DMC?

Post by Ben Boldt »

That’s interesting because a branch offset 0 would then stay already on the next page if you position that right, even though the instruction itself is on the previous page. So following a negative offset in that same case would cross the page boundary twice? This is some pretty cool stuff, glad you guys are so good at this.
User avatar
Jarhmander
Formerly ~J-@D!~
Posts: 569
Joined: Sun Mar 12, 2006 12:36 am
Location: Rive nord de Montréal

Re: Glitch-free controller reads with DMC?

Post by Jarhmander »

Yeah but page crossing due to normal PC incrementation has no special effect, only for (taken) branches. And the effect is not just one more CPU cycle, it affects interrupt timing... Though now that I read it, the IRQ/NMI is delayed when not crossing pages on taken branches...
((λ (x) (x x)) (λ (x) (x x)))
User avatar
Ben Boldt
Posts: 1149
Joined: Tue Mar 22, 2016 8:27 pm
Location: Minnesota, USA

Re: Glitch-free controller reads with DMC?

Post by Ben Boldt »

Does IRQ itself cause any special cycle/DMA alignment from the beginning of the IRQ handler?
User avatar
Jarhmander
Formerly ~J-@D!~
Posts: 569
Joined: Sun Mar 12, 2006 12:36 am
Location: Rive nord de Montréal

Re: Glitch-free controller reads with DMC?

Post by Jarhmander »

Not that I know of, and I don't see why it would.
((λ (x) (x x)) (λ (x) (x x)))
Fiskbit
Posts: 891
Joined: Sat Nov 18, 2017 9:15 pm

Re: Glitch-free controller reads with DMC?

Post by Fiskbit »

If the IRQ is a result of DMC DMA, it will occur shortly after a DMA, so the two can't ever collide, though you'll need to make sure that the time lost to that interrupt is an even number of cycles, not odd. Otherwise, sync will be lost. If the IRQ comes from a non-DMA source, maintaining sync is incredibly difficult because the interrupt has 3 consecutive write cycles, and would need to be aligned such that the middle write cycle is a put. If the 1st and 3rd are puts, instead, then a DMA landing on either one will take 3 cycles, not 4, breaking sync. This write alignment depends on which instruction boundary the interrupt occurred at.

Even if you're sure that the write cycles are never an issue, the interrupts are a problem for any synced code close to the minimum DMA period length or longer because the time stolen by the interrupt will change the timing of the desynced DMA cycle from DMC DMA landing near the end of OAM DMA. Given these caveats, I would strongly recommend keeping synced code of around 400 cycles or longer (actual length depending on your handler) away from any IRQ source.
User avatar
Ben Boldt
Posts: 1149
Joined: Tue Mar 22, 2016 8:27 pm
Location: Minnesota, USA

Re: Glitch-free controller reads with DMC?

Post by Ben Boldt »

Thanks for the explanation about how IRQs work (erm, don't work) with this.

I updated the ROM with your latest source and added some init code. The ROM runs but is now incredibly slow. The mouse does not work anymore with this, but it is running the code. I probably screwed something up but not sure what it could be. I have just only a few hooks into the original game, those seem to be working OK. Those hooks are done by hand and not really shown in the source code (below). I compiled this with asm6. Seems asm6 doesn't support anonymous labels or that explicit non-zero-page ROL.

Code: Select all

BUTTON_DIFFS    equ $7B
MOUSE_MASK      equ $7C
MOUSE_X         equ $7D
MOUSE_Y         equ $7E
MOUSE_BUTTONS   equ $7F

JOY1            equ $4016
JOY2_FRAME      equ $4017
PPU_OAM_ADDR    equ $2003
OAM_DMA         equ $4014

org $8EF0 ; this is here to offset the built code so as to paste it directly starting at ROM file offset $CF00.
hex 00  ; placeholder
org $8FCA ; tweak this to offset everything for the necessary page boundary.
MouseReadFailed:
        RTS
MouseReadEntry: ; This is CPU address $8FCB.
        LDA MOUSE_BUTTONS
        PHA  ; keep a copy of the old mouse buttons on the stack.
        LDX #$01
        STX MOUSE_X
        STX MOUSE_Y
        STX MOUSE_BUTTONS
        STX JOY1
        LDA #$00
        STA JOY1
        INX ; LDX #$02
        LDY #$08
        LDA #$02  ;#>oam_buffer
        STA OAM_DMA
        ; X == 2.
        ; Rate F has a bad cycle 432 cycles from here.
        ; Rate E has a bad cycle 576 cycles from here.
        ; PUT GET PUT GET
        BIT $00 ; get put get
fiskloop:
        LDA JOY2_FRAME ; put get put GET
        AND MOUSE_MASK ; put get put
        BNE MouseReadFailed ; get put
        DEY ; get put
        BNE fiskloop ; get put (get)
        BIT $00 ; get put get
        NOP ; put get
        NOP ; put get
        ; 121 cycles so far. 125 in the bad case.
        :
        LDA JOY2_FRAME ; put get put GET ; Desynced rate F lands on the 2nd cycle.
        AND MOUSE_MASK ; put get put
        CMP #$01 ; get put
hex 3e 7d 00 ; ROL <>mouse_x,X ; get put get put get PUT get
        BCC fiskloop ; put get (put get) MUST CROSS PAGE BOUNDARY ; Desynced rate E lands on the 4th cycle.
        NOP ; put get
        DEX ; put get
        BPL fiskloop ; put get (put get) MUST CROSS PAGE BOUNDARY
        ; Synced region is 597 cycles, plus any DMA time.
        
        
        
        
        
        
; use the X/Y data that came from the mouse:
check_x:
        LDA MOUSE_X
        BEQ check_y
        BMI left
right:
        LDA #$F8  ; limit going right.
        SEC
        SBC $32
        CMP MOUSE_X
        BCC right_limit
        ; carry is always 1 here
        LDA MOUSE_X
        CLC
        ADC $0032
        STA $0032
        ;CLC ; carry is always 0 because we already ensured the result won't go past the limit.
        BCC check_y
right_limit
        LDA #$F8
        STA #$0032
        ;CLC ; carry is always 0 because the CMP result rolled negative.
        BCC check_y
left:
        ASL
        LSR
        STA MOUSE_X
        
        lda $32
        sec
        sbc #$08
        cmp MOUSE_X

        BCC left_limit
        ; carry is 0 here.
        LDA $0032
        SEC
        SBC MOUSE_X
        STA $0032
        CLC ; carry is always 1 because we already ensured the result won't go past the limit.
        BCC check_y
left_limit:
        LDA #$08
        STA #$0032


check_y:
        LDA MOUSE_Y
        BEQ exit
        BMI up
down:
        LDA #$E8  ; limit going down.
        SEC
        SBC $31
        CMP MOUSE_Y
        BCC down_limit
        ; carry is always 1 here
        LDA MOUSE_Y
        CLC
        ADC $31
        STA $31
        ;CLC ; carry is always 0 because we already ensured the result won't go past the limit.
        BCC exit
down_limit
        LDA #$E8
        STA #$31
        ;CLC ; carry is always 0 because the CMP result rolled negative.
        BCC exit
up:
        ASL
        LSR
        STA MOUSE_Y
        
        lda $31
        sec
        sbc #$08
        cmp MOUSE_Y

        BCC up_limit
        ; carry is 0 here.
        LDA $31
        SEC
        SBC MOUSE_Y
        STA $31
        CLC ; carry is always 1 because we already ensured the result won't go past the limit.
        BCC exit
up_limit:
        LDA #$08
        STA #$31
        
exit:
        
update_button_diffs:
        PLA
        EOR MOUSE_BUTTONS
        AND MOUSE_BUTTONS
        ROL
        ROL
        ROL
        AND #$03
        STA BUTTON_DIFFS
        rts
        
org $9100
; External call that combines controller button handling with mouse button handling:
apply_mouse_button_diffs:
        jsr $c155  ; Call original controller read code.
        lda $29
        ora BUTTON_DIFFS
        sta $29
        
        lda $2b
        ora BUTTON_DIFFS
        sta $2b
        rts

org $9120
; Initialization stuff below:
cycle_mouse_sensitivity:
        ldy #$01
        sty JOY1
        lda JOY1
        dey
        sty JOY1
        rts

org $9140
find_mice:
        lda #$03
        sta MOUSE_MASK
find_mice_again:
        ldy #$01
        sty JOY1
        dey
        sty JOY1
        lda #$00
        ORA JOY2_FRAME ; make sure the first byte is $00.
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        EOR #$FF  ; invert.  Bits 0 and 1 = 1 now indicate each mouse exists (so far).
        AND MOUSE_MASK
        AND #$03  ; mask off the extra bits
        STA MOUSE_MASK
        BNE check_mice_byte_2
        JMP $C001  ; jump to original reset vector ; No mice found.
check_mice_byte_2:
        ldy #$08
check_mice_byte_2_loop:
        LDA JOY2_FRAME
        LSR
        ROL MOUSE_X  ; store the "buttons" byte of mouse 0 into MOUSE_X.
        LSR
        ROL MOUSE_Y  ; store the "buttons" byte of mouse 1 into MOUSE_Y.
        dey
        bne check_mice_byte_2_loop
        
check_mouse_0_signature:
        lda MOUSE_MASK
        and #$01
        beq check_mouse_1_signature  ; Mouse 0 is already not a mouse because the first byte wasn't $00.
        lda MOUSE_X  ; check the lower nybble of the 2nd byte for signature $1.
        AND #$0F
        CMP #$01
        BEQ mouse_0_found
        LDA MOUSE_MASK
        AND #$FE  ; Clear the bit that says mouse 0 exists.
        STA MOUSE_MASK
        JMP check_mouse_1_signature
mouse_0_found:
        LDA MOUSE_X  ; Check that sensitivity is 0.
        AND #$30
        BEQ exit_find_mice  ; if so, exit.  Don't even check mouse 1 because 2 mice at the same time are not supported.
        JSR cycle_mouse_sensitivity  ; if not, cycle and try again.
        JMP find_mice
check_mouse_1_signature:
        lda MOUSE_MASK
        and #$02
        beq exit_find_mice  ; Mouse 1 is already not a mouse because the first byte wasn't $00.
        lda MOUSE_Y  ; check the lower nybble of the 2nd byte for signature $1.
        AND #$0F
        CMP #$01
        BEQ mouse_1_found
        LDA MOUSE_MASK
        AND #$FE  ; Clear the bit that says mouse 1 exists.
        STA MOUSE_MASK
        JMP exit_find_mice
mouse_1_found:
        LDA MOUSE_Y  ; Check that sensitivity is 0.
        AND #$30
        BEQ exit_find_mice  ; if so, exit.
        JSR cycle_mouse_sensitivity  ; if not, cycle and try again.
        JMP find_mice
        
exit_find_mice:
        JMP $C001  ; jump to original reset vector


org $9300  ; This gets pasted into page F, near the very end of the ROM file.  I put it here for convenience to copy/paste from generated bin file.
init_mouse:  ; Reset vector points here.
        SEI  ; disable IRQ
        CLD  ; disable decimal mode
        LDA #$03  ; Set PRG page to 03, so as to access the following functions.
        STA $C000
        JSR cycle_mouse_sensitivity  ; An initial mouse sensitivity cycle may be necessary to make the mouse work properly.
        JMP find_mice
        
Shanghai 2 (J) - Mouse Init.ips
(456 Bytes) Downloaded 45 times

Edit: oh boy, there are some bugs with my code. First of all, I init the mouse BEFORE the game wipes the RAM. Derrrr…. Also, my code appears to end up with mouse mask 03, which would be both possible mice at the same time. But that gets wiped to 00 by the ram init anyway. Poking that value to 01 while running lands me off the rails at a bad opcode. Sooo, more work to be done on this from my end.


Edit 2:
Okay, I fixed some bugs. I had an issue where the fail case of your code (Fiskbit), I did not pop back from the stack, which corrupted it. That's how it went off the rails. The init code still doesn't seem to work right, but poking at the $7C directly changes the mouse mask with interesting effects. Changing it to $01 should in theory work like normal with the NES controller 2 port (like before). The game speeds up to normal speed when you do this now but the mouse doesn't move. So still something not quite right, but getting better.

New code:

Code: Select all

BUTTON_DIFFS    equ $7B
MOUSE_MASK      equ $7C
MOUSE_X         equ $7D
MOUSE_Y         equ $7E
MOUSE_BUTTONS   equ $7F

JOY1            equ $4016
JOY2_FRAME      equ $4017
PPU_OAM_ADDR    equ $2003
OAM_DMA         equ $4014

org $8EF0 ; this is here to offset the built code so as to paste it directly starting at ROM file offset $CF00.
hex 00  ; placeholder
org $8FC9
MouseReadFailed:
        PLA
        RTS
MouseReadEntry: ; This is CPU address $8FCB.
        LDA MOUSE_BUTTONS
        PHA  ; keep a copy of the old mouse buttons on the stack.
        LDX #$01
        STX MOUSE_X
        STX MOUSE_Y
        STX MOUSE_BUTTONS
        STX JOY1
        LDA #$00
        STA JOY1
        INX ; LDX #$02
        LDY #$08
        LDA #$02  ;#>oam_buffer
        STA OAM_DMA
        ; X == 2.
        ; Rate F has a bad cycle 432 cycles from here.
        ; Rate E has a bad cycle 576 cycles from here.
        ; PUT GET PUT GET
        BIT $00 ; get put get
fiskloop:
        LDA JOY2_FRAME ; put get put GET
        AND MOUSE_MASK ; put get put
        BNE MouseReadFailed ; get put
        DEY ; get put
        BNE fiskloop ; get put (get)
        BIT $00 ; get put get
        NOP ; put get
        NOP ; put get
        ; 121 cycles so far. 125 in the bad case.
        :
        LDA JOY2_FRAME ; put get put GET ; Desynced rate F lands on the 2nd cycle.
        AND MOUSE_MASK ; put get put
        CMP #$01 ; get put
hex 3e 7d 00 ; ROL <>mouse_x,X ; get put get put get PUT get
        BCC fiskloop ; put get (put get) MUST CROSS PAGE BOUNDARY ; Desynced rate E lands on the 4th cycle.
        NOP ; put get
        DEX ; put get
        BPL fiskloop ; put get (put get) MUST CROSS PAGE BOUNDARY
        ; Synced region is 597 cycles, plus any DMA time.
        
        
        
        
        
        
; use the X/Y data that came from the mouse:
check_x:
        LDA MOUSE_X
        BEQ check_y
        BMI left
right:
        LDA #$F8  ; limit going right.
        SEC
        SBC $32
        CMP MOUSE_X
        BCC right_limit
        ; carry is always 1 here
        LDA MOUSE_X
        CLC
        ADC $0032
        STA $0032
        ;CLC ; carry is always 0 because we already ensured the result won't go past the limit.
        BCC check_y
right_limit
        LDA #$F8
        STA #$0032
        ;CLC ; carry is always 0 because the CMP result rolled negative.
        BCC check_y
left:
        ASL
        LSR
        STA MOUSE_X
        
        lda $32
        sec
        sbc #$08
        cmp MOUSE_X

        BCC left_limit
        ; carry is 0 here.
        LDA $0032
        SEC
        SBC MOUSE_X
        STA $0032
        CLC ; carry is always 1 because we already ensured the result won't go past the limit.
        BCC check_y
left_limit:
        LDA #$08
        STA #$0032


check_y:
        LDA MOUSE_Y
        BEQ exit
        BMI up
down:
        LDA #$E8  ; limit going down.
        SEC
        SBC $31
        CMP MOUSE_Y
        BCC down_limit
        ; carry is always 1 here
        LDA MOUSE_Y
        CLC
        ADC $31
        STA $31
        ;CLC ; carry is always 0 because we already ensured the result won't go past the limit.
        BCC exit
down_limit
        LDA #$E8
        STA #$31
        ;CLC ; carry is always 0 because the CMP result rolled negative.
        BCC exit
up:
        ASL
        LSR
        STA MOUSE_Y
        
        lda $31
        sec
        sbc #$08
        cmp MOUSE_Y

        BCC up_limit
        ; carry is 0 here.
        LDA $31
        SEC
        SBC MOUSE_Y
        STA $31
        CLC ; carry is always 1 because we already ensured the result won't go past the limit.
        BCC exit
up_limit:
        LDA #$08
        STA #$31
        
exit:
        
update_button_diffs:
        PLA
        EOR MOUSE_BUTTONS
        AND MOUSE_BUTTONS
        ROL
        ROL
        ROL
        AND #$03
        STA BUTTON_DIFFS
        rts
        
org $9100
; External call that combines controller button handling with mouse button handling:
apply_mouse_button_diffs:
        jsr $c155  ; Call original controller read code.
        lda $29
        ora BUTTON_DIFFS
        sta $29
        
        lda $2b
        ora BUTTON_DIFFS
        sta $2b
        rts

org $9120
; Initialization stuff below:
cycle_mouse_sensitivity:
        ldy #$01
        sty JOY1
        lda JOY1
        dey
        sty JOY1
        rts

org $9140
find_mice:
        lda #$03
        sta MOUSE_MASK
find_mice_again:
        ldy #$01
        sty JOY1
        dey
        sty JOY1
        lda #$00
        ORA JOY2_FRAME ; make sure the first byte is $00.
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        EOR #$FF  ; invert.  Bits 0 and 1 = 1 now indicate each mouse exists (so far).
        AND MOUSE_MASK
        AND #$03  ; mask off the extra bits
        STA MOUSE_MASK
        BNE check_mice_byte_2
        rts  ; No mice found.
check_mice_byte_2:
        ldy #$08
check_mice_byte_2_loop:
        LDA JOY2_FRAME
        LSR
        ROL MOUSE_X  ; store the "buttons" byte of mouse 0 into MOUSE_X.
        LSR
        ROL MOUSE_Y  ; store the "buttons" byte of mouse 1 into MOUSE_Y.
        dey
        bne check_mice_byte_2_loop
        
check_mouse_0_signature:
        lda MOUSE_MASK
        and #$01
        beq check_mouse_1_signature  ; Mouse 0 is already not a mouse because the first byte wasn't $00.
        lda MOUSE_X  ; check the lower nybble of the 2nd byte for signature $1.
        AND #$0F
        CMP #$01
        BEQ mouse_0_found
        LDA MOUSE_MASK
        AND #$FE  ; Clear the bit that says mouse 0 exists.
        STA MOUSE_MASK
        JMP check_mouse_1_signature
mouse_0_found:
        LDA MOUSE_X  ; Check that sensitivity is 0.
        AND #$30
        BEQ exit_find_mice  ; if so, exit.  Don't even check mouse 1 because 2 mice at the same time are not supported.
        JSR cycle_mouse_sensitivity  ; if not, cycle and try again.
        JMP find_mice_again
check_mouse_1_signature:
        lda MOUSE_MASK
        and #$02
        beq exit_find_mice  ; Mouse 1 is already not a mouse because the first byte wasn't $00.
        lda MOUSE_Y  ; check the lower nybble of the 2nd byte for signature $1.
        AND #$0F
        CMP #$01
        BEQ mouse_1_found
        LDA MOUSE_MASK
        AND #$FE  ; Clear the bit that says mouse 1 exists.
        STA MOUSE_MASK
        JMP exit_find_mice
mouse_1_found:
        LDA MOUSE_Y  ; Check that sensitivity is 0.
        AND #$30
        BEQ exit_find_mice  ; if so, exit.
        JSR cycle_mouse_sensitivity  ; if not, cycle and try again.
        JMP find_mice_again
        
exit_find_mice:
        lda MOUSE_MASK
        cmp #$03
        bne not2mice
        lda #$01  ; Default to mouse 0 if it found both mice.
        sta MOUSE_MASK
not2mice:
        RTS


org $9300  ; This gets pasted into page F, near the very end of the ROM file.  I put it here for convenience to copy/paste from generated bin file.
init_mouse:  ; This gets pasted at $FF61 = ROM 0x1ff71
        LDA #$03  ; Set PRG page to 03, so as to access the following functions.
        STA $C000
        JSR cycle_mouse_sensitivity  ; An initial mouse sensitivity cycle may be necessary to make the mouse work properly.
        JSR find_mice
        RTS
Shanghai 2 (J) - Mouse Init try 2.ips
(460 Bytes) Downloaded 44 times
I am already thinking how SimCity could be hacked like this. Sounds cool too but not to get too far ahead of ourselves.
User avatar
Ben Boldt
Posts: 1149
Joined: Tue Mar 22, 2016 8:27 pm
Location: Minnesota, USA

Re: Glitch-free controller reads with DMC?

Post by Ben Boldt »

I think I have most of the bugs fixed now, there were a few! Everything seems to work correctly now.

Code: Select all

BUTTON_DIFFS    equ $7B
MOUSE_MASK      equ $7C
MOUSE_X         equ $7D
MOUSE_Y         equ $7E
MOUSE_BUTTONS   equ $7F

JOY1            equ $4016
JOY2_FRAME      equ $4017
PPU_OAM_ADDR    equ $2003
OAM_DMA         equ $4014

org $8EF0 ; this is here to offset the built code so as to paste it directly starting at ROM file offset $CF00.
hex 00  ; placeholder
org $8FC9
MouseReadFailed:
        PLA
        RTS
MouseReadEntry: ; This is CPU address $8FCB.
        LDA MOUSE_BUTTONS
        PHA  ; keep a copy of the old mouse buttons on the stack.
        LDX #$01
        STX MOUSE_X
        STX MOUSE_Y
        STX MOUSE_BUTTONS
        STX JOY1
        LDA #$00
        STA JOY1
        INX ; LDX #$02
        LDY #$08
        LDA #$02  ;#>oam_buffer
        STA OAM_DMA
        ; X == 2.
        ; Rate F has a bad cycle 432 cycles from here.
        ; Rate E has a bad cycle 576 cycles from here.
        ; PUT GET PUT GET
        BIT $00 ; get put get
fiskloop1:
        LDA JOY2_FRAME ; put get put GET
        AND MOUSE_MASK ; put get put
        BNE MouseReadFailed ; get put
        DEY ; get put
        BNE fiskloop1 ; get put (get)
        BIT $00 ; get put get
        NOP ; put get
        NOP ; put get
        ; 121 cycles so far. 125 in the bad case.
fiskloop2:
        LDA JOY2_FRAME ; put get put GET ; Desynced rate F lands on the 2nd cycle.
        AND MOUSE_MASK ; put get put
        CMP #$01 ; get put
hex 3e 7d 00 ; ROL <>mouse_x,X ; get put get put get PUT get
        BCC fiskloop2 ; put get (put get) MUST CROSS PAGE BOUNDARY ; Desynced rate E lands on the 4th cycle.
        NOP ; put get
        DEX ; put get
        BPL fiskloop2 ; put get (put get) MUST CROSS PAGE BOUNDARY
        ; Synced region is 597 cycles, plus any DMA time.
        
        
        
        
        
        
; use the X/Y data that came from the mouse:
check_x:
        LDA MOUSE_X
        BEQ check_y
        BMI left
right:
        LDA #$F8  ; limit going right.
        SEC
        SBC $32
        CMP MOUSE_X
        BCC right_limit
        ; carry is always 1 here
        LDA MOUSE_X
        CLC
        ADC $0032
        STA $0032
        ;CLC ; carry is always 0 because we already ensured the result won't go past the limit.
        BCC check_y
right_limit
        LDA #$F8
        STA #$0032
        ;CLC ; carry is always 0 because the CMP result rolled negative.
        BCC check_y
left:
        ASL
        LSR
        STA MOUSE_X
        
        lda $32
        sec
        sbc #$08
        cmp MOUSE_X

        BCC left_limit
        ; carry is 0 here.
        LDA $0032
        SEC
        SBC MOUSE_X
        STA $0032
        CLC ; carry is always 1 because we already ensured the result won't go past the limit.
        BCC check_y
left_limit:
        LDA #$08
        STA #$0032


check_y:
        LDA MOUSE_Y
        BEQ exit
        BMI up
down:
        LDA #$E8  ; limit going down.
        SEC
        SBC $31
        CMP MOUSE_Y
        BCC down_limit
        ; carry is always 1 here
        LDA MOUSE_Y
        CLC
        ADC $31
        STA $31
        ;CLC ; carry is always 0 because we already ensured the result won't go past the limit.
        BCC exit
down_limit
        LDA #$E8
        STA #$31
        ;CLC ; carry is always 0 because the CMP result rolled negative.
        BCC exit
up:
        ASL
        LSR
        STA MOUSE_Y
        
        lda $31
        sec
        sbc #$08
        cmp MOUSE_Y

        BCC up_limit
        ; carry is 0 here.
        LDA $31
        SEC
        SBC MOUSE_Y
        STA $31
        CLC ; carry is always 1 because we already ensured the result won't go past the limit.
        BCC exit
up_limit:
        LDA #$08
        STA #$31
        
exit:
        
update_button_diffs:
        PLA
        EOR MOUSE_BUTTONS
        AND MOUSE_BUTTONS
        ROL
        ROL
        ROL
        AND #$03
        STA BUTTON_DIFFS
        rts
        
org $9100
; External call that combines controller button handling with mouse button handling:
apply_mouse_button_diffs:
        jsr $c155  ; Call original controller read code.
        lda $29
        ora BUTTON_DIFFS
        sta $29
        
        lda $2b
        ora BUTTON_DIFFS
        sta $2b
        rts

org $9120
; Initialization stuff below:
cycle_mouse_sensitivity:
        ldy #$01
        sty JOY1
        lda JOY1
        dey
        sty JOY1
        rts

org $9140
find_mice:
        lda #$03
        sta MOUSE_MASK
find_mice_again:
        ldy #$01
        sty JOY1
        dey
        sty JOY1
        lda #$00
        ORA JOY2_FRAME ; make sure the first byte is $00.
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        ORA JOY2_FRAME
        EOR #$FF  ; invert.  Bits 0 and 1 = 1 now indicate each mouse exists (so far).
        AND MOUSE_MASK  ; mask off the extra bits
        STA MOUSE_MASK
        BNE check_mice_byte_2
        rts  ; No mice found.
check_mice_byte_2:
        ldy #$08
check_mice_byte_2_loop:
        LDA JOY2_FRAME
        LSR
        ROL MOUSE_X  ; store the "buttons" byte of mouse 0 into MOUSE_X.
        LSR
        ROL MOUSE_Y  ; store the "buttons" byte of mouse 1 into MOUSE_Y.
        dey
        bne check_mice_byte_2_loop
        
check_mouse_0_signature:
        lda MOUSE_MASK
        and #$01
        beq check_mouse_1_signature  ; Mouse 0 is already not a mouse because the first byte wasn't $00.
        lda MOUSE_X  ; check the lower nybble of the 2nd byte for signature $1.
        AND #$0F
        CMP #$01
        BEQ mouse_0_found
        LDA MOUSE_MASK
        AND #$FE  ; Clear the bit that says mouse 0 exists.
        STA MOUSE_MASK
        JMP check_mouse_1_signature
mouse_0_found:
        LDA MOUSE_X  ; Check that sensitivity is 0.
        AND #$30
        BEQ exit_find_mice  ; if so, exit.  Don't even check mouse 1 because 2 mice at the same time are not supported.
        JSR cycle_mouse_sensitivity  ; if not, cycle and try again.
        JMP find_mice_again
check_mouse_1_signature:
        lda MOUSE_MASK
        and #$02
        beq exit_find_mice  ; Mouse 1 is already not a mouse because the first byte wasn't $00.
        lda MOUSE_Y  ; check the lower nybble of the 2nd byte for signature $1.
        AND #$0F
        CMP #$01
        BEQ mouse_1_found
        LDA MOUSE_MASK
        AND #$FD  ; Clear the bit that says mouse 1 exists.
        STA MOUSE_MASK
        JMP exit_find_mice
mouse_1_found:
        LDA MOUSE_Y  ; Check that sensitivity is 0.
        AND #$30
        BEQ exit_find_mice  ; if so, exit.
        JSR cycle_mouse_sensitivity  ; if not, cycle and try again.
        JMP find_mice_again
        
exit_find_mice:
        lda MOUSE_MASK
        cmp #$03
        bne not2mice
        lda #$01  ; Default to mouse 0 if it found both mice.
        sta MOUSE_MASK
not2mice:
        RTS


org $9300  ; This gets pasted into page F, near the very end of the ROM file.  I put it here for convenience to copy/paste from generated bin file.
init_mouse:  ; This gets pasted at $FF61 = ROM 0x1ff71
        JSR $FC00
        LDA #$03  ; Set PRG page to 03, so as to access the following functions.
        STA $C000
        JSR cycle_mouse_sensitivity  ; An initial mouse sensitivity cycle may be necessary to make the mouse work properly.
        JSR find_mice
        RTS
Shanghai 2 (J) - Mouse v1.1.ips
(461 Bytes) Downloaded 41 times
I do not have any way to test a mouse connected to the Famicom expansion port. I have neither hardware nor emulator that can do that.
Pokun
Posts: 2681
Joined: Tue May 28, 2013 5:49 am
Location: Hokkaido, Japan

Re: Glitch-free controller reads with DMC?

Post by Pokun »

Oh I just realized that Mesen only supports the Mouse in the controller ports and in NES mode, what a shame. I guess I'll have to build that adapter.
User avatar
rainwarrior
Posts: 8734
Joined: Sun Jan 22, 2012 12:03 pm
Location: Canada
Contact:

Re: Glitch-free controller reads with DMC?

Post by rainwarrior »

I'm finally back at home so I can test this with my Famicom. Trying with it wired to $4017 d1...

(Using v1.1)

The SNES mouse seems to work well. It does appear to be on the slowest setting though. I'd recommend putting it to medium instead. I also notice that you can't start the game with the mouse from the title screen, though once you get to the first menu the buttons work there.

The Hyperkin mouse is not detected, so it doesn't work, but if I hotswap from the SNES mouse after booting, I can trick it into trying. This does mostly work but the cursor seems to jump halfway across the screen once every 10 or 20 seconds.
Post Reply