;-------------------
;  TMC 2.00 Player
;------------------

player equ $200
normal equ 1 ; change to 0 for short version

       org player

addr   equ $fa
byte   equ $fc
bajt   equ $fd
filter equ $fe
maxvol equ $ff

; some tables on start (to avoid page breaking)

voltab dta d'                '
       dta d'        !!!!!!!!'
       dta d'    !!!!!!!!""""'
       dta d'   !!!!!"""""###'
       dta d'  !!!!""""####$$'
       dta d'  !!!"""###$$$%%'
       dta d'  !!"""##$$$%%&&'
       dta d'  !!""##$$%%&&'''''
       dta d' !!""##$$%%&&''''('
       dta d' !!""#$$%%&''''(()'
       dta d' !!"##$%%&''''())*'
       dta d' !!"#$$%&''''()**+'
       dta d' !""#$%&&''()**+,'
       dta d' !"##$%&''()**+,-'
       dta d' !"#$%&''''()*+,-.'
       dta d' !"#$%&''()*+,-./'

frqtab dta 0,$f1,$e4,$d7
       dta $cb,$c0,$b5,$aa
       dta $a1,$98,$8f,$87
       dta $7f,$78,$72,$6b
       dta $65,$5f,$5a,$55
       dta $50,$4b,$47,$43
       dta $3f,$3c,$38,$35
       dta $32,$2f,$2c,$2a
       dta $27,$25,$23,$21
       dta $1f,$1d,$1c,$1a
       dta $18,$17,$16,$14
       dta $13,$12,$11,$10
       dta 15,14,13,12
       dta 11,10,9,8
       dta 7,6,5,4
       dta 3,2,1,0

       dta 0,$f2,$e9,$da
       dta $ce,$bf,$b6,$aa
       dta $a1,$98,$8f,$89
       dta $80,$7a,$71,$6b
       dta $65,$5f,$5c,$56
       dta $50,$4d,$47,$44
       dta $3e,$3c,$38,$35
       dta $32,$2f,$2d,$2a
       dta $28,$25,$23,$21
       dta $1f,$1d,$1c,$1a
       dta $18,$17,$16,$14
       dta $13,$12,$11,$10
       dta 15,14,13,12
       dta 11,10,9,8
       dta 7,6,5,4
       dta 3,2,1,0

       dta 0,$ff,$f1,$e4
       dta $d8,$ca,$c0,$b5
       dta $ab,$a2,$99,$8e
       dta $87,$7f,$79,$73
       dta $70,$66,$61,$5a
       dta $55,$52,$4b,$48
       dta $43,$3f,$3c,$39
       dta $37,$33,$30,$2d
       dta $2a,$28,$25,$24
       dta $21,$1f,$1e,$1c
       dta $1b,$19,$17,$16
       dta $15,$13,$12,$11
       dta $10,15,14,13
       dta 12,11,10,9
       dta 8,7,6,5
       dta 4,3,2,1

       dta 0,$f3,$e6,$d9
       dta $cc,$c1,$b5,$ad
       dta $a2,$99,$90,$88
       dta $80,$79,$72,$6c
       dta $66,$60,$5b,$55
       dta $51,$4c,$48,$44
       dta $40,$3c,$39,$35
       dta $32,$2f,$2d,$2a
       dta $28,$25,$23,$21
       dta $1f,$1d,$1c,$1a
       dta $18,$17,$16,$14
       dta $13,$12,$11,$10
       dta 15,14,13,12
       dta 11,10,9,8
       dta 7,6,5,4
       dta 3,2,1,0

basslo dta l($be2,$b38,$a8c,$a00)
       dta l($96a,$8e8,$86a,$7ef)
       dta l($780,$708,$6ae,$646)
       dta l($5e6,$595,$541,$4f6)
       dta l($4b0,$46e,$430,$3f6)
       dta l($3bb,$384,$352,$322)
       dta l($2f4,$2c8,$2a0,$27a)
       dta l($255,$234,$214,$1f5)
       dta l($1d8,$1bd,$1a4,$18d)
       dta l($177,$160,$14e,$138)
       dta l($127,$115,$106,$0f7)
       dta l($0e8,$0db,$0cf,$0c3)
       dta l($0b8,$0ac,$0a2,$09a)
       dta l($090,$088,$07f,$078)
       dta l($070,$06a,$064,$05e)
       dta l($057,$052,$032,$00a)

       dta 0,$f2,$33,$96
       dta $e2,$38,$8c,$00
       dta $6a,$e8,$6a,$ef
       dta $80,$08,$ae,$46
       dta $e6,$95,$41,$f6
       dta $b0,$6e,$30,$f6
       dta $bb,$84,$52,$22
       dta $f4,$c8,$a0,$7a
       dta $55,$34,$14,$f5
       dta $d8,$bd,$a4,$8d
       dta $77,$60,$4e,$38
       dta $27,$15,$06,$f7
       dta $e8,$db,$cf,$c3
       dta $b8,$ac,$a2,$9a
       dta $90,$88,$7f,$78
       dta $70,$6a,$64,$5e

