; Compile with WLA-6510 (http://www.hut.fi/~vhelin/wla.html)
.DEFINE dest $f7
.DEFINE desth $f8
.DEFINE source $f9
.DEFINE sourceh $fa
.DEFINE dataend $0100
.DEFINE dataendh $0101
;***** BLOCK PACKER ******************************************************
BlockPack:
ldy #$00
_seeklast:
lda Sequencer,y ; find last step in sequencer
beq _lastseq
iny
cpy #$40
bne _seeklast
_lastseq:
iny ; space for loop mark
tya
asl
clc
adc #$c0
sta dest
lda #$65
adc #$00
sta desth ; address of first packed block
lda #$00
ldy #$3f
_clrtmpb:
sta $65c0,y ; packed player sequencer
sta $6000,y ; temporary block address map
sta $6040,y ; temporary block address map
dey
bpl _clrtmpb
ldy #$00 ; sequencer position
_packnextblock:
tya
pha
ldx.w Sequencer,y
beq _packendloop
jsr PackOneBlock
pla
tay
iny
jmp _packnextblock
_packendloop:
pla
ldx.w Sequencer+1,y ; get loop position
tya
asl
tay
lda #$00
sta $65c0,y ; 'loop'
txa
sta $65c1,y ; loop position
ldy #$00
ldx #$00
_songt:
lda $3500,x ; add song tag
jsr _byteout
inx
cpx #$18
bne _songt
ldx #$00
_tagit:
lda.w PackedTag,x ; add john player tag
jsr _byteout
inx
cpx #$18
bne _tagit
lda dest ; end of packed data
sta.w dataend
lda desth
sec
sbc #$50
sta.w dataendh
rts
PackedTag:
.DB "/JOHN PLAYER BY A. EEBEN"
;----- pack one block in sequencer step y, block number in x
PackOneBlock:
tya
asl
tay
lda $6000,x ; same block packed earlier?
beq _notpackedyet
sta $65c0,y
lda $6040,x
sta $65c1,y
rts
_notpackedyet:
lda desth ; store packed block address
clc
adc #$b0
sta $65c0,y ; unusual byte order
sta $6000,x
lda dest
sta $65c1,y
sta $6040,x
txa
clc
adc #(BlockData/256)-1
sta sourceh
ldy #$00
sty source
ldx #$20 ; lines in block
_nextline:
ldy #$07
_buf:
lda (source),y ; buffer line
sta.w buffer,y
dey
bpl _buf
iny ; zero
lda source ; advance to next line in block
clc
adc #$08
sta source
;---- check if no notes on line
lda.w buffer+2
bne _notempty
lda.w buffer+4
bne _notempty
lda.w buffer+6
bne _notempty
lda #$ff ; output 'no notes on line'
jsr _byteout
jmp _cmdout
_notempty:
;---- channel 1
lda.w buffer+2 ; c1 note
beq _c1onebyte
bmi _c1onebyte
jsr _byteout ; output note
lda.w buffer+3 ; get sound number
_c1onebyte:
jsr _byteout ; output $00 or $fe or sound number
;---- check if no notes on channels 2 and 3
lda.w buffer+4
bne _notemptyb
lda.w buffer+6
bne _notemptyb
lda #$ff ; output 'no more notes on line'
jsr _byteout
jmp _cmdout
_notemptyb:
;----- channel 2
lda.w buffer+4 ; c2 note
beq _c2onebyte
bmi _c2onebyte
jsr _byteout ; output note
lda.w buffer+5 ; get sound number
_c2onebyte:
jsr _byteout ; output $00 or $fe or sound number
;----- channel 3
lda.w buffer+6 ; c3 note
beq _c3onebyte
bmi _c3onebyte
jsr _byteout ; output note
lda.w buffer+7 ; get sound number
_c3onebyte:
jsr _byteout ; output $00 or $fe or sound number
;----- command
_cmdout:
lda.w buffer
beq _cmdonebyte
jsr _byteout ; output cmd
cmp #$02 ; skip rest of block if 'brk'
beq _blockend
cmp #$01 ; no parameter needed for 'end'
beq _linedone
lda.w buffer+1 ; get cmd parameter
_cmdonebyte:
jsr _byteout ; output 'no cmd' or cmd parameter
_linedone:
dex
beq _blockend
jmp _nextline ; next line in block
_blockend:
rts
;----- byte out
_byteout:
sta (dest),y
inc dest
bne _nocd
inc dest+1
_nocd:
rts
buffer:
.DB $00,$00,$00,$00,$00,$00,$00,$00
;***** MUSIC FILE PACKER *************************************************
.DEFINE rlecode $a7
.DEFINE musicend $36
;----- pack music from $1400-$35ff to $6000
MusicPack:
lda #$4a
sta $6000
lda #$4f
sta $6001
lda #$48
sta $6002
lda #$4e
sta $6003
lda #$14
sta source+1
lda #$60
sta dest+1
lda #$00
sta source
lda #$04
sta dest
_rleseek:
ldy #$00
ldx #$00
lda (source),y
_rlerept:
cpy #$ff
beq _rlepack
iny
cmp (source),y
beq _rlerept
cmp #rlecode
beq _rlepack ; escape hit
cpy #$04
bcs _rlepack ; pack if more than 4
sta (dest,x) ; write noncomp byte
inc source ; advance source by 1
bne _rlna
inc source+1
_rlna:
lda #$01
jmp _rleadvdest
_rlepack:
pha
tya
clc
adc source
sta source
bcc _rlnoca
inc source+1
_rlnoca:
lda #rlecode
sta (dest,x) ; write esc
tya
ldx #musicend
cpx source+1
bne _rlenotrim
sec
sbc source ; trim end of data
_rlenotrim:
ldy #$01
sta (dest),y ; write count
iny
pla
sta (dest),y ; write bytevalue
lda #$03
_rleadvdest:
clc ; advance dest by a
adc dest
sta dest
bcc _rlnocb
inc dest+1
_rlnocb:
ldx #musicend
cpx source+1
bne _rleseek
_rledone:
ldy #$00
lda #rlecode
sta (dest),y
iny
lda #$00
sta (dest),y
lda #$02
clc
adc dest
sta dest
bcc _rlnoce
inc dest+1
_rlnoce:
lda dest
sta.w dataend
lda desth
sta.w dataendh
rts
;----- unpack music from $6000 to $1400
MusicUnpack:
lda #$4a ; is it really john?
cmp $6000
bne _bad
lda #$4f
cmp $6001
bne _bad
lda #$48
cmp $6002
bne _bad
lda #$4e
cmp $6003
beq _notbad
_bad:
rts
_notbad:
lda #$60
sta source+1
lda #$14
sta dest+1
lda #$04
sta source
ldy #$00
sty dest
_unpackloop:
ldy #$00
lda (source),y
cmp #rlecode
beq _unpack
sta (dest),y
inc source
bne _munops
inc source+1
_munops:
inc dest
bne _unpackloop
inc dest+1
_munopd:
jmp _unpackloop
_unpack:
iny
lda (source),y ; get count
beq _unpackdone
sta tmpreg
iny
lda (source),y ; get bytevalue
ldy tmpreg
_reptout:
dey
sta (dest),y
bne _reptout
lda tmpreg
clc
adc dest
sta dest
bcc _nocda
inc dest+1
_nocda:
lda #$03
clc
adc source
sta source
bcc _nocdb
inc source+1
_nocdb:
jmp _unpackloop
_unpackdone:
rts