;---------------T

DEBUG	equ	0

	incdir	Include40/
	include	misc/AYPlayer.i
	include	misc/mine.i
	incdir	''

	ifne	DEBUG

	lea	song(pc),a0
	bsr	initsound
	bsr	interrupt
	rts

song	dc.b	0,1,2,3
	dc.w	50814
	dc.w	0
	dc.b	0;,0
	incbin	zx:archive/megamixcomp.001
	endc

* STRC (SoundTracker Raxoft Compiler) AY Player for
* SoundTracker songs compiled by my compiler/compressor

* 1 Initial version

	STRUCTURE	STRC_Song,0
	UBYTE	ams_assignA	;0-3 specifies, what amiga channel will be
	UBYTE	ams_assignB	;assigned to each ay channel (A-C, noise)
	UBYTE	ams_assignC
	UBYTE	ams_assignN
	UWORD	strc_getabs	;start of data in ZX ram
	WORD	ams_fadeoffset	;precise fade specification
	UWORD	ams_fadelen	;how long to fade (not supported by DT so far)
				;set to zero for neverending song
	;and so on...

; The Player itself.

dd
	AYPLAYERHEADER	STRC
	dc.b	12+1		;custom ayfreq transpose
	ifeq	DEBUG
AYbase	ds.l	1		;where ay registers should be "outed"
	else
AYbase	dc.l	ay		;where ay registers should be "outed"
	endc
	ifeq	DEBUG
AYass	ds.l	1		;where ay channel assignment should be copied
	else
	dc.l	ay
	endc
AYfreq	ds.l	1		;from where we take AY frequencies
	dc.w	0		;initplayer
	dc.w	0		;endplayer
	dc.w	initsound-*
	dc.w	0		;endsound
	dc.w	interrupt-*
	dc.w	nextpatt-*
	dc.w	prevpatt-*
	dc.b	'SoundTracker (Raxoft) 1.2',0
	dc.b	'(C) 1990 Patrik Rak - Raxoft',0
	dc.b	'(C) 1994 Patrik Rak - Raxoft',0
	even

initsound	moveq	#0,d1			;clear variables
	lea	vars,a1
	moveq	#(data-vars)/2-1,d0
.fill	move.w	d1,(a1)+
	dbra	d0,.fill

	move.l	AYass(pc),a2		;feed PlayAY
	move.l	(a0)+,(a2)		;with channel assignement

	move.w	(a0)+,d1		;get getabs (upper word is zero)!!

	move.w	(a0)+,d2		;gate fadeoffset

	move.w	(a0)+,songfade-data(a1)	;store fadelen

	moveq	#0,d0
	move.b	(a0),d0			;delay
	move.w	(a0),d3
	and.w	#$ff,d3
	mulu	d0,d3			;pattlen in VBIs...

	moveq	#envtab,d0
	add.l	a0,d0
	move.l	d0,(a1)+	;data
	sub.l	d1,a0
	move.l	a0,(a1)+	;getabsset
	move.w	#$0101,(a1)+	;curdelay & curpattlen
	moveq	#posbeg-envtab,d1
	add.l	d1,d0
	move.l	d0,(a1)+		;position

	move.w	d3,(a1)+	;vbipattlen
	move.w	d2,(a1)+	;fadeofset

	move.l	d0,a0
.count	add.w	d3,d2
	addq.l	#7,a0
	tst.b	1(a0)
	bne.b	.count
	move.w	d2,(a1)		;songlen
	rts

nextpatt	lea	position,a1
	move.l	(a1),a0
	tst.b	1(a0)
	bne.b	patterns		;no next pattern
	rts

prevpatt	lea	position,a1
	move.l	(a1),a0
	subq.l	#7,a0
	subq.l	#7,a0
	moveq	#posbeg-xy,d0
	add.l	data-position(a1),d0
	cmp.l	d0,a0
	bcc.b	patterns
	move.l	d0,a0
patterns	move.w	#$101,-2(a1)
	move.l	a0,(a1)+
	move.w	(a1)+,d3
	move.w	(a1)+,d2
	tst.w	(a1)
	bne.b	initsound\.count
	rts

