;Shock collar debug program for Sega Genesis
;CC Furrtek 2012

    cpu 68000
    supmode on

WRAM           equ  $FF0000    ; Work RAM

DPORT          equ  $C00000    ; VDP Data
CPORT          equ  $C00004    ; VDP Command

 org    $0
 
; Vector table (most point to an RTS)

 dc.l   $00FFFFFE,     Start, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   HBlankInt, Interrupt, VBlankInt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.l   Interrupt, Interrupt, Interrupt, Interrupt
 dc.b   "SEGA MEGA DRIVE "
 dc.b   "GPL/AL 2011     "
 dc.b   "Joypad comm test for shock collar               "
 dc.b   "Joypad comm test for shock collar               "   ; Name (export)
 dc.b   "GM T-000006-01"                                     ; Serial
 dc.w   $0000
 dc.b   "                "
 dc.l   $00000000, $000003FF
 dc.l   $00FF0000, $00FFFFFF
 dc.l   $00000000, $00000000, $00000000
 dc.b   "            "
 dc.b   "D                                       "
 dc.b   "E               "

; Variables

     org WRAM
MENU:          ds.b 1
OLD_JP1:       ds.b 1
VBL:           ds.b 1
TIMER:         ds.w 1

     org $400

HBlankInt:
     rte
     
VBlankInt:
     st.b   VBL
     rte

Interrupt:
     rts

Start:
     move.w  #$2700,sr              ; No IRQs

     move.b  $A10001,d0             ; "SEGA" @ $A14000 if version > 0
     andi.b  #$0F,d0
     beq     .version_0
     move.l  $100,$A14000
.version_0:

     lea    VDPinit,a0              ; VDP registers init
     moveq  #19-1,d0
.initvdp:
     move.w (a0)+,CPORT
     dbra   d0,.initvdp

     lea    WRAM,a0                 ; Empties 4*$FF of RAM
     move.l #$FF-1,d0
.clram:
     clr.l  (a0)+
     dbra   d0,.clram

     move.l #$50000003,CPORT        ; VRAM WRITE @ $D000 (H Scroll tables)
     move.l #28-1,d0                ; 28 tile lines
.clscrolls:
     move.w #0,DPORT                ; Scroll A=0
     move.w #0,DPORT                ; Scroll B=0
     dbra   d0,.clscrolls
     
     move.l #$40000003,CPORT        ; VRAM Write @ $C000 (BG Map A)
     move.l #(64*32)-1,d0
.cltilesa:
     move.w #$8000,DPORT
     dbra   d0,.cltilesa

     move.l #$60000003,CPORT        ; VRAM Write @ $E000 (BG Map B)
     move.l #(64*32)-1,d0
.cltilesb:
     move.w #0,DPORT
     dbra   d0,.cltilesb

     move.l #$60000000,CPORT        ; VRAM Write @ $2000 (tile 256)
     lea    alpha,a0                ; Load alphabet
     move.l #(64*32/4)-1,d7         ; 64 tiles
.ldalpha:
     move.l (a0)+,DPORT
     dbra   d7,.ldalpha

     move.l #$C0000000,CPORT        ; CRAM Write (Color RAM)
     lea    palette,a1
     move.l #16-1,d0                ; 16 colors
.ldpal:
     move.w (a1)+,DPORT
     dbra   d0,.ldpal
     
     move.l #$42060003,CPORT        ; Title text
     lea    txt_title,a0
     jsr    disptext
     move.l #$4C240003,CPORT        ; Not even ashamed
     lea    txt_cc,a0
     jsr    disptext

     move.l #$44960003,CPORT        ; Short zap P1 text
     lea    txt_zap1s,a0
     jsr    disptext
     move.l #$45160003,CPORT        ; Short zap P2 text
     lea    txt_zap2s,a0
     jsr    disptext
     move.l #$45960003,CPORT        ; Short zap both text
     lea    txt_zap3s,a0
     jsr    disptext
     move.l #$46160003,CPORT        ; Zap P1 text
     lea    txt_zap1,a0
     jsr    disptext
     move.l #$46960003,CPORT        ; Zap P2 text
     lea    txt_zap2,a0
     jsr    disptext
     move.l #$47160003,CPORT        ; Zap both text
     lea    txt_zap3,a0
     jsr    disptext

     move.w #$2000, sr              ; IRQs on

