*      
* SID Runtime ANalyzer -- a tool for
* looking at SID instruments etc.
*
* SLJ 6/02
*

         org $4000

CHROUT   = $ffd2

point    = $02
temp     = $04
point2   = $fa
count2   = $fc
lastval  = $fe

*
* Init
*
Init     
         lda #00
         sta buffer
         lda #$80
         sta buffer+1
         lda #00
         sta start
         sta start+1
         sta numframe
         sta numframe+1
         sta delta
         sta playflag
         sta playack
         sta ldaval
         jsr FrameOne
         jsr ResetReg

         jsr SIDout
         jsr ClearSID     ;clear "SID"
         jsr SIDin

         jsr InitIRQ

         lda #03
         sta PlayTune+1
         lda #00
         sta InitTune+1
         lda #$10
         sta PlayTune+2
         sta InitTune+2

         lda #$40
         sta numframe
         lda #00
         sta numframe+1

         jsr Capture
*         jmp MainProg

*-------------------------------
         do 0
*
* Test code
*
TestCode 
         lda #<testinit
         sta InitTune+1
         lda #>testinit
         sta InitTune+2

         lda #<testplay
         sta PlayTune+1
         lda #>testplay
         sta PlayTune+2

         lda #$08
         sta numframe
         lda #00
         sta numframe+1

         jsr Capture
         jmp MainProg

testinit 
         lda #00
         sta testtemp
         ldx #$18
:loop    sta $d400,x
         dex
         bpl :loop
         rts

testtemp dfb 00
testplay 
         ldx testtemp
         lda :testtab,x
         sta $d404
         lda :tab2,x
         sta $d418
         inc testtemp
         rts

:testtab hex 8141211108040201
:tab2    hex 0102030405060708
         fin
*-------------------------------

MainProg 
         lda #6
         sta $d021
         lda #12
         sta $d020
         lda #$80
         sta $028a
         jsr Strout
         dfb 153          ;lt green
         dfb 147
         txt 'ransid :: slj 6/02 :: '
         txt 'sjudd@ffd2.com',0d
*         dfb 00
*
*         jsr Strout
         dfb 19
         dfb 17,17,17,17,17
         dfb 5

         txt ' v1        v2        v3       fil/vol',0d
         txt 'atdk:     atdk:     atdk:     d415:',0d
         txt 'surl:     surl:     surl:     d417:',0d
         txt 'pwid:     pwid:     pwid:     d418:',0d
         txt 'freq:     freq:     freq:',0d
         txt 'creg:     creg:     creg:',0d

         dfb 17,17,17,17

         dfb 158          ;yellow
         txt '+/-     next/prev frame   * reset sid',0d
         txt 'shft+/- big steps         c capture',0d
         txt 'ctrl-p  play frames       = no update',0d
         txt '1/2/3/4 toggle playback   _ brk',0d
         txt 'home    go to first frame',0d
         dfb $0d
         txt 'up/dn   select register   @ abs/delta',0d
         txt 'lf/rt   scroll display',0d
         txt '\       set to cur frame',0d
         dfb 5
         dfb 00

Main     
         jsr Strout
         dfb 19
         dfb 17,17,17
         txt 'frame start:',00

         ldx start
         lda start+1
         jsr Hex16

         jsr Strout
         txt ' len:',00
         ldx numframe
         lda numframe+1
         jsr Hex16

         jsr Strout
         txt ' current:',00
         ldx curframe
         lda curframe+1
         jsr Hex16

         jsr PlayFrame
         lda playflag
         and dispflag     ;1 and 1
         bne Noprint

         jsr PrintFrame
         lda playflag
         bne NoPrint
PrReg    jsr PrintReg
PrVstat  jsr Vstats
NoPrint  

:wait    jsr $ffe4
         bne :key
         lda playflag
         beq :wait

         lda playack
         beq :wait
         bne Main

:key     
         cmp #'+'
         beq :next
         cmp #'-'
         beq :prev
         cmp #"{"
         beq :next2
         cmp #"}"
         beq :prev2

         cmp #145
         beq :up
         cmp #17
         beq :down
         cmp #157
         beq :left
         cmp #29
         beq :right

         cmp #16
         beq :play
         cmp #19
         beq :home

         cmp #'*'
         beq :star
         cmp #'c'
         beq :cap
         cmp #'\'
         beq :setcur
         cmp #'='
         beq :noup

         cmp #'_'
         beq :brk

         cmp #'@'
         beq :toggle

         cmp #'5'
         bcs :wait
         cmp #'1'
         bcc :wait