interrupt	lea	ay,a6	;base
	lea	data-ay(a6),a0
	move.l	(a0)+,a5	;data
	move.l	(a0)+,d7	;getabsset
	moveq	#0,d6		;use d6 as obsl1 in original
	subq.b	#1,(a0)
	bne.b	.samenote
	moveq	#-1,d6		;signal new tones
	move.b	delay-xy(a5),(a0)+
	subq.b	#1,(a0)
	bne.b	.samenote
	move.b	pattlen-xy(a5),(a0)+
	move.l	(a0),a0
	tst.b	1(a0)
	bne.b	.notend
	lea	posbeg-xy(a5),a0
.notend	bsr.b	getabs
	move.l	d0,ch1-ay(a6)
	bsr.b	getabs
	move.l	d0,ch2-ay(a6)
	bsr.b	getabs
	move.l	d0,ch3-ay(a6)
	move.b	(a0)+,transpose+1-ay(a6)
	move.l	a0,position-ay(a6)
.samenote	lea	ch1-ay(a6),a2
	move.l	a6,a3			;lea	freqa-ay(a6),a3
	lea	vola-ay(a6),a4
	moveq	#0,d5
	st	strobe-ay(a6)	;all off
.loop	bsr.b	obsluha
	lea	chlen(a2),a2
	addq.l	#2,a3
	addq.l	#1,a4
	addq.b	#1,d5
	cmp.b	#3,d5
	bne.b	.loop
	move.l	AYbase(pc),a1
	moveq	#11-1,d0
.outy	move.b	(a6)+,(a1)+
	dbra	d0,.outy
	move.b	(a6)+,d0
	beq.b	.done
	move.b	(a6)+,(a1)+
	move.b	(a6),(a1)+
	move.b	d0,(a1)
.done	lea	songlen-volc-1(a4),a0
	moveq	#0,d0
	tst.w	(a0)
	beq.b	.exit
	subq.w	#1,(a0)+
	bne.b	.exit
	move.w	(a0),d0
.exit	rts


getabs	moveq	#0,d0		
	move.b	(a0)+,d1
	move.b	(a0)+,d0
	lsl.w	#8,d0
	move.b	d1,d0
	add.l	d7,d0
	rts

gettab	move.l	d2,d0	;because tables are even
gettab2	move.w	(a0,d0.w),d0
	ror	#8,d0
	add.l	d7,d0
	move.l	d0,a0
	add	d3,a0
	rts

;a2 channel, a3 freq, a4 volume, d5 how much rotate strobe

obsluha	tst	d6		;new tones?
	beq.b	.same
	bsr.w	newtone
	bra.b	.cont
.same	bsr.w	sametone
.cont	moveq	#0,d2
	move.b	smp(a2),d2	;sample number
	add.w	d2,d2
	lea	tonetab-xy(a5,d2),a0
	bsr.b	getabs
	move.l	d0,a0
	moveq	#0,d3
	move.b	pos(a2),d3
	add	d3,a0
	add	d3,a0
	move.b	(a0)+,d1
	move.b	(a0),d4
	lsl.w	#8,d4
	move.b	d1,d4

	add.w	d4,d4	;can be negative...
	add.w	d4,d4
	add.w	d4,d4

	moveq	#0,d0
	move.b	orn(a2),d0
	add.w	d0,d0
	lea	orntab-xy(a5),a0
	bsr.b	gettab2
	move.w	transpose-ay(a6),d0
	add.b	(a0),d0
	add.b	tone(a2),d0
	add.w	d0,d0
	move.l	AYfreq(pc),a0
	add.w	d0,a0
	add.w	(a0),d4
	move.w	d4,(a3)		;freq

	move.l	a5,a0		;lea envtab-xy(a5),a0
	bsr.b	gettab
	move.b	(a0),d4
	beq.b	.envel0
	lea	noistab-xy(a5),a0
	bsr.b	gettab
	move.b	(a0),d3
	move.b	d3,d2
	moveq	#-2,d0		;strobe for tone on
	add.b	d2,d2		;noise off?
	bcs.b	.nonoise
	moveq	#-10,d0		;strobe for tone and noise on
	and.b	#31,d3
	move.b	d3,noise-ay(a6)	;noise
.nonoise	add.b	d2,d2
	bcc.b	.toneon
	addq.b	#1,d0		;turn the tone off