basshi dta h($be2,$b38,$a8c,$a00)
       dta h($96a,$8e8,$86a,$7ef)
       dta h($780,$708,$6ae,$646)
       dta h($5e6,$595,$541,$4f6)
       dta h($4b0,$46e,$430,$3f6)
       dta h($3bb,$384,$352,$322)
       dta h($2f4,$2c8,$2a0,$27a)
       dta h($255,$234,$214,$1f5)
       dta h($1d8,$1bd,$1a4,$18d)
       dta h($177,$160,$14e,$138)
       dta h($127,$115,$106,$0f7)
       dta h($0e8,$0db,$0cf,$0c3)
       dta h($0b8,$0ac,$0a2,$09a)
       dta h($090,$088,$07f,$078)
       dta h($070,$06a,$064,$05e)
       dta h($057,$052,$032,$00a)

       dta 0,13,13,12
       dta 11,11,10,10
       dta 9,8,8,7
       dta 7,7,6,6
       dta 5,5,5,4
       dta 4,4,4,3
       dta 3,3,3,3
       dta 2,2,2,2
       dta 2,2,2,1
       dta 1,1,1,1
       dta 1,1,1,1
       dta 1,1,1,0
       dta 0,0,0,0
       dta 0,0,0,0
       dta 0,0,0,0
       dta 0,0,0,0

tables_len equ *-player

;      org +$300
       jmp init
       jmp play
       jmp sound

; some external controls
quadro dta 1           ; 0=mono, 1-63=stereo, 64-127= RMT stereo, 128-255=quadro
pokeys dta 16          ; which data should go to which pokey (0,1,2 and 3 respectively)
       dta 20          ; for stereo config: 16=first 4 tracks, 20=last 4 tracks
       dta 0           ; for quadro values should be:
       dta 0           ; 0=main volume from tracks 0-3, 4=main volume from tracks 4-5
                       ; 8=additional volume from tracks 0-3, 12=additional volume from tracks 4-5
                       ; typical: 0,4,12,8 which should sound well on pokeys 0&2 on left channel
                       ; and pokeys 1&3 on right channel
                       ; (on stereo atari these settings should also sound well)
silent dta d'        ' ; which channel should be silent

; these values are usable from the outside of player
czygrc dta 0           ; if song should be played
pozsng dta 0           ; position in song

specialflag dta 0      ; flag triggered in song data
adrsng dta a(0)        ; address of song line

tempo  dta 0           ; tempo of song
ltempo dta 0           ; counter of tempo
pozptr dta 0           ; counter of positions in patterns (64 means end of pattern)

       ift normal ; !!!

aud1   dta 0           ; total AUDCTL of left channel
aud2   dta 0           ; and right

voltabs equ *          ; (24 bytes)

       eif ; !!!

vol1ch dta d'        ' ; volume of main channels

       ift normal ; !!!

vol2ch dta d'        ' ; volume of additional channels
volume dta d'        ' ; volume of channels in stereo (taken from vol1ch and vol2ch)

freqtabs equ *         ; (24 bytes)

       eif ; !!!

frq    dta d'        ' ; frequency

       ift normal ; !!!

note   dta d'        ' ; actual note played on channel (taken from aktwys)
freqen dta d'        ' ; frequency of channels in stereo (taken from frq)

       eif ; !!!

; data for accesing pattern data
adrptl dta d'        ' ; address of pattern data
adrpth dta d'        ' ;
pozwpt dta d'        ' ; index for accesing data in pattern
poddzw dta d'        ' ; change of note
delay  dta d'        ' ; how many spaces in pattern should be skipped