:tog     and #$07
         tax
         dex
         lda togtab,x
         eor #$80
         sta togtab,x
         jmp :clrsid

:brk     brk

:next    jsr NextFrame
         jmp Main

:prev    jsr PrevFrame
         jmp Main

:next2   jsr BigNext
         jmp Main

:prev2   jsr BigPrev
         jmp Main

:up      jsr PrevReg
         jmp Main

:down    jsr NextReg
         jmp Main

:left    jsr DecRegPos
         jmp PrReg

:right   jsr IncRegPos
         jmp PrReg

:play    lda #1
         eor playflag
         sta playflag
         beq :jmp
         jsr FrameOne
:clrsid  jsr ClearSID
:jmp     jmp Main

:home    jsr FrameOne
         jmp Main

:cap     jsr Capture
         jmp MainProg

:star    jsr ClearSID
         jmp :wait

:setcur  jsr SetCurFrame
         jmp Main

:noup    lda dispflag
         eor #$01
         sta dispflag
         jmp :wait

:toggle  lda delta        ;0=absolute
         clc              ;1=positive delta
         adc #1           ;2=negative delta
         cmp #3
         bne :sta
         lda #00
:sta     sta delta
         jmp Main

ClearSID lda #00
         ldx #$18
:l2      sta $d400,x
         dex
         bpl :l2

         lda #$08
         sta $d404
         sta $d404+7
         sta $d404+14
         ldx #$ff         ;let sid
:l3      dex              ;settle
         bne :l3
         rts

         txt 'a secret message'

*
* irq handler
*
InitIRQ  
         sei
         lda #<irq
         sta $0314
         lda #>irq
         sta $0315
         cli

         lda $02a6
         beq :ntsc
:pal     lda #$c7
         ldy #$4c
         bne :sta
:ntsc    lda #$c6
         ldy #$42
:sta     sty $dc05
         sta $dc04
         rts

IRQ      
         lda playflag
         beq :skip
         lda playack
         bne :skip
         inc playack
         inc $d020
         jsr NextFrame
         dec $d020
:skip    jmp $ea31


*
* Print voice on/off stats
*
Vstats   
         jsr Strout
         dfb 19
         dfb 17,17,17,17,17
         dfb 00
         ldx #3
:loop    lda #'*'
         ldy togtab,x
         beq :c0
         lda #' '
:c0      ldy :togpos,x
         sta ($d1),y
         dex
         bpl :loop
         rts

:togpos  dfb 0,10,20,29

togtab   dfb 0,0,0,0

*
* Inc/dec register offsets
*
DecRegPos
         lda regpos
         bne :dec
         ora regpos+1
         beq :rts
         dec regpos+1
:dec     dec regpos
         lda framepos
         sec
         sbc #25
         sta framepos
         bcs :rts
         dec framepos+1
:rts     rts

IncRegPos
         lda regpos
         clc
         adc #1
         tay
         lda regpos+1
         adc #00
         sta temp
         cpy numframe
         sbc numframe+1
         bcs :rts
         lda temp
         sty regpos
         sta regpos+1
         lda framepos
         clc
         adc #25
         sta framepos
         bcc :rts
         inc framepos+1
:rts     rts

*
* Play a SID frame
*
PlayFrame
         lda togtab
         bne :v2
*         ldy #4
*         lda (point),y ;d404
*         and #$fe     ;gate off
*         sta $d404
         ldy #06          ;do adsr first
         jsr :dovoice

:v2      lda togtab+1
         bne :v3
*         ldy #$04+7
*         lda (point),y
*         and #$fe     ;gate off
*         sta $d404+7
         ldy #13
         jsr :dovoice

:v3      lda togtab+2
         bne :v4
*         ldy #$04+14
*         lda (point),y
*         and #$fe     ;gate off
*         sta $d404+14
         ldy #20
         jsr :dovoice

:v4      lda togtab+3
         bne :ack
         ldy #21