.toneon	rol.b	d5,d0
	and.b	d0,strobe-ay(a6)
	and.b	#16,(a4)	;keep just previous env on flag!!!
	or.b	d4,(a4)		;vol
.envel0	rts

newtone	move.l	(a2),a0
	moveq	#0,d0
	move.b	(a0)+,d0
	bmi.b	silentqm
	move.b	d0,tone(a2)
	move.b	(a0)+,d0
	move.b	(a0)+,d2
	move.l	a0,(a2)
	
	moveq	#15,d1
	and.b	d0,d1
	lea	smpmem(a2),a0
	lsr.b	#4,d0
	bne.b	.newsmpl
	move.b	(a0),d0
.newsmpl	move.b	d0,(a0)+
	move.b	d0,(a0)+
	clr.b	(a0)+
	move.b	#32,(a0)+
	add	d0,d0
	lea	smpltab-xy(a5,d0.w),a1
	move.w	(a1),(a0)		;even table

	moveq	#%01111101,d0
	btst	d1,d0
	bne.b	.exit
	clr.b	orn(a2)
	clr.b	(a4)
	cmp.b	#1,d1
	beq.b	.exit
	cmp.b	#15,d1
	bne.b	.env
	and	d1,d2
	move.b	d2,orn(a2)
	rts
.env	move.b	#16,(a4)
	move.b	d1,envtype-ay(a6)
	move.b	d2,envfreq-ay(a6)	;fill only lower byte
.exit	rts

silentqm	move.l	a0,(a2)
	addq.b	#1,d0
	bne.b	sametone
	clr.b	smpmem(a2)
silent	clr.b	smp(a2)
	clr.b	(a4)
	;rts	;to behave exactly as origal I omit this logical rts

sametone	addq.b	#1,pos(a2)
	and.b	#31,pos(a2)
	subq.b	#1,len(a2)
	bne.b	.exit
	move.b	rpos(a2),d0
	beq.b	silent
	subq.b	#1,d0
	move.b	d0,pos(a2)
	move.b	rlen(a2),len(a2)
.exit	rts

	section	variables,bss
vars
ay
freqa	ds.w	1
freqb	ds.w	1
freqc	ds.w	1
noise	ds.b	1
strobe	ds.b	1
vola	ds.b	1
volb	ds.b	1
volc	ds.b	1
envtype	ds.b	1		;note that these two
envfreq	ds.w	1		;lines are swapped!!!

	rsreset
strm	rs.l	1		;Position in pattern stream
tone	rs.b	1		;Current tone
orn	rs.b	1		;Ornament number (tone slides)
smpmem	rs.b	1		;sample nr (same as smp, but this remains intact)
smp	rs.b	1		;Current sample nr (freq slides, env & noise)
pos	rs.b	1		;Position in sample/ornament
len	rs.b	1		;Sample/orn length remaining to loop test
rpos	rs.b	1		;If, then where start repeating sample/orn
rlen	rs.b	1		;What len use when looping
;following three are maintained directly in this conversion
;ctrl	rs.b	1		;Partial tone noise strobe
;freq	rs.w	1		;Freq calculated for this channel
;vol	rs.b	1		;Volume for this channel
chlen	rs.b	0

ch1	ds.b	chlen
ch2	ds.b	chlen
ch3	ds.b	chlen

data	ds.l	1		;song data
getabsset	ds.l	1		;ZX Ram base

curdelay	ds.b	1
curpattlen	ds.b	1
position	ds.l	1
vbipattlen	ds.w	1
fadeoffset	ds.w	1
songlen	ds.w	1
songfade	ds.w	1
transpose	ds.w	1
varsend
varslen	equ	*-vars

	rsreset
delay	rs.b	1	;how long each note sounds (VBIs)
pattlen	rs.b	1	;how many notes in each pattern
tonetab	rs.w	16	;ptrs to seq of freq slides
orntab	rs.w	16	;ptrs to seq of tone slides
xy	rs.b	0
envtab	rs.w	16	;ptrs to seq of volume values
noistab	rs.w	16	;ptrs to seq of noise values + tone&noise mask
smpltab	rs.w	16	;table of rpos and rlen s
posbeg	rs.b	0