; data for accesing instrument data
czygrx dta d'        ' ; if something is played on channel
adrsnl dta d'        ' ; address of instrument data
adrsnh dta d'        ' ;
numdzw dta d'        ' ; number of instrument
wysdzw dta d'        ' ; note to play
aktwys dta d'        ' ; actual played note
znksz  dta d'        ' ; distortion
audctl dta d'        ' ; AUDCTL
slupy  dta d'        ' ; counter for data inside instrument

; data for specific sound effects
sndlen dta d'        ' ; length of instrument
sndlop dta d'        ' ; where to loop sound data
actvol dta d'        ' ; volume of sounds
actvl1 dta d'        ' ; actual control of main volume

       ift normal ; !!!

actvl2 dta d'        ' ; and additional volume

       eif ; !!!

opad1  dta d'        ' ; how soon the sound should fade (main volume)
opad2  dta d'        ' ; and additional volume
lopad1 dta d'        ' ; counters for fading
lopad2 dta d'        ' ;
opadst dta d'        ' ; start of fading
typ    dta d'        ' ; type of effect
param  dta d'        ' ; parameter for effect
typdat dta d'        ' ; data for effect
czekaj dta d'        ' ; how soon the effect should start
dtyp   dta d'        ' ; how often the effect should chanfe
ltyp   dta d'        ' ; counter for effect change
ilperm dta d'        ' ; how many arpeggio sounds
aperm  dta d'        ' ; actual arpeggio sound
dperm  dta d'        ' ; how soon the arpeggio should change
lperm  dta d'        ' ; counter for arpeggio
kolejn dta d'        ' ; order of arpeggio
sndfilter dta d'        ' ; filter from sound data
mainaudctl dta d'        ' ; main audctl
addaudctl dta d'        ' ; additional audctl
shiftfrq dta d'        '
shiftnote dta d'        '
shiftfilter dta d'        '

; some useful tables

       ift normal ; !!!

przeci dta 4,5,6,7     ; which channel is the opposite (used only in stereo)
       dta 0,1,2,3

       eif ; !!!

audtb1 dta 4,2,0,0     ; which byte in audctl has to be set to make sound "2 channel synth"
       dta 4,2,0,0
audtb2 dta 0,16,0,8    ; which byte in audctl has to be set to make sound "2 channel bass"
       dta 0,16,0,8
usedaudctl dta 4+129,$50+2+129,129,$28+129 ; bits of AUDCTL used in channel
       dta 4+129,$50+2+129,129,$28+129

;-------------------------
; start of player program

player_program equ *

; new address of song line
p3     dey
       lda (addr),y
       sta pozsng
       mvx #0 byte
       asl @
       rol byte
       asl @
       rol byte
       asl @
       rol byte
       asl @
       rol byte
       adc pozsng ; clc
       scc:inc byte
       clc
zm0    adc #0
       sta addr
       lda byte
zm1    adc #0
       sta addr+1
       jmp p1

; play song (call only one time per frame)
play   jsr pokey
       lda czygrc
       beq rsound
       dec ltempo
       bmi p4
rsound jmp sound+3

p4     dec pozptr
       bne r1

; get new patterns from song
       ldx #0
       inc pozsng
       mwa adrsng addr

p1     ldy #16
       lda (addr),y
       bmi p3
       jeq stop
       sta pozptr
       dey

p2     lda (addr),y
       dey
       sty byte
       tay
zm2    lda $ffff,y
       sta adrptl,x
zm3    lda $ffff,y
       sta adrpth,x
       lda #0
       sta delay,x
       sta pozwpt,x
       ldy byte
       lda (addr),y
       sta poddzw,x
       inx
       dey
       bpl p2
       lda #17
       add addr
       sta adrsng
       lda #0
       adc addr+1
       sta adrsng+1

; get new data from patterns
r1     mva tempo ltempo

       ldx #7
r2     dec delay,x
       bmi r13

r14    dex
       bpl r2
       jmp sound+3

r13    mva adrptl,x addr
       mva adrpth,x addr+1

       ldy pozwpt,x
r3     lda (addr),y ; get data
       bne r4

       iny ; $00: only new volume
       lda (addr),y
       sta actvol,x
       and #$f0
       sta actvl1,x

       ift normal ; !!!

       lda (addr),y
       asl @
       asl @
       asl @
       asl @
       sta actvl2,x

       eif ; !!!

       iny
       tya
       sta pozwpt,x
       jmp r14