:l4      lda (point),y
         sta $d400,y
         iny
         cpy #25
         bne :l4

:ack     lda #00
         sta playack

:rts     rts

:dovoice 
         lda (point),y    ;check if sr
         cmp lastframe,y  ;will change
         beq :cont

         lda #00
         sta $d400,y
         dey
         dey
         sta $d400,y
         lda #08
         sta $d400,y
         iny
         iny

         ldx #$10         ;let sid
:blah    dex              ;settle down
         bne :blah
:cont    

         ldx #7
:l1      lda (point),y
         sta $d400,y
         sta lastframe,y
         dey
         dex
         bne :l1
         rts

*
* Output a SID frame
*
PrintFrame
         ldx curreg
         jsr HighlightReg

         ldx #00
:loop    stx temp
         jsr SetRegPos
         ldx temp
         ldy regoffset,x
         lda regsize,x
         cmp #1
         beq :byte
         iny
         lda (point),y    ;high byte
         jsr Hexout
         dey
:byte    lda (point),y
         jsr Hexout
         inx
         cpx #18
         bcc :loop
         rts

SetRegPos                 ;reg in .X
         ldy regcol,x
         lda regrow,x
         tax
         clc
         jmp $fff0        ;plot

regcol   dfb 5,5,5,5,5
         dfb 15,15,15,15,15
         dfb 25,25,25,25,25
         dfb 35,35,35

regrow   dfb 6,7,8,9,10
         dfb 6,7,8,9,10
         dfb 6,7,8,9,10
         dfb 6,7,8

regcol2  dfb 0,0,0,0,0
         dfb 10,10,10,10,10
         dfb 20,20,20,20,20
         dfb 30,30,30

regoffset dfb 5,6,2,0,4
         dfb 5+7,6+7,2+7,0+7,4+7
         dfb 5+14,6+14,2+14,0+14,4+14
         dfb $15,$17,$18

regsize  dfb 1,1,2,2,1
         dfb 1,1,2,2,1
         dfb 1,1,2,2,1
         dfb 2,1,1

*
* Highlight registers
*

SetPos2  
         ldy regcol2,x
         lda regrow,x
         tax
         clc
         jmp $fff0        ;plot

HighlightReg              ;reg in .X
         jsr SetPos2

         ldy $d3
         lda ($d1),y
         ora #$80
         sta ($d1),y
         iny
         lda ($d1),y
         ora #$80
         sta ($d1),y
         iny
         lda ($d1),y
         ora #$80
         sta ($d1),y
         iny
         lda ($d1),y
         ora #$80
         sta ($d1),y

         rts

UnlightReg
         jsr SetPos2
         ldy $d3
         lda ($d1),y
         and #$7f
         sta ($d1),y
         iny
         lda ($d1),y
         and #$7f
         sta ($d1),y
         iny
         lda ($d1),y
         and #$7f
         sta ($d1),y
         iny
         lda ($d1),y
         and #$7f
         sta ($d1),y
         rts



*
* Print register time history
*
PrintReg 
         ldx #12
         ldy #00
         clc
         jsr $fff0

         jsr Strout
         txt 'reg pos=',00
         ldx regpos
         lda regpos+1
         jsr Hex16
         jsr Strout
         txt ' type=',00
         lda delta
         beq :abs0
         cmp #1
         beq :pdel
         jsr Strout
         txt 'delta-  ',0d,00
         jmp :cont
:pdel    jsr Strout
         txt 'delta+  ',0d,00
         jmp :cont
:abs0    jsr Strout
         txt 'absolute',0d,00
:cont    
         lda #'['
         jsr $ffd2

         lda framepos
         sta point2
         lda framepos+1
         sta point2+1

         lda regpos
         sta count2
         lda regpos+1
         sta count2+1

         ldx curreg
         ldy regoffset,x

         lda #00
         sta lastval
         sta lastval+1

         lda regpos
         ora regpos+1
         beq :loop
         jsr :getlast

:loop    jsr PrRegDat

         lda point2
         clc
         adc #25
         sta point2
         bcc :c0
         inc point2+1
:c0      
         inc count2
         bne :c1
         inc count2+1