; Main loop

.mainlp:
     tst.b  VBL
     beq    .mainlp                 ; Wait for VBlank
     clr.b  VBL

     tst.w  TIMER                   ; Don't touch timer if already at zero
     beq    .nodec
     subq.w #1,TIMER
     
     cmp.w  #150,TIMER              ; Display "THREE" if timer = 150
     bne    .no300
     move.l #$49160003,CPORT
     lea    txt_premier,a0
     jsr    disptext
     bra    .nodec
.no300:
     cmp.w  #100,TIMER              ; Display "TWO" if timer = 100
     bne    .no200
     move.l #$49220003,CPORT
     lea    txt_milieu,a0
     jsr    disptext
     bra    .nodec
.no200:
     cmp.w  #50,TIMER                Display "ONE" if timer = 50
     bne    .no100
     move.l #$492A0003,CPORT
     lea    txt_dernier,a0
     jsr    disptext
     bra    .nodec
.no100:
     cmp.w  #1,TIMER                ; Clear text if timer = 1 and...
     bne    .nodec
     move.l #$49160003,CPORT
     lea    txt_eff,a0
     jsr    disptext

     cmp.b  #0,MENU                 ; ...execute selection
     bne    .no0
     jsr    zap1s
.no0:
     cmp.b  #1,MENU
     bne    .no1
     jsr    zap2s
     bra    .nodec
.no1:
     cmp.b  #2,MENU
     bne    .no2
     jsr    zap1s
     jsr    zap2s
     bra    .nodec
.no2:
     cmp.b  #3,MENU
     bne    .no3
     jsr    zap1
     bra    .nodec
.no3:
     cmp.b  #4,MENU
     bne    .no4
     jsr    zap2
     bra    .nodec
.no4:
     cmp.b  #5,MENU
     bne    .nodec
     jsr    zap1
     jsr    zap2

.nodec:


     clr.l  d0                      ; Display arrow in front of selected item
     move.b MENU,d0
     lsl.w  #7,d0                   ; *128 (64 tiles * 2 bytes per line)
     addi.l #$4492,d0               ; Offset of first item
     move.w d0,CPORT
     move.l #$0003,d0
     move.w d0,CPORT
     move.w #$8100+'>'-32,DPORT     ; Put > character in BG map

     ; Read joypad 1
     move.b #$40,$A10006            ; SELECT of port 1 is an output
     move.b #$40,$A10003            ; SELECT high
     nop
     nop
     move.b $A10003,d0              ; Get xxCBRLDU
     andi.b #$3F,d0                 ;     00CBRLDU
     nop
     nop
     move.b #$00,$A10003            ; SELECT low
     nop
     nop
     move.b $A10003,d1              ; Get xxSA00DU
     andi.b #$30,d1                 ;     00SA0000
     lsl.b  #2,d1                   ;     SA000000
     or.b   d1,d0                   ;     SACBRLDU
     eori.b #$FF,d0
     move.b OLD_JP1,d1
     move.b d0,OLD_JP1
     eor.b  d0,d1
     and.b  d0,d1                   ; Keep rising edges

     btst   #0,d1
     beq    .nou                    ; Up
     jsr    clrm                    ; Clear last arrow
     subq.b #1,MENU
     cmp.b  #$FF,MENU
     bne    .nou
     move.b #5,MENU                 ; Wrap cursor to 5
.nou:

     btst   #1,d1
     beq    .nod                    ; Down
     jsr    clrm                    ; Clear last arrow
     addq.b #1,MENU
     cmp.b  #6,MENU
     bne    .nod
     clr.b  MENU                    ; Wrap cursor to 0
.nod:

     btst   #6,d1
     beq    .noa                    ; A
     move.w #160,TIMER              ; Start up timer
.noa:

     bra    .mainlp
     
; Zapping routines