r4     cmp #$40
       bcs r5
       adc poddzw,x ; $01-$3f: new note with sound and maybe volume
       sta wysdzw,x
       iny
       lda (addr),y
       bpl r11
       and #$7f
       sta byte
       iny
       lda (addr),y
       sta actvol,x
       and #$f0
       sta actvl1,x

       ift normal ; !!!

       lda (addr),y
       asl @
       asl @
       asl @
       asl @
       sta actvl2,x

       eif ; !!!

       iny
       tya
       sta pozwpt,x
       ldy byte
       jsr dzwiek
       jmp r14

r11    tay ; without volume
       inc pozwpt,x
       inc pozwpt,x
       lda actvol,x
       and #$f0
       sta actvl1,x

       ift normal ; !!!

       lda actvol,x
       asl @
       asl @
       asl @
       asl @
       sta actvl2,x

       eif ; !!!

       jsr dzwiek
       jmp r14

r5     cmp #$80
       bcs r6
       and #$3f ; $41-$7f: new note with volume
       add poddzw,x
       sta wysdzw,x
       iny
       lda (addr),y
       sta actvol,x
       and #$f0
       sta actvl1,x

       ift normal ; !!!

       lda (addr),y
       asl @
       asl @
       asl @
       asl @
       sta actvl2,x

       eif ; !!!

       iny
       tya
       sta pozwpt,x
       jmp r14

r6     bne r7
       iny ; $80: more than 15 spaces
       lda (addr),y
       sta delay,x
       iny
       tya
       sta pozwpt,x
       jmp r14

r7     cmp #$c0
       bcs r8
       and #$3f ; $81-$bf: new note
       add poddzw,x
       sta wysdzw,x
       inc pozwpt,x
       jmp r14

r8     cmp #$d0
       bcs r9
       iny ; $c0-$cf: new tempo
       inc pozwpt,x
       and #15
       sta tempo
       sta ltempo
       jmp r3

r9     cmp #$e0 ; special code
       bcs r15
       mva (addr),y byte
       iny
       mva (addr),y bajt
       iny
       tya
       sta pozwpt,x
       lda byte
       jsr specialcode
       jmp r14

r15    cmp #$f0 ; special code with volume
       bcs r12
       mva (addr),y byte
       iny
       mva (addr),y bajt
       lda byte
       jsr specialcode
       ldy pozwpt,x
       iny
       iny
       lda (addr),y
       sta actvol,x
       and #$f0
       sta actvl1,x

       ift normal ; !!!

       lda (addr),y
       asl @
       asl @
       asl @
       asl @
       sta actvl2,x

       eif ; !!!

       iny
       tya
       sta pozwpt,x
       jmp r14

r12    cmp #$ff
       bcs r10
       sbc #$ef ; $f0-$fe: spaces-$f0 (c is clear here)
       sta delay,x
       inc pozwpt,x
       jmp r14

r10    lda #$40 ; $ff: spaces till the end of pattern
       sta delay,x
       jmp r14

; main play sound loop
sound  jsr pokey
       ldx #7
p5     lda czygrx,x
       beq p6
       jmp graj

grajreturn equ *
       lda silent,x
       beq p7

       lda #0 ; silent channel
       sta vol1ch,x

       ift normal ; !!!

       sta vol2ch,x

       eif ; !!!

       dex
       bpl p5
       jmp p8

p7     ldy bajt
       lda frqtab,y
       add byte
       sta frq,x
       tya
       sta aktwys,x

       lda audctl,x
       and audtb2,x
       beq p11
       lda bajt ; 2 channel bass
       and #$7f
       tay
       lda basslo,y
       add byte
       sta frq-1,x
       lda basshi,y
       adc #0
       sta frq,x
       lda #0
       sta vol1ch-1,x
       ldy przeci,x
       sta vol2ch-1,y
       dex
       dex
       bpl p5
       jmp p8

p11    lda audctl,x
       and audtb1,x
       beq p6
       lda sndfilter,x ;two channel filter
       add bajt
       sta aktwys+2,x
       tay
       lda frqtab,y
       add byte
       sec
       adc filter
       sta frq+2,x

p6     dex
       bpl p5

; sound postprocessing
p8     inx
       stx byte

       ift normal ; !!!

       ldx #3
       lda quadro
       beq p9
       and #$40
       bne p12

       ldx #7 ; standard stereo settings