:c1      lda count2
         cmp numframe
         lda count2+1
         sbc numframe+1
         bcs :done

         lda $d3
         cmp #35
         bcs :done

         lda #32
         jsr $ffd2
         jmp :loop

:done    
         lda #']'
         jsr $ffd2

:space   lda #32
         jsr $ffd2
         lda $d3
         cmp #40
         bcc :space
         rts

:getlast 
:dec25   lda point2
         sec
         sbc #25
         sta point2
         bcs :c3
         dec point2+1
:c3      
         lda regsize,x
         cmp #1
         beq :lobyte
         iny
         lda (point2),y
         sta lastval+1
         dey

:lobyte  lda (point2),y
         sta lastval

:inc25   lda point2
         clc
         adc #25
         sta point2
         bcc :rts
         inc point2+1
:rts     rts

*
* print reg data
*
* .X = reg, .Y = offset
* delta=0 -> absolute values
*       1 -> positive delta
*       2 -> negative delta

PrRegDat 
         lda delta
         beq :abs

         cmp #1           ;pos delta
         beq :pdelta

:mdelta  lda lastval
         sbc (point2),y
         sta temp

         lda regsize,x
         and #1           ;preserves c
         bne :mbyte
         lda lastval+1
         iny
         sbc (point2),y
         jsr Hexout
         lda (point2),y
         sta lastval+1
         dey
:mbyte   lda temp
         jsr Hexout
         lda (point2),y
         sta lastval
         rts

:pdelta  lda (point2),y
         sbc lastval
         sta temp

         lda regsize,x
         and #1           ;preserves c
         bne :pbyte
         iny
         lda (point2),y
         sbc lastval+1
         jsr Hexout
         lda (point2),y
         sta lastval+1
         dey
:pbyte   lda temp
         jsr Hexout
         lda (point2),y
         sta lastval
         rts

:abs     lda regsize,x
         cmp #1
         beq :byte
         iny
         lda (point2),y
         jsr Hexout
         dey
:byte    lda (point2),y
         jmp Hexout

*
* Go to forward/previous frames
*

NextFrame
         ldx #0
         dfb $2c
BigNext  ldx #1
         lda curframe
         clc
         adc :tab1,x
         tay
         lda curframe+1
         adc #00
         sta temp
         cpy numframe
         sbc numframe+1
         bcc :cont
         lda #00
         sta playflag
         jmp PrintFrame

:cont    lda temp
         sta curframe+1
         sty curframe

         lda :tablo,x
         clc
         adc point
         sta point
         lda :tabhi,x
         adc point+1
         sta point+1

:exit    rts


:tab1    dfb 1,16
:tablo   dfb 25,<400
:tabhi   dfb 0,>400


PrevFrame
         ldx #0
         dfb $2c
BigPrev  ldx #1
         lda curframe
         sec
         sbc :tab1,x
         tay
         lda curframe+1
         sbc #00
         bcc :exit
         sta curframe+1
         sty curframe

         lda point
         sec
         sbc :tablo,x
         sta point
         lda point+1
         sbc :tabhi,x
         sta point+1

:exit    rts

:tab1    dfb 1,16
:tablo   dfb 25,<400
:tabhi   dfb 00,>400

*
* Handle registers
*
NextReg  
         ldx curreg
         jsr UnlightReg
         ldx curreg
         inx
         cpx #18
         bcc :stx
         ldx #00
:stx     stx curreg
         rts

PrevReg  
         ldx curreg
         jsr UnlightReg
         dec curreg
         bpl :exit
         lda #17
         sta curreg
:exit    rts

*
* Capture SID frames
*
Capture  
         jsr Strout
         dfb 147
         dfb 14,5
         txt ':: Capture menu ::',0d
         hex 0d0d
         dfb 00

PrMenu   
         jsr strout
         dfb 19,17,17
         txt 'InitTune:$'
         dfb 00
         lda #00
         jsr RevCheck
         lda inittune+2
         ldx inittune+1
         jsr Hex16

         jsr strout