zap1s:                              ; Short zap player 1
     move.b #$40,$A10009            ; SELECT of port 1 is an output
     move.l #6-1,d0                 ; 6 pulses (12 state changes)
.z1s:
     move.b #$40,$A10003            ; SELECT high
     nop
     move.b #$00,$A10003            ; SELECT low
     dbra   d0,.z1s
     rts
     
zap2s:                              ; Short zap player 2
     move.b #$40,$A1000B            ; SELECT of port 2 is an output
     move.l #6-1,d0                 ; 6 pulses (12 state changes)
.z2s:
     move.b #$40,$A10005            ; SELECT high
     nop
     move.b #$00,$A10005            ; SELECT low
     dbra   d0,.z2s
     rts

zap1:                               ; Long zap player 1
     move.b #$40,$A10009            ; SELECT of port 1 is an output
     move.l #8-1,d0                 ; 8 pulses (16 state changes)
.z1:
     move.b #$40,$A10003            ; SELECT high
     nop
     move.b #$00,$A10003            ; SELECT low
     dbra   d0,.z1
     rts
     
zap2:                               ; Long zap player 2
     move.b #$40,$A1000B            ; SELECT of port 2 is an output
     move.l #8-1,d0                 ; 8 pulses (16 state changes)
.z2:
     move.b #$40,$A10005            ; SELECT high
     nop
     move.b #$00,$A10005            ; SELECT low
     dbra   d0,.z2
     rts

; Arrow clearing

clrm:
     clr.l  d0
     move.b MENU,d0
     lsl.w  #7,d0
     addi.l #$4492,d0
     move.w d0,CPORT
     move.l #$0003,d0
     move.w d0,CPORT
     move.w #$8100+' '-32,DPORT
     rts

txt_title:
 dc.b "SHOCK COLLAR DEBUG",$00
txt_cc:
 dc.b "FURRTEK SYSTEMS 2012",$00
txt_zap1s:
 dc.b "SHORT ZAP PLAYER 1",$00
txt_zap2s:
 dc.b "SHORT ZAP PLAYER 2",$00
txt_zap3s:
 dc.b "SHORT ZAP BOTH PLAYER",$00
txt_zap1:
 dc.b "ZAP PLAYER 1",$00
txt_zap2:
 dc.b "ZAP PLAYER 2",$00
txt_zap3:
 dc.b "ZAP BOTH PLAYERS",$00
txt_premier:
 dc.b "THREE",$00
txt_milieu:
 dc.b "TWO",$00
txt_dernier:
 dc.b "ONE",$00
txt_eff:
 dc.b "             ",$00

palette:
 dc.w   $0700,$0EEE,$0060,$0066
 dc.w   $0600,$0606,$0660,$0666
 dc.w   $0EEE,$000E,$00E0,$00EE
 dc.w   $0E00,$0E0E,$0EE0,$000E

disptext:
     clr.w  d0
     move.b (a0)+,d0
     beq    .quit                   ; End of string on zero byte
     addi.w #($100-32)+$8000,d0     ; ASCII offset
     move.w d0,DPORT
     bra    disptext
.quit:
     rts

alpha:
 BINCLUDE "alpha.bin"               ; Alphabet characters (4BPP)
     
VDPinit:
 dc.w   $8004    ; Raster int:OFF, Full palette, TV out on
 dc.w   $8164    ; TV:ON, Vblank int:ON, DMA:OFF, V:240 pixels
 dc.w   $8236    ; Map A address
 dc.w   $8338    ; Window map address
 dc.w   $8407    ; Map B address
 dc.w   $857E    ; Sprite RAM address
 dc.w   $8700    ; Border color
 dc.w   $8A00    ; No raster interrupt
 dc.w   $8B00    ; Scroll mode
 dc.w   $8C81    ; H: 320 pixels, Shadow:OFF, interlace:OFF
 dc.w   $8D34    ; Scroll table address
 dc.w   $8F02    ; VRAM autoinc: +2
 dc.w   $9001    ; 64*32 tiles BG maps
 dc.w   $9100    ; Window width
 dc.w   $9200    ; Window height
 dc.w   $9300    ; DMA stuff...
 dc.w   $9400
 dc.w   $9500