p9     txa
       tay
       lda vol1ch,y
       bne p10
       ldy przeci,x
       lda vol2ch,y
       bne p10
       txa
       tay
       lda #0
p10    ora znksz,y
       sta volume,x
       lda frq,y
       sta freqen,x
       lda aktwys,y
       sta note,x

       lda audctl,y
       ora byte
       sta byte

       cpx #4
       sne:sta aud2
       dex
       bpl p9
       sta aud1
       rts

p12    equ * ; RMT stereo
p13    lda vol1ch,x
       ora znksz,x
       sta volume,x
       lda vol2ch+4,x
       ora znksz+4,x
       sta volume+4,x
       mva frq,x freqen,x
       mva frq+4,x freqen+4,x
       mva aktwys,x note,x
       mva aktwys+4,x note+4,x
       dex
       bpl p13

       lda audctl
       ora audctl+1
       ora audctl+2
       ora audctl+3
       sta aud1
       lda audctl+4
       ora audctl+5
       ora audctl+6
       ora audctl+7
       sta aud2
       rts

; set pokey
pokey  lda quadro
       jeq pokey1
       jpl pokey2

       lda pokeys+3 ; data for pokey 3
       tax
       lsr @
       lsr @
       and #1
       tay
       lda aud1,y
       sta $d238
       txa
       and #4
       tay
       lda freqtabs,y
       sta $d230
       lda voltabs,x
       sta $d231
       lda freqtabs+1,y
       sta $d232
       lda voltabs+1,x
       sta $d233
       lda freqtabs+2,y
       sta $d234
       lda voltabs+2,x
       sta $d235
       lda freqtabs+3,y
       sta $d236
       lda voltabs+3,x
       sta $d237

       lda pokeys+2 ; data for pokey 2
       tax
       lsr @
       lsr @
       and #1
       tay
       lda aud1,y
       sta $d228
       txa
       and #4
       tay
       lda freqtabs,y
       sta $d220
       lda voltabs,x
       sta $d221
       lda freqtabs+1,y
       sta $d222
       lda voltabs+1,x
       sta $d223
       lda freqtabs+2,y
       sta $d224
       lda voltabs+2,x
       sta $d225
       lda freqtabs+3,y
       sta $d226
       lda voltabs+3,x
       sta $d227

pokey2 lda pokeys+1 ; data for pokey 1
       tax
       lsr @
       lsr @
       and #1
       tay
       lda aud1,y
       sta $d218
       txa
       ldy quadro
       spl:and #4
       tay
       lda freqtabs,y
       sta $d210
       lda voltabs,x
       sta $d211
       lda freqtabs+1,y
       sta $d212
       lda voltabs+1,x
       sta $d213
       lda freqtabs+2,y
       sta $d214
       lda voltabs+2,x
       sta $d215
       lda freqtabs+3,y
       sta $d216
       lda voltabs+3,x
       sta $d217

pokey1 lda pokeys ; data for pokey 0
       tax
       lsr @
       lsr @
       and #1
       tay
       lda aud1,y
       sta $d208
       txa
       ldy quadro
       spl:and #4
       tay
       lda freqtabs,y
       sta $d200
       lda voltabs,x
       sta $d201
       lda freqtabs+1,y
       sta $d202
       lda voltabs+1,x
       sta $d203
       lda freqtabs+2,y
       sta $d204
       lda voltabs+2,x
       sta $d205
       lda freqtabs+3,y
       sta $d206
       lda voltabs+3,x
       sta $d207
       rts

       els ; !!!

       rts

pokey  lda audctl+4
       ora audctl+5
       ora audctl+6
       ora audctl+7
       sta $d218
       lda frq+4
       sta $d210
       lda vol1ch+4
       ora znksz+4
       sta $d211
       lda frq+5
       sta $d212
       lda vol1ch+5
       ora znksz+5
       sta $d213
       lda frq+6
       sta $d214
       lda vol1ch+6
       ora znksz+6
       sta $d215
       lda frq+7
       sta $d216
       lda vol1ch+7
       ora znksz+7
       sta $d217

       lda audctl+0
       ora audctl+1
       ora audctl+2
       ora audctl+3
       sta $d208
       lda frq+0
       sta $d200
       lda vol1ch+0
       ora znksz+0
       sta $d201
       lda frq+1
       sta $d202
       lda vol1ch+1
       ora znksz+1
       sta $d203
       lda frq+2
       sta $d204
       lda vol1ch+2
       ora znksz+2
       sta $d205
       lda frq+3
       sta $d206
       lda vol1ch+3
       ora znksz+3
       sta $d207
       rts

       eif ; !!!