*         dfb $0d
         dfb 146          ;rev off
         txt ' <- lda #$',00
         lda #01
         jsr RevCheck
         lda ldaval
         jsr Hexout

         jsr strout
         dfb $0d          ;turns rev off
         txt 'PlayTune:$'
         dfb 00
         lda #2
         jsr RevCheck
         lda PlayTune+2
         ldx PlayTune+1
         jsr Hex16

         jsr strout
         dfb 13,13
         txt 'Start frame:$'
         dfb 00
         lda #3
         jsr RevCheck
         lda start+1
         ldx start
         jsr Hex16

         jsr strout
         dfb 13
         txt 'Number of capture frames:$'
         dfb 00
         lda #4
         jsr RevCheck
         lda numframe+1
         ldx numframe
         jsr Hex16

         jsr Strout
         dfb $0d,$0d
         txt 'Frame buffer:$',00
         lda #5
         jsr RevCheck
         lda buffer+1
         ldx buffer
         jsr Hex16

         jsr Strout
         dfb 13,13
         txt 'up/dn  select',0d
         txt 'cr     enter value',0d
         txt '+/-    change (shift=big change)',0d
         txt '_      capture and exit',0d
         dfb 00

:wait    jsr $ffe4
         beq :wait

         cmp #145
         beq :up
         cmp #17
         beq :down
         cmp #13
         beq :cr
         cmp #'+'
         beq :plus
         cmp #'-'
         beq :minus
         cmp #"{"
         beq :bigplus
         cmp #"}"
         beq :bigminus

         cmp #'_'
         bne :wait
         jmp GetFrames

:up      lda curpar
         sec
         sbc #1
         bpl :sta1
         lda #5
:sta1    sta curpar
         jmp PrMenu

:down    lda curpar
         clc
         adc #1
         cmp #6
         bcc :sta2
         lda #00
:sta2    sta curpar
         jmp PrMenu

:cr      jsr GetVal
         jsr SetParVal
         jmp PrMenu

:bigplus lda #16
         dfb $2c
:plus    lda #1
         sta temp
         jsr GetParVal
         clc
         adc temp
         bcc :c0
         iny
:c0      jsr SetParVal
         jmp PrMenu

:bigminus lda #16
         dfb $2c
:minus   lda #1
         sta temp
         jsr GetParVal
         sec
         sbc temp
         bcs :c1
         dey
:c1      jsr SetParVal
         jmp PrMenu

RevCheck 
         cmp curpar
         bne :rts
         lda #18          ;rev on
         jmp $ffd2
:rts     rts

curpar   dfb 00

*
* Get/Set par values
*
* .A/.Y = lo/hi
*
GetParVal
         ldx curpar
         beq :init
         dex
         beq :lda
         dex
         beq :play
         dex
         beq :start
         dex
         beq :numframe
         lda buffer
         ldy buffer+1
         rts
:numframe
         lda numframe
         ldy numframe+1
         rts

:start   lda start
         ldy start+1
         rts

:play    lda PlayTune+1
         ldy PlayTune+2
         rts

:lda     lda ldaval
         rts

:init    lda InitTune+1
         ldy InitTune+2
         rts

SetParVal
         ldx curpar
         beq :init
         dex
         beq :lda
         dex
         beq :play
         dex
         beq :start
         dex
         beq :numframe
:buffer  
         sta buffer
         sty buffer+1
         rts
:numframe
         sta numframe
         sty numframe+1
         rts

:start   sta start
         sty start+1
         rts

:play    sta PlayTune+1
         sty PlayTune+2
         rts

:lda     sta ldaval
         rts

:init    sta InitTune+1
         sty InitTune+2
         rts

*
* Get 16-bit hex value
*
val      da 00

GetVal   
         ldx #24
         ldy #00
         clc
         jsr $fff0

         jsr Strout
         txt 'Enter value:$    '
         dfb 157,157,157,157
         dfb 00

         lda #00
         sta val
         sta val+1

         jsr :getchar
         jsr :getchar
         jsr :getchar
         jsr :getchar
:done    ldy val+1
         lda val
         rts

:getchar jsr $ffcf
         cmp #$0d
         beq :exit

         cmp #$40         ;convert to hex
         bcc :c1
         sbc #7
:c1      and #$0f
         asl val
         rol val+1
         asl val
         rol val+1
         asl val
         rol val+1
         asl val
         rol val+1
         ora val
         sta val
         rts

:exit    pla
         pla
         jmp :done


*
* Play tune and record frames
*
GetFrames
         lda start
         sta count
         lda start+1
         sta count+1

         lda buffer
         sta mpoint
         lda buffer+1
         sta mpoint+1

         jsr SIDout

         lda #00
         ldx #$18
:l2      sta $d400,x
         dex
         bpl :l2

         lda ldaval
         jsr InitTune

:ploop   lda count
         ora count+1
         beq :c1
         jsr debug
         jsr PlayTune
         lda count
         bne :dec
         dec count+1
:dec     dec count
         jmp :ploop
:c1      
         lda numframe
         sta count
         lda numframe+1
         sta count+1

:loop2   jsr debug
         jsr CopySID
         lda count
         bne :dec2
         ora count+1
         beq :done
         dec count+1
:dec2    dec count
         jsr PlayTune
         jmp :loop2
:done    
         jsr SIDin
         jsr ResetReg
*         jmp FrameOne

*
* Go to frame 1, reset register
*
FrameOne 
         lda #00
         sta curframe
         sta curframe+1
         lda buffer
         sta point
*         sta framepos
         lda buffer+1
         sta point+1
*         sta framepos+1
         rts
ResetReg 
         lda #00
         sta curreg
         sta regpos
         sta regpos+1
         lda buffer
         sta framepos
         lda buffer+1
         sta framepos+1
         rts

*
* Set regs to current frame
*
SetCurFrame
         lda curframe
         sta regpos
         lda curframe+1
         sta regpos+1
         lda point
         sta framepos
         lda point+1
         sta framepos+1
         rts

*
* Copy SID regs to buffer
*
CopySID  
         lda $02
         pha
         lda $03
         pha
         lda mpoint
         sta $02
         lda mpoint+1
         sta $03

         ldy #$18
:loop    lda $d400,y
         sta ($02),y
         dey
         bpl :loop

         lda mpoint
         clc
         adc #25
         sta mpoint
         lda mpoint+1
         adc #00
         sta mpoint+1

         pla
         sta $03
         pla
         sta $02
         rts

*
* Switch SID in/out
*

SIDout   lda #$7f
         sta $dc0d
         sei              ;just in case
         lda #$30
         sta $01
         rts

SIDin    sei              ;just in case!
         lda #$36
         sta $01
         lda #$81
         sta $dc0d
         cli
         rts

*-------------------------------
*
* Utility routines
*
*-------------------------------

*
* HEX16 -- print two-byte hex
*
* Input: .X .A = lo hi
*
HEX16    
         JSR HEXOUT
         TXA              ;Fall through to next routine
*
* HEXOUT
*
* Print hex byte in .A using CHROUT
*
HEXOUT   
         PHA
         LSR
         LSR
         LSR
         LSR
         JSR :PRINT
         PLA
         AND #$0F
:PRINT   ORA #$30
         CMP #$3A
         BCC :PLOP
         ADC #$06
:PLOP    JMP $FFD2

*
* STROUT
*   Like PRINT, but the string immediately follows the
*   subroutine call; execution resumes right after the
*   null-termination byte.
*
*   On exit, A and X are thoroughly hosed.
*
STROUT   
         PLA
         TAX              ;Lo byte
         PLA
         INX
         BNE :PRINT
         CLC
         ADC #01
:PRINT   
         STA :LOOP+2
:LOOP    LDA $A000,X
         BEQ :DONE
         JSR CHROUT
         INX
         BNE :LOOP
         INC :LOOP+2
         BNE :LOOP

:DONE    LDA :LOOP+2
         PHA              ;hi byte
         TXA
         PHA              ;lo byte
         RTS


debug    
         pha
         lda $01
         pha
         lda #$37
         sta $01
         inc $d020
         pla
         sta $01
         pla
         rts


*
* Variables/storage
*

InitTune jmp $1000
PlayTune jmp $1003
ldaval   dfb 00

start    da 00            ;start frame
numframe da 32            ;number of frames
curframe da 00

curreg   dfb 00           ;current register
regpos   da 00
framepos da 00            ;start of frame,for register
delta    dfb 00           ;abs/differential

count    da 00            ;counter
mpoint   da 00            ;pointer

dispflag dfb 00           ;update display
playflag dfb 00
playack  dfb 00
playup   dfb 00

buffer   da $5000

lastframe ds 25