; sound processing
graj   lda adrsnl,x
       sta addr
       lda adrsnh,x
       sta addr+1

       mva shiftfrq,x byte
       mva shiftnote,x bajt
       mva shiftfilter,x filter

       lda slupy,x
       cmp sndlen,x
       bcc n1
       sta opadst,x
       lda sndlop,x
       sta slupy,x
       jmp n0

n1     lda opadst,x ; sound fading
       beq n6
n0     lda opad1,x
       beq n7
       dec lopad1,x
       bne n7
       sta lopad1,x
       lda actvl1,x
       beq n7
       sub #16
       sta actvl1,x
n7     lda opad2,x
       beq n6
       dec lopad2,x
       bne n6
       sta lopad2,x

       ift normal ; !!!

       lda actvl2,x
       beq n6
       sub #16
       sta actvl2,x

       eif ; !!!

n6     ldy aperm,x ; arpeggio
       lda (addr),y
       add wysdzw,x
       add:sta bajt
       dec lperm,x
       bpl m1
       lda dperm,x
       sta lperm,x
       lda kolejn,x
       beq m6
       add aperm,x
       sta aperm,x
       beq m7
       cmp ilperm,x
       bcc m1
       lda #$ff
       sta kolejn,x
       jmp m1

m7     lda #1
       sta kolejn,x
       jmp m1

m6     inc aperm,x
       lda ilperm,x
       cmp aperm,x
       bcs m1
       lda #0
       sta aperm,x

m1     lda #19
       add:sta addr
       scc:inc addr+1

       ldy slupy,x
       lda (addr),y ; main sound data
       and #$f0
       sta znksz,x
       lda (addr),y
       and #15
       ora actvl1,x
       tay
       lda voltab,y
       ora maxvol
       tay
       lda voltab,y
       sta vol1ch,x

       ift normal ; !!!

       ldy slupy,x
       iny
       lda (addr),y
       and #15
       ora actvl2,x
       tay
       lda voltab,y
       ora maxvol
       tay
       lda voltab,y
       sta vol2ch,x

       eif ; !!!

       lda czekaj,x
       bne m2
       lda typ,x
       sta m5+1
m5     bpl * ; jmp
       jmp typ0
       nop
       jmp typ1
       nop
       jmp typ2
       nop
       jmp typ3
       nop
       jmp typ4
       nop
       jmp typ5
       nop
       jmp typ6
       nop
       jmp typ7

m2     dec czekaj,x
m3     ldy slupy,x ; accents
       iny
       lda (addr),y
       and #$70
       lsr @
       lsr @
       lsr @
       sta n5+1
       lda (addr),y
       bmi n3
       lda mainaudctl,x
       jmp n4
n3     lda addaudctl,x
n4     and usedaudctl,x
       sta audctl,x
       iny
       iny
       tya
       sta slupy,x
       dey
       lda (addr),y
n5     bcc * ; jmp
       bcc a0
       bcc a1
       bcc a2
       bcc a3
       bcc a4
       bcc a5
       bcc a6
       bcc a7

; accents
a1     adc:sta shiftfrq,x
       lda (addr),y
a0     add:sta byte
       jmp grajreturn

a3     adc:sta shiftnote,x
       lda (addr),y
a2     add:sta bajt
       jmp grajreturn

a5     adc:sta shiftfilter,x
       lda (addr),y
a4     add:sta filter
       jmp grajreturn

a6     sta byte
       lda #0
a7     sta bajt
       jmp grajreturn

; effects
typ1   lda typdat,x
       and #3
       lsr @
       bcc t0
       bne t1
       lda param,x
       add:sta byte
t0     dec ltyp,x
       bpl typ0
       inc typdat,x
       mva dtyp,x ltyp,x
       jmp m3

t1     lda byte
       sbc param,x ; sec
       sta byte
       dec ltyp,x
       bpl typ0
       inc typdat,x
       mva dtyp,x ltyp,x
       jmp m3

typ2   ldy typdat,x
       lda param,x
       bmi t2
       iny
       iny
t2     dey
       tya
       add:sta byte
       dec ltyp,x
       bpl typ0
       tya
       sta typdat,x
       cmp param,x
       bne t3
       eor #$ff
       sta param,x
t3     mva dtyp,x ltyp,x
typ0   jmp m3

typ3   ldy typdat,x
       lda param,x
       bmi t4
       iny
       iny
t4     dey
       tya
       add:sta bajt
       dec ltyp,x
       bpl typ0
       tya
       sta typdat,x
       cmp param,x
       bne t3
       eor #$ff
       sta param,x
       mva dtyp,x ltyp,x
       jmp m3

typ4   lda typdat,x
       add:sta byte
       dec ltyp,x
       bpl typ0
       lda param,x
       add:sta typdat,x
       mva dtyp,x ltyp,x
       jmp m3

typ5   lda bajt
       sub typdat,x
       sta bajt
       dec ltyp,x
       bpl typ0
       lda param,x
       add:sta typdat,x
       mva dtyp,x ltyp,x
       jmp m3

typ6   lda param,x
       add:sta byte
typ7   jmp m3 ; placeholder for new type of sound

;----------------
; init functions

; play song, X=number of song
songx  ldy #16
zm4    lda #0
       sta addr
zm5    lda #0
       sta addr+1
       mva #0 pozsng
d5     txa
       beq inic
       lda (addr),y
       seq:bpl d4
       dex
d4     lda #17
       add:sta addr
       scc:inc addr+1
       inc pozsng
       bne d5
       ldx #0

; play song, X=line of song
playx  lda #0
       sta byte
       txa
       sta pozsng
       asl @
       rol byte
       asl @
       rol byte
       asl @
       rol byte
       asl @
       rol byte
       adc pozsng ; clc
       scc:inc byte
       clc
zm6    adc #0
       sta addr
       lda byte
zm7    adc #0
       sta addr+1
inic   jsr stop
       mwa addr adrsng
       ldx #7
i4     mva #$ff actvol,x
       lda #$f0
       sta actvl1,x

       ift normal ; !!!

       sta actvl2,x

       eif ; !!!

       dex
       bpl i4
       lda #3
       sta $d20f
       sta $d21f

       ift normal ; !!!

       sta $d22f
       sta $d23f

       eif ; !!!

       dec pozsng
       inx
       stx ltempo
       inx
       stx pozptr
       stx czygrc
       rts

i1     txa ; change of tempo
       and #15
       sta tempo
       rts
i2     stx czygrc ; pause, continue
       rts

init   cmp #$10 ; A=$00
       jcc songx
       cmp #$20 ; A=$10
       bcc playx
       cmp #$30 ; A=$20
       jcc d2
       cmp #$40 ; A=$30
       bcc i1
       cmp #$50 ; A=$40
       jcc stop
       cmp #$60 ; A=$50
       bcc i2
       cmp #$70 ; A=$60
       jcs i3
       sty bajt

specialcode and #15
       asl @
       sta sc17+1
       lda bajt
sc17   bcc * ; jmp
       bcc sc0
       bcc sc1
       bcc sc2
       bcc sc3
       bcc sc4
       bcc sc5
       bcc sc6
       bcc sc7
       bcc sc8
       bcc sc9
       bcc sc10
       bcc sc11
       bcc sc12
       bcc sc13
       bcc sc14
       bcc sc15

sc0    sta specialflag ; code 0: set special flag
sc10   equ *
sc11   equ *
sc12   equ *
sc13   equ *
sc14   equ *
sc15   equ *
       rts

; special codes
sc4    sta sndfilter,x
       rts
sc5    sta mainaudctl,x
       rts
sc6    sta addaudctl,x
       rts
sc7    sta shiftfilter,x
       rts
sc8    sta shiftfrq,x
       rts
sc9    sta shiftnote,x
       rts

sc1    and #$70
       lsr @
       lsr @
       sta typ,x
       and #$30
       sne:sta typdat,x
       lda bajt
       bmi sc16
       and #15
       sta param,x
       rts

sc16   and #15
       eor #$ff
       add #1
       sta param,x
       rts

sc2    and #$3f
       sta dtyp,x
       sta ltyp,x
       rts

sc3    and #$80
       asl @
       rol @
       sta kolejn,x
       lda bajt
       and #$70
       lsr @
       lsr @
       lsr @
       lsr @
       sta ilperm,x
       sne:sta kolejn,x
       lda bajt
       and #15
       sta dperm,x
       sta lperm,x
       lda aperm,x
       cmp ilperm,x
       bcc sc0
       lda ilperm,x
       seq:sbc #1 ; sec
       sta aperm,x
       rts

; init of new song
i3     sty addr
       stx addr+1

       ldy #25
       mva (addr),y+ quadro
       mva (addr),y+ pokeys
       mva (addr),y+ pokeys+1
       mva (addr),y+ pokeys+2
       mva (addr),y+ pokeys+3
       lda (addr),y
       sta tempo

       lda addr ; low byte of instruments data
       eor #$80
       smi:inx
       sta zm8+1
       stx zm8+2

       eor #$80 ; low byte of pattern data
       smi:inx
       sta zm2+1
       stx zm2+2

       inx      ; high byte of pattern data
       sta zm3+1
       stx zm3+2

       inx      ; high byte of instrument data
       sta zm9+1
       stx zm9+2

       eor #$80 ; track data
       smi:inx
       sta adrsng
       sta zm0+1
       sta zm4+1
       sta zm6+1
       stx adrsng+1
       stx zm1+1
       stx zm5+1
       stx zm7+1

       mva #$f0 maxvol
       lda #0
       sta czygrc
       sta specialflag

; stop playing
stop   ldx #7
       lda #0
       sta czygrc
d9     sta czygrx,x
       sta audctl,x
       sta vol1ch,x

       ift normal ; !!!

       sta vol2ch,x
       sta volume,x
       sta $d230,x
       sta $d220,x

       eif ; !!!

       sta $d210,x
       sta $d200,x
       dex
       bpl d9
       sta $d218
       sta $d208

       ift normal ; !!!

       sta $d238
       sta $d228
       sta aud1
       sta aud2

       eif ; !!!
       rts

; procedures for play new instrument
d1     sta vol1ch,x ; if attempt to play empty sound - clear data

       ift normal ; !!!

       sta vol2ch,x
       sta volume,x

       eif ; !!!

       sta audctl,x
       rts

d0     tya ; change only volume
       sta actvol,x
d3     and #$f0
       sta actvl1,x
       lda actvol,x

       ift normal ; !!!

       asl @
       asl @
       asl @
       asl @
       sta actvl2,x

       eif ; !!!

       rts

d2     and #7
       sta addr
       txa
       ldx addr
       and #$3f
       beq d0
       sta wysdzw,x
       tya
       bmi d2-1
       lda actvol,x
       jsr d3
dzwiek mva #0 czygrx,x
zm9    lda $ffff,y
       beq d1
       sta adrsnh,x
       sta addr+1
zm8    lda $ffff,y
       sta adrsnl,x
       sta addr
       tya
       sta numdzw,x

       ldy #8
       mva (addr),y+ sndlen,x
       mva (addr),y+ sndlop,x
       mva (addr),y+ sndfilter,x
       mva (addr),y+ mainaudctl,x
       mva (addr),y+ addaudctl,x
       mva (addr),y+ opad1,x
       sta lopad1,x
       mva (addr),y+ opad2,x
       sta lopad2,x
       lda (addr),y
       and #$70
       lsr @
       lsr @
       sta typ,x

       lda (addr),y+
       bmi d7
       and #15
       sta param,x
       jmp d8
d7     and #15
       eor #$ff
       add #1
       sta param,x

d8     mva (addr),y+ czekaj,x
       lda (addr),y+
       and #$3f
       sta dtyp,x
       sta ltyp,x
       lda (addr),y
       and #$80
       asl @
       rol @
       sta kolejn,x
       lda (addr),y
       and #$70
       lsr @
       lsr @
       lsr @
       lsr @
       sta ilperm,x
       bne d6
       sta kolejn,x
d6     lda (addr),y-
       and #15
       sta dperm,x
       sta lperm,x
       lda (addr),y
       and #$c0
       ora wysdzw,x
       sta wysdzw,x
       tay
       lda frqtab,y
       sta frq,x

       lda #0
       sta slupy,x
       sta typdat,x
       sta opadst,x
       sta aperm,x
       sta shiftfrq,x
       sta shiftnote,x
       sta shiftfilter,x
       lda #1
       sta czygrx,x
       rts

endplr end