Include	"Equ.s"
Translate	equ -30

******************************************************************
*	 **  *    * **** ****    ***    **  **** ***  ***
* 	*  * **  ** *  * *       *  *  *  * *     *  *
* 	**** * ** * *  * ****    ****  **** ****  *  *
* 	*  * *    * *  *    *    *   * *  *    *  *  *  
* 	*  * *    * **** ****    ****  *  * **** ***  ***
******************************************************************
*
* 	AMOS MUSICAL ROUTINES
*
*	Version 1.1
*	By Francois Lionet
*	AMOS (c) Mandarin / Jawx 1990
*
*	This source code is public domain
*
******************************************************************
*
*	Here is the main AMOS extension. It includes all music
* instructions, and is a perfect example of how to create a
* extension for AMOS.
* 	It has been assembled with GENAM2.
*
*	This code is certainely not perfect, some parts may seem to
* you improvable, and sure are! If you make changes to it, be sure
* keep compatibility with the previous version. Create a version for
* each new change so that AMOS music extension don`t become a
* jungle!
*	Some labels may look rather French to you, but sorry, it is
* my native language!
*	
*	When you program an extension, try to program it in RELATIVE
* code, using adress register and index. The COMPILER will only
* accept relative code.
*
*	Thanks to Andreas Tadic, the author of GMC for inspiration in 
* some parts of the music routine...
*
******************************************************************

******************************************************************
*	AMOS INTERFACE

*******	COLD START
*	This must be at the beginning of your program!
*	It is called just after loading...
*
* On Entry:
*	A0=	Branch table
*	A1=	Current intuition.library base
*	A2=	Current graphic.library base
*	A3=	Current diskfont.library base
*	A5=	AMOS data zone address
* You must return
*	A0=	Token table
*	A1=	Welcome message
*	A2=	Routine called by screen reset
*	A3=	Routine called on Quit
*	D0=	False/true-> ERROR
*	D1=	Number of extension. This number MUST be the same
*		than the extension number in the extension list
*	D2=	Address of a routine called each time a memory bank
*		has been changed, zero if not to be called
*
*	If D1<>number of extension or D0=true, AMOS does not load!
*
	movem.l	a4-a6,-(sp)

*	If AMOS data zone, stands 8 long words allowing you to simply
*	put a patch in the VBL interrupt. The first on is at VBLRout.
*	At each VBL, AMOS explores this list, and call all address <> 0
*	It stops at the FIRST zero. The music patch is the first routine
* 	called.
	lea	MusInt(pc),a1		* Interrupt routine
	move.l	a1,VBLRout(a5)		* Branch
	lea	MusAdr(pc),a1
	move.l	a0,(a1)			* Store address of BRANCH TABLE
	lea	MB(pc),a3		* Base of music parameters
	lea	BkCheck(pc),a0		* Address of CHECK MUSIC BANK
	move.l	a0,d2
	lea	AdMB(pc),a1
	move.l	a3,(a1)
	lea	Tk(pc),a0		* Address of TOKEN TABLE
	lea	MusWel(pc),a1		* Address of WELCOME MESSAGE
	lea	MusDef(pc),a2		* Address of SCREEN RESET
	lea	MusEnd(pc),a3		* Address of QUIT
	moveq	#0,d1			* Returns NUMBER OF EXTENSION
	movem.l	(sp)+,a4-a6
	moveq	#0,d0			* NO ERRORS
	rts

******* SCREEN RESET
*	Each time a DEFAULT occurs, this routine is called. If you
*	do not want any effect, make it point to a RTS
MusDef:	
	lea	MB(pc),a3
* Init narrator
	bsr	NarInit
* Init musique
	bsr	RazWave			* Reset waves
	move.l	Buffer(a5),a0		* Draw square wave
	move.l	a0,a1
	moveq	#127,d0
MuDf1	move.b	#-127,128(a0)
	move.b	#127,(a0)+
	dbra	d0,MuDf1
	moveq	#0,d1			* 0-> Noise
	bsr	NeWave
	moveq	#1,d1			* 1-> Square wave
	bsr	NeWave
	move.w	#LNoise/2-1,d2		* Draw first noise
	move.w	BSeed-MB(a3),d1
	move.l	WaveBase-MB(a3),a0
	lea	WaveDeb(a0),a0
MuDf2	add.w	Circuits+6,d1
	mulu	#$3171,d1
	lsr.l	#8,d1
	move.w	d1,(a0)+
	dbra	d2,MuDf2
	move.w	d1,BSeed-MB(a3)
	moveq	#56,d0			* Default settings
	moveq	#%1111,d1
	bsr	Vol
	bsr	MVol
	move.w	#5,SamBank-MB(a3)	* Sample bank=5	
	moveq	#0,d0			* Sam loop off
	moveq	#-1,d1
	bsr	SL0
	bsr	MuInit
	rts

******* QUIT
*	Here you should restore everything to normal, close
*	all opened libraries, give all reserved memory back to
*	the system...
MusEnd:	lea	MB(pc),a3
* Plus de routine VBL
	clr.l	VBLRout(a5)		* No more routine
* End narrator (if there)
	tst.l	TranBase-MB(a3)
	beq.s	NarEnd
	lea	WriteRep-MB(a3),a1
	move.l	$4,a6
	jsr	RemPort(a6)
	lea	TalkIO-MB(a3),a1
	jsr	CloseDev(a6)
	move.l	TranBase-MB(a3),a1
	jsr	CloseLib(a6)
* End music
NarEnd	bsr	MOff
	moveq	#%1111,d0
	bsr	EnvOff
	bsr	RazWave
	lea	Circuits,a0
	move.w	#$000F,DmaCon(a0)
	move.w	#%0000011110000000,IntReq(a0)
	move.w	#%0000011110000000,IntEna(a0)
	clr.w	$a8(a0)
	clr.w	$b8(a0)
	clr.w	$c8(a0)
	clr.w	$d8(a0)
	rts

******* Now follow a tricky thing to allow AMAL to grab the address
*	of the vumeters. AMAL will get the address of the music extension
*	BkCheck routine, look 4 bytes before, and get the address of the
*	voices volume level
AdMB	dc.l	0			
******* LOOK FOR MUSIC BANK
*	Authorised registers: D0-D7/A0-A3
BkCheck	lea	MB(pc),a3
	move.l	MusBank-MB(a3),d0	* Address of OLD music bank
	move.l	2*8(a0),d1		* Address of ACTUAL music bank
	beq.s	BkNo			* 8 bytes per bank (here bank 3)
	move.l	d1,a1			* Looks for "Musi"
	move.l	(a1),d2		
	cmp.l	BkMus-MB(a3),d2
	bne.s	BkNo
	lea	8(a1),a1
	moveq	#0,d1			* Performs a check sum
	add.l	(a1),d1
	add.l	4(a1),d1
	add.l	8(a1),d1
	add.l	12(a1),d1
	cmp.l	d0,a1
	bne.s	BkNew
	cmp.l	MusCheck-MB(a3),d1
	bne.s	BkNew
* Same bank! Do nothing!
	rts
* No more bank!
BkNo	tst.l	d0
	beq.s	BkNo1
	bsr	MuInit
	clr.l	MusBank-MB(a3)
BkNo1	rts
* A NEW bank
BkNew	move.l	a1,MusBank-MB(a3)
	move.l	d1,MusCheck-MB(a3)
	bsr	MuInit
	move.l	MusBank-MB(a3),a0
	move.l	a0,a1
	add.l	(a0),a1
	move.l	a1,BankInst-MB(a3)
	move.l	a0,a1
	add.l	4(a0),a1
	move.l	a1,BankSong-MB(a3)
	add.l	8(a0),a0
	move.l	a0,BankPat-MB(a3)
	rts

******* Call normal error messages
OOMem	moveq	#24,d0			* Out of mem
	bra.s	IError
IFonc:	moveq	#23,d0			* Function call
IError:	move.l	MusAdr(pc),a0		* No need to care about SP!
	jmp	4(a0)
******* Call customized error messages
WNDef	moveq	#0,d0	
	bra.s	Custom
SNDef	moveq	#1,d0
	bra.s	Custom
BNSam	moveq	#2,d0
	bra.s	Custom
STSho	moveq	#3,d0
	bra.s	Custom
W0Res	moveq	#4,d0
	bra.s	Custom
MnRes	moveq	#5,d0
	bra.s	Custom
MNDef	moveq	#6,d0
Custom:	moveq	#0,d1			* Error can be trapped
	lea	MusErr(pc),a0		* Your list
	move.l	MusAdr(pc),a1
	jmp	8(a1)
******* Debugging facility
*	If you call this routine, it restore screen, leaves
*	everything opened, and do an ILLEGAL instruction to come back
*	to MONAM2. A0 holds the current PC address, do just do a PC=A0
*	to come just after the JSR IBUG!
*	Really usefull for annoying bugs! Of course, you can't call
* 	it under insterrupts, and you have to do a RESET after...
IBug:	move.l	MusAdr(pc),a0
	jmp	(a0)

***********************************************************
*	Now, the code!
*
*	How to get the parameters?
*
*	When an instruction or function is called, you get the parameters
*	pushed in A3. Remember that you unpile them in REVERSE order than
* 	the instruction syntax.
*	As you have a entry point for each set of parameters, you know
*	how many are pushed...
*		- INTEGER:	move.l	(a3)+,d0
*		- STRING:	move.l	(a3)+,a0
*				move.w	(a0)+,d0
*		A0---> start of the string.
*		D0---> length of the string
*		- FLOAT:	move.l	(a3)+,d0
*		fast floatting point format.
*	IMPORTANT POINT: you MUST unpile the EXACT number of parameters,
*	to restore A3 to its original level. If you do not, you will not
*	have a immediate error, and AMOS will certainely crash on next
*	UNTIL / WEND / ENDIF / NEXT etc... You do not have to care about it
*	when an error occurs...
*
*	You must preserve A4 to A6. All other registers can be freely
*	modified.
*	You end a routine by a RTS.
*
*	To send a function`s parameter back to AMOS, you load it in D3,
*	and put its type in D2:
*		moveq	#0,d2	for an integer
*		moveq	#1,d2	for a float
*		moveq	#2,d2	for a string
*
*	THE JUMP TABLE
*	
*		The address given to you during initialisation process
*	points to a usefull BRA table, to have quick access to some 
*	important AMOS routines. Here are the offsets of this routines:
*
*	bra	JBug		;00- Debugging facility
*	bra	RunErr		;04- Normal error
*	bra	ERunErr		;08- Specific error
*	bra	BkAd		;0C- D3.l (number of bank-1)->A0 Bank address
*	bra	Tests		;10- Performs update
*	bra	WaitRout	;14- Wait routine (see play)
*	bra	GetEc		;18- Get screen address D0.l= screen number
*	bra	AdOuBank	;1C- Address or memory bank? (D3.l)
*	bra	EffBank		;20- Erases bank #D3.l
*

***********************************************************
*	NARRATOR!
*	This part of code is certainely perfectible, as it is not
*	really "safe"...

******* Open narrator
OpNar	move.l	TranBase(pc),d0
	bne.s	OpNarOk
	movem.l	a3-a6,-(sp)
	lea	MB(pc),a3
	sub.l	a1,a1			* Narrator.device
	move.l	$4,a6
	jsr	FindTask(a6)
	lea	WriteRep-MB(a3),a1
	move.l	d0,$10(a1)
	jsr	AddPort(a6)
	lea	TalkIo-MB(a3),a1
	moveq	#0,d0
	moveq	#0,d1
	lea	NarDevice-MB(a3),a0
	jsr	OpenDev(a6)
	tst.l	d0
	bne	OpNarE
	bsr	NarInit
	lea	TranName-MB(a3),a1	* Translator.library
	moveq	#0,d0
	jsr	OpenLib(a6)
	move.l	d0,TranBase-MB(a3)
	beq	OpNarE
	movem.l	(sp)+,a3-a6
OpNarOk	rts
OpNarE	movem.l	(sp)+,a3-a6
NoNar	moveq	#7,d0
	bra	Custom

******* Init narrator (if here)!
NarInit	lea	TalkIO-MB(a3),a1
	lea	WriteRep-MB(a3),a0
	move.l	a0,14(a1)
	move.w	#150,48(a1)
	move.w	#110,50(a1)
	clr.w	52(a1)
	clr.w	54(a1)
	lea	Amaps-MB(a3),a0
	move.l	a0,56(a1)
	move.w	#4,60(a1)
	move.w	#63,62(a1)
	move.w	#22200,64(a1)
	rts

******* SAY a$[,multi]
ISay2:	bsr	OpNar
	move.l	(a3)+,d7
	bra.s	ISay
ISay1:	bsr	OpNar
	moveq	#0,d7	
ISay:	moveq	#%0000,d0
	bsr	VOnOf
	lea	MB(pc),a0
	clr.w	EnvOn-MB(a0)
	clr.w	Noise-MB(a0)
	move.l	(a3)+,a0
	moveq	#0,d0
	move.w	(a0)+,d0
	move.l	Buffer(a5),a1
	move.l	#1024,d1
	movem.l	a3-a6,-(sp)
	move.l	TranBase(pc),a6
	jsr	Translate(a6)
	tst.w	d0
	bne.s	SayX
	lea	TalkIO(pc),a1
	move.w	#3,28(a1)
	move.l	#1024,36(a1)
	move.l	Buffer(a5),40(a1)
	move.l	ExecBase,a6
	tst.w	d7
	bne.s	ISayA
	jsr	DoIO(a6)
	bra.s	SayX
ISayA	jsr	SendIO(a6)
SayX	movem.l	(sp)+,a3-a6
	moveq	#%1111,d0
	bsr	VOnOf
	rts
******* SET TALK sex,mode,pitch,rate
ITalk	bsr	OpNar
	move.l	#EntNul,d0
	lea	TalkIO(pc),a1
	move.l	(a3)+,d1
	cmp.l	d0,d1
	beq.s	IRd1
	cmp.w	#40,d1
	bcs	IFonc
	cmp.w	#400,d1
	bhi	IFonc
	move.w	d1,48(a1)
IRd1	move.l	(a3)+,d1
	cmp.l	d0,d1
	beq.s	IRd2
	cmp.w	#65,d1
	bcs	IFonc
	cmp.w	#320,d1
	bhi	IFonc
	move.w	d1,50(a1)
IRd2	move.l	(a3)+,d1
	cmp.l	d0,d1
	beq.s	IRd3
	and.w	#$0001,d1
	move.w	d1,52(a1)
IRd3	move.l	(a3)+,d1
	cmp.l	d0,d1
	beq.s	IRd4
	and.w	#$0001,d1
	move.w	d1,54(a1)
IRd4	rts

***********************************************************
*	MUSIC INSTRUCTION

*******	BELL
Bell0	moveq	#0,d3
	moveq	#70,d2
	moveq	#%1111,d1
	moveq	#1,d5
	lea	EnvBell(pc),a0
	move.l	a0,d6
	bra	GoBel
Bell1	moveq	#0,d3
	move.l	(a3)+,d2
	moveq	#%1111,d1
	moveq	#1,d5
	lea	EnvBell(pc),a0
	move.l	a0,d6
	bra	GoBel
******* BOOM
Boom	moveq	#0,d3
	moveq	#36,d2
	moveq	#0,d5
	lea	EnvBoom(pc),a0
	move.l	a0,d6
	bra.s	Shout
******* SHOOT
Shoot	moveq	#0,d3
	moveq	#60,d2
	moveq	#0,d5
	lea	EnvShoot(pc),a0
	move.l	a0,d6
* Gives a stereo effect
Shout:	clr.w	d0
	bsr	VOnOf
	moveq	#%1000,d1
Shot	movem.l	d0-d7,-(sp)
	bsr	GoShot
	movem.l	(sp)+,d0-d7
	addq.w	#1,d2
	lsr.w	#1,d1
	bcc.s	Shot
	rts

*******	VOLUME n
IVol1	move.l	(a3)+,d0
	moveq	#%1111,d1
	bsr	Vol
	bsr	MVol
	rts
******* VOLUME voice,n
IVol2	move.l	(a3)+,d0
	move.l	(a3)+,d1
* Set voices volume level
Vol	cmp.l	#64,d0
	bcc	IFonc
	moveq	#0,d2
	lea	EnvBase(pc),a0
Vol1	btst	d2,d1
	beq.s	Vol2
	move.w	d0,EnvDVol(a0)
Vol2	lea	EnvLong(a0),a0
	addq.w	#1,d2
	cmp.w	#4,d2
	bcs.s	Vol1
	rts

*******	PLAY note,length
IPlay2	move.l	(a3)+,d3
	bmi	IFonc
	move.l	(a3)+,d2
	moveq	#%1111,d1
	moveq	#-1,d5
	moveq	#0,d6
	bra.s	GoBel
******* Play voice,note,length
IPlay3	move.l	(a3)+,d3
	bmi	IFonc
	move.l	(a3)+,d2
	move.l	(a3)+,d1
	moveq	#-1,d5
	moveq	#0,d6
GoBel	cmp.l	#96,d2			* <96?
	bhi	IFonc
	move.w	d1,d0			* Stop voices
	eor.w	#$000F,d0
	bsr	VOnOf
GoShot	move.l	a3,-(sp)
	lea	Circuits,a2
	lea	MB(pc),a3
	move.w	EnvOn-MB(a3),d7
	clr.w	EnvOn-MB(a3)
* Explores all 4 voices
	moveq	#0,d0
	move.w	d1,d4
	moveq	#3,d1
IPl1	btst	d1,d4
	beq.s	IPl2
	bsr	VPlay
IPl2	dbra	d1,IPl1
******* Start!
IPlX	move.w	#$1f4,d1
IPlX0	dbra	d1,IPlX0
	bset	#15,d0
	move.w	d0,DmaCon(a2)
	move.w	d7,EnvOn-MB(a3)
	move.l	(sp)+,a3
* Wait?
	tst.l	d3
	beq.s	IPlX1
	move.l	MusAdr(pc),a0		* Call the AMOS wait routine
	jsr	$14(a0)
IPlX1	rts

******* Play voice D1: WAVE orSAMPLE
*	Note D2
VPlay	movem.l	d0-d7/a0-a2,-(sp)
	bclr	d1,Noise-MB(a3)		* No more random
	tst.w	d2
	beq	VSil
	addq.w	#3,d2
	move.w	d5,d0			* Forced wave? (bell)
	bpl.s	VPl0
	move.w	d1,d0			* Wave or Sample?
	lsl.w	#1,d0
	lea	Waves(pc),a0
	move.w	0(a0,d0.w),d0
	bmi	VPl2

* Play WAVE!
VPl0	beq	VPl4
	moveq	#0,d3
	bset	d1,d3
	move.w	d3,DmaCon(a2)		* Stop voice
	lea	$a0(a2),a2
	move.w	d1,d3
	lsl.w	#4,d3
	add.w	d3,a2			* a2-> I/O
	movem.l	d1-d3/a2,-(sp)
	move.w	d0,d1
	bsr	WaveAd
	beq	WNDef
	move.l	a2,a1
	movem.l	(sp)+,d1-d3/a2
	pea	WaveEnv(a1)
	lea	WaveDeb(a1),a1
	subq.w	#1,d2
	move.w	d2,d3
	ext.l	d3
	divu	#12,d3
	lsl.w	#2,d3
	lea	TFreq-MB(a3),a0
	add.w	d3,a0
	add.w	(a0)+,a1
	move.l	a1,(a2)			* AudAd
	move.w	(a0)+,d3
	move.w	d3,4(a2)		* AudLen
	lsl.w	#1,d3
	lea	TNotes-MB(a3),a1
	lsl.w	#1,d2
	mulu	0(a1,d2.w),d3
	move.l	MusClock-MB(a3),d2
	divu	d3,d2
	cmp.w	#124,d2
	bcc.s	VPl1
	moveq	#124,d2
VPl1:	move.w	d2,6(a2)		* AudPer
* Start enveloppe 
	move.l	(sp)+,d5
	tst.l	d6			* Fixed enveloppe? (bell / shoot)
	bne.s	VPl1a
	move.l	d5,d6
VPl1a	lea	EnvBase-MB(a3),a0	
	move.w	d1,d0
	mulu	#EnvLong,d0
	add.w	d0,a0
	move.l	d6,EnvAd(a0)
	move.l	d6,EnvDeb(a0)
	clr.w	EnvVol(a0)
	bsr	MuIntE
	movem.l	(sp)+,a0-a2/d0-d7
	bset	d1,d0
	bset	d1,d7
	rts
******* Silence!
VSil	moveq	#0,d0
	bset	d1,d0
	move.w	d0,DmaCon(a2)
	movem.l	(sp)+,a0-a2/d0-d7
	bclr	d1,d7
	rts
******* Play SAMPLE
VPl2	move.l	a2,-(sp)
	move.w	d2,-(sp)
	neg.w	d0
	bsr	GetSam
	move.w	(sp)+,d0
	move.l	(sp)+,a2
VPl3	lea	TNotes-MB(a3),a0
	lsl.w	#1,d0
	mulu	-2(a0,d0.w),d3
	divu	#440,d3
	bra	SPl0
******* Play NOISE
VPl4	bset	d1,Noise-MB(a3)
	move.w	d2,d0
	move.l	WaveBase-MB(a3),a1
	lea	WaveEnv(a1),a0
	lea	WaveDeb(a1),a1
	move.l	#LNoise,d2
	move.l	#2000,d3
	tst.l	d6
	bne.s	VPl3
	move.l	a0,d6
	bra.s	VPl3

******* PLAY OFF (voice)
IPlOf0	moveq	#%1111,d0
	bra.s	PlOf
IPlOf1	move.l	(a3)+,d0
PlOf	move.l	a3,-(sp)
	lea	MB(pc),a3
	bsr	EnvOff
	move.l	(sp)+,a3
	rts

***********************************************************
*	SAMPLE INSTRUCTIONS

*******	SAM BANK n
ISBank	move.l	(a3)+,d0
	bls	IFonc
	cmp.l	#16,d0
	bhi	IFonc
	lea	SamBank(pc),a0
	move.w	d0,(a0)
	rts
******* SAMLOOP ON
ISLOn1	moveq	#-1,d0
SLoop	move.l	(a3)+,d1
	bra.s	Sl0
ISLOn0	moveq	#-1,d0
	moveq	#%1111,d1
	bra.s	Sl0
******* SAMLOOP OFF
ISLOf1	moveq	#0,d0
	move.l	(a3)+,d1
	bra.s	Sl0
ISLOf0	moveq	#0,d0
	moveq	#%1111,d1
SL0	moveq	#0,d2
	lea	EnvSam(pc),a0
Sl1	btst	d2,d1
	beq.s	Sl2
	move.w	d0,8(a0)
Sl2	lea	$10(a0),a0
	addq.w	#1,d2
	cmp.w	#4,d2
	bcs.s	Sl1
	rts
******* NOISE TO voice
INoTo	move.l	(a3)+,d1
	moveq	#0,d0
	bra.s	ISmt
******* SAMPLE n TO voice
ISamTo	move.l	4(a3),d0
	bsr	GetSam
	move.l	(a3)+,d1
	move.l	(a3)+,d0
	neg.w	d0
* Poke D1-> waves
ISmt	lea	Waves(pc),a0
	moveq	#0,d2
ISmt1	btst	d2,d1
	beq.s	ISmt2
	move.w	d0,(a0)
ISmt2	addq.l	#2,a0
	addq.w	#1,d2
	cmp.w	#4,d2
	bcs.s	ISmt1
	rts
******* SAM PLAY number
ISam1	move.l	(a3)+,d0
	bsr	GetSam
	moveq	#%1111,d1
	moveq	#0,d6
	bra	GoSam
******* SAM PLAY voix,number
ISam2	move.l	(a3)+,d0
	bsr	GetSam
	move.l	(a3)+,d1
	moveq	#0,d6
	bra	GoSam
******* SAM PLAY voix,number,frequence
ISam3	move.l	4(a3),d0
	bsr	GetSam
	move.l	(a3)+,d3
	cmp.l	#500,d3
	ble	IFonc
	addq.l	#4,a3
	move.l	(a3)+,d1	
	moveq	#0,d6
	bra	GoSam
******* SAM RAW voice,ad,length,freq
ISamR	move.l	(a3)+,d3
	cmp.l	#500,d3
	ble	IFonc
	move.l	(a3)+,d2
	cmp.l	#256,d2
	ble	IFonc
	move.l	(a3)+,a1
	move.l	(a3)+,d1
	moveq	#0,d6
GoSam:	move.l	a3,-(sp)
	lea	MB(pc),a3
	move.w	d1,d0			* Stops music
	eor.w	#$000F,d0
	bsr	VOnOf
	lea	Circuits,a2
	move.w	EnvOn-MB(a3),d7
	clr.w	EnvOn-MB(a3)
* Do all voices
	moveq	#0,d0
	move.w	d1,d4
	moveq	#3,d1
ISp2b	btst	d1,d4
	beq.s	ISp2c
	bsr	SPlay
ISp2c	dbra	d1,ISp2b
* Start!
ISpX	move.w	#$1f4,d1
ISpX1	dbra	d1,ISpX1
	bset	#15,d0
	move.w	d0,DmaCon(a2)
	move.w	d7,EnvOn-MB(a3)
	move.l	(sp)+,a3
	rts

******* Find a sample -> A0
GetSam	move.l	d0,-(sp)
	move.w	SamBank(pc),d3
	ext.l	d3
	beq	IFonc
	move.l	MusAdr(pc),a0
	jsr	$0C(a0)
	move.l	-8(a0),d0
	cmp.l	BkSam(pc),d0
	bne	BNSam
* Get sample characteristics1
	move.l	(sp)+,d0
	bls	IFonc
	cmp.w	(a0),d0
	bhi	SNDef
	lsl.w	#2,d0
	move.l	2-4(a0,d0.w),d0
	beq	SNDef
	add.l	d0,a0
	move.w	8(a0),d3
	ext.l	d3
	move.l	10(a0),d2
	lea	14(a0),a1
	rts

******* SAMPLAY routine
*	A1= Sample
*	D3= Freq
*	D2= Long
*	D1= Voice
SPlay:	movem.l	d0-d7/a0-a2,-(sp)
	bclr	d1,Noise-MB(a3)
SPl0	moveq	#0,d0
	bset	d1,d0			* Stop voice
	move.w	d0,DmaCon(a2)

	lea	$a0(a2),a2
	move.w	d1,d4
	lsl.w	#4,d4
	add.w	d4,a2			* a2-> I/O
	move.l	a1,(a2)			* AudAd
	move.w	d2,d4
	lsr.w	#1,d4
	move.w	d4,4(a2)		* AudLen
	move.l	MusClock-MB(a3),d4
	divu	d3,d4
	bvc.s	SPl1
	moveq	#124,d4
SPl1	cmp.w	#124,d4
	bcc.s	SPl2
	moveq	#124,d4
SPl2:	move.w	d4,6(a2)		* AudPer
* Starts enveloppe 
	move.l	d6,a1
	tst.l	d6
	bne	SPl4
	lea	EnvSam-MB(a3),a1
	move.w	d1,d0
	lsl.w	#4,d0
	add.w	d0,a1
	mulu	#50,d2
	divu	d3,d2	
	subq.w	#1,d2
	bhi.s	SPl3
	moveq	#1,d2
SPl3	move.w	d2,4(a1)
SPl4	lea	EnvBase-MB(a3),a0	
	move.w	d1,d0
	mulu	#EnvLong,d0
	add.w	d0,a0
	move.l	a1,EnvAd(a0)
	move.l	a1,EnvDeb(a0)
	clr.w	EnvVol(a0)
	bsr	MuIntE
* Fini!
	movem.l	(sp)+,d0-d7/a0-a2
	bset	d1,d0
	bset	d1,d7
	rts
	
***********************************************************
*	WAVE INSTRUCTION SET

*******	WAVE n TO n
IWave:	move.l	4(a3),d1
	bmi	IFonc
	bsr	WaveAd
	beq	WNDef
	move.l	(a3)+,d1
	move.l	(a3)+,d0
	bra	ISmt
*******	SET WAVE n,a$
ISWave:	move.l	(a3)+,a1
	move.w	(a1)+,d1
	cmp.w	#256,d1
	bcs	STSho
	move.l	(a3)+,d1
	bls	IFonc
	move.l	a3,-(sp)
	lea	MB(pc),a3
	bsr	NeWave
	bne	OOMem
	move.l	(sp)+,a3
	rts
*******	DEL WAVE 
IDWave1	move.l	(a3)+,d1
	bmi	IFonc
	beq	W0Res
	cmp.l	#1,d1
	beq	W0Res
	move.l	a3,-(sp)
	lea	MB(pc),a3
	moveq	#%1111,d0
	bsr	EnvOff
	bsr	WaveAd
	beq	WNDef
	bsr	WaveDel
	bsr	NoWave
	move.l	(sp)+,a3
	rts
*******	SET ENVEL n,n TO n,v
ISEnv	move.l	(a3)+,d4
	cmp.l	#64,d4
	bcc	IFonc
	move.l	(a3)+,d3
	move.l	(a3)+,d5
	bmi	IFonc
	cmp.l	#7,d5
	bcc	IFonc
	move.l	(a3)+,d1
	bmi	IFonc
	tst.w	d5
	bne.s	ISe1
	tst.w	d3
	bls	IFonc
ISe1	move.l	a3,-(sp)
	lea	MB(pc),a3
	bsr	WaveAd
	beq	WNDef
	lsl.w	#2,d5
	lea	WaveEnv(a2,d5.w),a2
	move.w	d3,(a2)+
	move.w	d4,(a2)+
	clr.w	(a2)
	move.l	(sp)+,a3
	rts
******* RAZ WAVES
RazWave	movem.l	a2/d0-d2,-(sp)
	moveq	#%1111,d0
	bsr	EnvOff			* Stop all voices
	lea	WaveBase-MB(a3),a2	* Erase all instruments
	move.l	a2,d2
RzW1	move.l	d2,a2
	move.l	(a2),d0
	beq.s	RzW2
	move.l	d0,a2
	bsr	WaveDel
	bra.s	RzW1
RzW2	bsr	NoWave
	movem.l	(sp)+,a2/d0-d2
	rts
* Plus de Waves speciales
NoWave	lea	Waves(pc),a0		* Default waves
	move.w	#1,(a0)+
	move.w	#1,(a0)+
	move.w	#1,(a0)+
	move.w	#1,(a0)+
	rts

******* NEW WAVES
*	A1= Array address
*	D1= # to create
NeWave:	movem.l	d1-d7/a1-a2,-(sp)
NeW0	bsr	WaveAd
	beq.s	NeW1
	moveq	#%1111,d0
	bsr	EnvOff
	bsr	WaveDel
	bra.s	NeW0
NeW1	move.l	#WaveLong,d0
	SyCall	SyChip
	beq.s	NeWE
	move.l	d0,(a2)
	move.l	d0,a2
	move.w	d1,WaveNb(a2)
* Copy default ADSR
	move.l	a1,-(sp)
	lea	EnvDef-MB(a3),a0
	lea	WaveEnv(a2),a1
NeW3	move.l	(a0)+,(a1)+
	bne.s	NeW3
	move.l	(sp)+,a1
* Full wave: 256 bytes
	lea	WaveDeb(a2),a2
	move.l	a2,a0
	moveq	#256/4-1,d0
NeW2	move.l	(a1)+,(a0)+
	dbra	d0,NeW2
* 1/2
	move.l	a2,a1
	move.l	a0,a2
	moveq	#127,d0
	bsr	NewRout
* 1/4
	move.l	a2,a1
	move.l	a0,a2
	moveq	#63,d0
	bsr	NewRout
* 1/8
	move.l	a2,a1	
	move.l	a0,a2
	moveq	#31,d0
	bsr	NewRout
* 1/16
	move.l	a2,a1
	move.l	a0,a2
	moveq	#15,d0
	bsr	NewRout
* 1/32
	move.l	a2,a1
	move.l	a0,a2
	moveq	#7,d0
	bsr	NewRout
* 1/64
	move.l	a2,a1
	move.l	a0,a2
	moveq	#3,d0
	bsr	NewRout
******* No error
	moveq	#0,d0
NeWx	movem.l	(sp)+,d1-d7/a1-a2
	rts
******* Out of mem
NeWE	moveq	#-1,d0
	bra.s	NeWx

******* Divide a sample by 2
NewRout	move.b	(a1)+,d1
	ext.w	d1
	move.b	(a1)+,d2
	ext.w	d2
	add.w	d2,d1
	asr.w	#1,d1
	move.b	d1,(a0)+
	dbra	d0,NewRout
	rts

******* Get a wave address
WaveAd:	moveq	#0,d2
	lea	WaveBase(pc),a2
	move.l	(a2),d0
	beq.s	WAd2
WAd1	move.l	a2,d2
	move.l	d0,a2
	cmp.w	WaveNb(a2),d1
	beq.s	WAd3
	move.l	(a2),d0
	bne.s	WAd1
WAd2	moveq	#0,d0
	rts
WAd3	moveq	#-1,d0
	rts

******* Deletion of a WAVE (A2)-D2
WaveDel	movem.l	a0-a2/d0-d2,-(sp)
	move.w	WaveNb(a2),d1
	move.l	d2,a0
	move.l	(a2),(a0)
	move.l	#WaveLong,d0
	move.l	a2,a1
	SyCall	SyFree
	movem.l	(sp)+,a0-a2/d0-d2
	rts

***********************************************************
*	ENVELOPPES 

***********************************************************
*	STOP ENVELOPPE D0
EnvOff	movem.l	d0-d3/a0,-(sp)
	move.w	EnvOn-MB(a3),d1
	clr.w	EnvOn-MB(a3)
	moveq	#0,d3
	lea	Circuits,a0
	moveq	#0,d2
EOf1	btst	d2,d0
	beq.s	EOf2
	bclr	d2,d1
	beq.s	EOf2
	bset	d2,d3
	move.w	#2,$a4(a0)
	clr.w	$a8(a0)
EOf2	lea	$10(a0),a0
	addq.w	#1,d2
	cmp.w	#4,d2
	bcs.s	EOf1
	move.w	d1,EnvOn-MB(a3)
	move.w	d3,MuReStart-MB(a3)
	movem.l	(sp)+,d0-d3/a0
	rts
	
******* Next enveloppe
MuIntE	move.l	EnvAd(a0),a1
MuIe0	move.w	(a1)+,d3
	beq.s	MuIntS
	bmi.s	MuIe1
	move.w	d3,EnvNb(a0)
	move.w	EnvDVol(a0),d4
	mulu	(a1)+,d4
	lsr.w	#6,d4
	sub.w	EnvVol(a0),d4
	ext.l	d4
	lsl.w	#8,d4
	divs	d3,d4
	ext.l	d4
	lsl.l	#8,d4
	move.l	d4,EnvDelta(a0)
	clr.w	EnvVol+2(a0)
	move.l	a1,EnvAd(a0)
	rts
* Loop
MuIe1	move.l	EnvDeb(a0),a1
	bra.s	MuIe0
* End of a voice
MuIntS	bset	d1,d5
	bclr	d1,d0
	bclr	d1,Noise-MB(a3)
* Restarts the music
	bset	d1,MuReStart+1-MB(a3)
	rts

******************************************************************
*	MUSIC

******* Music initialisation
MuInit:	clr.l	MuBase-MB(a3)
	clr.w	MuNumber-MB(a3)
	move.l	#$DFF0A0,MuChip0-MB(a3)
	move.l	#$DFF0B0,MuChip1-MB(a3)
	move.l	#$DFF0C0,MuChip2-MB(a3)
	move.l	#$DFF0D0,MuChip3-MB(a3)
	move.w	#$000F,MuDMAsk-MB(a3)
	clr.w	MuReStart-MB(a3)
	bsr	MOff
	rts

******* MUSIC OFF-> Stops all musics
IMuSOff	movem.l	a0-a3/d0-d1,-(sp)
	lea	MB(pc),a3
	clr.l	MuBase-MB(a3)
	clr.w	MuNumber-MB(a3)
	bsr	MOff
	movem.l	(sp)+,a0-a3/d0-d1
	rts

******* MUSIC STOP-> Stops current music
IMuStop	movem.l	a0-a3/d0-d1,-(sp)
	lea	MB(pc),a3
	move.l	MuBase-MB(a3),d0
	beq.s	IStp
	clr.w	MuBase-MB(a3)
	move.l	d0,a0
	clr.w	VoiCpt0(a0)
	clr.w	VoiCpt1(a0)
	clr.w	VoiCpt2(a0)
	clr.w	VoiCpt3(a0)
	move.l	d0,MuBase-MB(a3)
IStp	movem.l	(sp)+,a0-a3/d0-d1
	rts

******* MUSIC VOLUME
IMVol	move.l	(a3)+,d0
	cmp.l	#64,d0
	bcc	IFonc
* Set volume
MVol	and.w	#63,d0
	lea	MB(pc),a0
	move.w	d0,MuVolume-MB(a0)
	move.l	MuBase-MB(a0),d4
	beq.s	MVol3
	clr.l	MuBase-MB(a0)
	lea	MuBuffer-MB(a0),a1
	move.w	MuNumber-MB(a0),d1
MVol0	move.l	a1,a2
	moveq	#3,d2
MVol1	move.w	VoiDVol(a2),d3
	mulu	d0,d3
	lsr.w	#6,d3
	move.w	d3,VoiVol(a2)
	lea	VoiLong(a2),a2
	dbra	d2,MVol1
MVol2	lea	MuLong(a1),a1
	subq.w	#1,d1
	bne.s	MVol0
	move.l	d4,MuBase-MB(a0)
MVol3	rts

******* VOICE ON/OFF Voices
IVoice	move.l	(a3)+,d0
	and.w	#$000F,d0
	move.l	a3,-(sp)
	lea	MB(pc),a3
	bsr	VOnOf
	movem.l	(sp)+,a3
	rts

******* Start / Stop voices D0
VOnOf	movem.l	d0-d5/a0-a3,-(sp)
	lea	MB(pc),a3
	move.l	MuBase-MB(a3),d1
	beq.s	VooX
	clr.l	MuBase-MB(a3)
	move.l	d1,a1
	move.l	d1,a2
	move.w	MuDMAsk-MB(a3),d1
	move.w	d0,MuDMAsk-MB(a3)
	move.l	WaveBase-MB(a3),a0
	lea	WaveDeb(a0),a0
	move.l	a0,d3
	lea	MuChip0-MB(a3),a0
	moveq	#0,d2
	moveq	#0,d4
* Exploration loop
Voo1	btst	d2,d0
	bne.s	Voo2
* Stop a voice!
	btst	d2,d1			* Already stopped?
	beq.s	VooN
	bset	d2,d4
	move.l	d3,(a0)
	bclr	d2,MuStart+1(a2)
	bclr	d2,MuStop+1(a2)
	bra.s	VooN
* Re start a voice
Voo2	btst	d2,d1			* Already on?
	bne.s	VooN
	bset	d2,MuReStart+1-MB(a3)
* Next
VooN	addq.l	#4,a0
	lea	VoiLong(a1),a1
	addq.w	#1,d2
	cmp.w	#4,d2
	bcs.s	Voo1
* Stop them!
	move.w	d4,Circuits+DmaCon
	move.w	#$200,d0
VooW	dbra	d0,VooW
	move.l	a2,MuBase-MB(a3)
VooX	movem.l	(sp)+,d0-d5/a0-a3
	rts

******* MUSIC n
IMusic	move.l	(a3)+,d3
	bls	IFonc
* Points to the SONG
	move.l	a3,-(sp)
	lea	MB(pc),a3	
	tst.l	MusBank-MB(a3)
	beq	MnRes
	move.l	BankSong-MB(a3),a1
	cmp.w	(a1),d3
	bhi	MNDef
	lsl.w	#2,d3
	add.l	2-4(a1,d3.w),a1
* Still room?
	cmp.w	#3,MuNumber-MB(a3)
	bcc	IMusX
	clr.l	MuBase-MB(a3)
* Buffer address
	move.w	MuNumber-MB(a3),d0
	move.w	d0,d1
	addq.w	#1,MuNumber-MB(a3)
	mulu	#MuLong,d0
	lea	MuBuffer-MB(a3),a2
	add.w	d0,a2
* Init datas
	moveq	#(VoiLong*4)/2-1,d0
	move.l	a2,a0
IMus1	clr.w	(a0)+
	dbra	d0,IMus1
	clr.w	MuStop(a2)
	clr.w	MuStart(a2)
* Init parameters
	move.l	a2,d2
	move.w	#100,MuCpt(a2)
	move.w	#14,MuTempo(a2)
	moveq	#0,d0
IMus2	move.w	#1,VoiCpt(a2)
	lea	FoEnd-MB(a3),a0
	move.l	a0,VoiAdr(a2)
	move.l	a1,a0
	add.w	0(a0,d0.w),a0
	move.l	a0,VoiPat(a2)
	move.l	a0,VoiDPat(a2)
	lea	VoiLong(a2),a2
	addq.w	#2,d0
	cmp.w	#8,d0
	bne.s	IMus2
* Starts music
	move.l	d2,MuBase-MB(a3)
IMusX	move.l	(sp)+,a3
	rts

******* Tempo T
ITempo	move.l	(a3)+,d0
	cmp.l	#100,d0
	bhi	IFonc
	move.l	MuBase(pc),d1
	beq.s	ITemp
	move.l	d1,a0
	move.w	d0,MuTempo(a0)
ITemp	rts

***********************************************************
*	=VU METRE(v)
FVu	move.l	(a3)+,d0
	cmp.l	#4,d0
	bcc	IFonc
	lea	MB(pc),a0
	moveq	#0,d3
	move.b	0(a0,d0.w),d3
	clr.b	0(a0,d0.w)
	moveq	#0,d2
	rts

***********************************************************
*	=MU BASE
FMB	lea	MB(pc),a0
	move.l	a0,d3
	moveq	#0,d2
	rts

***********************************************************
*
*	INTERRUPT ROUTINES
*
*	Here is the main point! Happy SoundTracker users, forget
*	everything! This music routine does not use the same system!
*	Music is not coded in parallel (all note for all voices
*	in 16 bytes), but in a more efficient but a little more complex
*	"track" system.
*	Each voice has its own track. More than that, the delays between
*	each note is not fixed as in SoundTracker (to have important
*	delays you just leave a few empty notes after), but coded in the
*	note itself. The delay is acheived by counting this value to
*	zero.
*	LABEL are not coded within the note, but stands before it, in
*	two bytes. The main advantage is that you can have up to 128
*	different labels, and the parameter of this label is a full
*	byte. More than one label can be put after each other, and will
*	only have effect for the next note.
*
*	This structure makes AMOS music player very versatile: it can play
*	(after appropriate conversion) SoundTracker-like musics or IFF
*	music files.
*
*	I also realised when the music routine was finished, that it
*	would not be really difficult to implement the music priority
*	system, which I think is really useful to do games!
*
*	If you carefully look to the code, I am sure you will be able
*	to grab a few clock cycle here or there. I prefer to write readable
*	code, a little slower (very little) than more efficient tricky
*	code!!!
*
*	For version 2 I want to implement synthetic instruments which saves
*	A LOT of memory. Anyway, almost everything is ready to do so, with
*	all the WAVE interrupt routines...
*
***********************************************************	

******* VBL Entry
MusInt	lea	MB(pc),a3	
	move.w	EnvOn-MB(a3),d0
	beq	Music
	lea	EnvBase-MB(a3),a0
	lea	$a0(a6),a2
	moveq	#0,d1
	moveq	#3,d2
	moveq	#0,d5
MuInt1	btst	d1,d0
	beq.s	MuIntN
	move.l	EnvDelta(a0),d3
	add.l	EnvVol(a0),d3
	move.l	d3,EnvVol(a0)
	swap	d3
	move.w	d3,8(a2)
MuInt2	subq.w	#1,EnvNb(a0)
	bne.s	MuIntN
	bsr	MuIntE
MuIntN	lea	EnvLong(a0),a0
	lea	$10(a2),a2
	addq.w	#1,d1
	dbra	d2,MuInt1
	move.w	d0,EnvOn-MB(a3)
	move.w	d5,DmaCon(a6)
******* Make noise?
	tst.w	Noise-MB(a3)
	beq.s	Music
	move.w	PNoise-MB(a3),d0
	moveq	#7,d2
	move.w	BSeed-MB(a3),d1
	move.l	WaveBase-MB(a3),a0
INoi1	add.w	6(a6),d1
	mulu	#$3171,d1
	lsr.l	#8,d1
	move.w	d1,WaveDeb(a0,d0.w)
	subq.w	#2,d0
	bpl.s	INoi2
	move.w	#LNoise-2,d0
INoi2	dbra	d2,INoi1
	move.w	d0,PNoise-MB(a3)
	move.w	d1,BSeed-MB(a3)

*******	Music routine
Music:	move.l	MuBase-MB(a3),d0
	beq	MuEnd1
	movem.l	a4-a6,-(sp)
	move.l	d0,a5
	bsr	MuEvery
* Here is a smart counter, which gives progressive results
* from zero to 100...
	move.w	MuCpt(a5),d0
	add.w	MuTempo(a5),d0
	move.w	d0,MuCpt(a5)
	cmp.w	#100,d0
	bcs	MuEnd
	sub.w	#100,MuCpt(a5)
* Lets go for one step of music!
	moveq	#0,d5
	moveq	#0,d7
	move.l	a5,a4
	tst.b	VoiCpt+1(a4)
	beq.s	Mus0
	addq.w	#1,d5
	subq.b	#1,VoiCpt+1(a4)
	bne.s	Mus0
	moveq	#0,d6
	move.l	MuChip0-MB(a3),a6
	bsr	MuStep
Mus0	lea	MuVoix1(a5),a4
	tst.b	VoiCpt+1(a4)
	beq.s	Mus1
	addq.w	#1,d5
	subq.b	#1,VoiCpt+1(a4)
	bne.s	Mus1
	moveq	#1,d6
	move.l	MuChip1-MB(a3),a6
	bsr	MuStep
Mus1	lea	MuVoix2(a5),a4
	tst.b	VoiCpt+1(a4)
	beq.s	Mus2
	addq.w	#1,d5
	subq.b	#1,VoiCpt+1(a4)
	bne.s	Mus2
	moveq	#2,d6
	move.l	MuChip2-MB(a3),a6
	bsr	MuStep
Mus2	lea	MuVoix3(a5),a4
	tst.b	VoiCpt+1(a4)
	beq.s	Mus3
	addq.w	#1,d5
	subq.b	#1,VoiCpt+1(a4)
	bne.s	Mus3
	moveq	#3,d6
	move.l	MuChip3-MB(a3),a6
	bsr	MuStep
Mus3	and.w	MuDMAsk-MB(a3),d7
	move.w	d7,$DFF096
	tst.w	d5
	beq.s	MuFin
MuEnd	movem.l	(sp)+,a4-a6
MuEnd1	rts
* Finished?
MuFin	subq.w	#1,MuNumber-MB(a3)
	beq	MuFini
* Restarts previous music
	move.w	MuNumber-MB(a3),d0
	subq.w	#1,d0
	mulu	#MuLong,d0
	lea	MuBuffer-MB(a3),a0
	add.w	d0,a0
	move.l	a0,MuBase-MB(a3)
	move.w	MuDMAsk-MB(a3),MuReStart-MB(a3)
	clr.w	MuStart(a0)
	clr.w	MuStop(a0)
	bra.s	MuEnd
* Really finished!
MuFini	clr.l	MuBase-MB(a3)
	bsr.s	MOff
	bra.s	MuEnd
* Stop sound routine
MOff	lea	Circuits,a0
	move.w	MuDMAsk-MB(a3),d0
	beq.s	MOf3
	move.w	d0,DmaCon(a0)
	moveq	#3,d1
MOf1	btst	d1,d0
	beq.s	MOf2
	move.w	#2,$a4(a0)
	clr.w	$a8(a0)
MOf2	lea	$10(a0),a0
	dbra	d1,MOf1
MOf3	rts

******* One step of music for one voice
MuStep	move.l	VoiAdr(a4),a2
MuSt0	move.w	(a2)+,d0
	bmi.s	MuEtiq
* Play a normal note
	move.w	d0,VoiCpt(a4)
	move.w	(a2)+,d0
	beq.s	MuSt1
	move.w	d0,VoiNote(a4)
	move.w	d0,$06(a6)
	move.l	BankInst-MB(a3),d0
	move.l	VoiInst(a4),a0
	add.l	(a0),d0
	move.l	d0,(a6)
	move.w	8(a0),$04(a6)
	bset	d6,d7
	bclr	d6,MuStop+1(a5)
	bset	d6,MuStart+1(a5)
	move.w	VoiSlB(a4),VoiSlide(a4)
	move.w	VoiSlC(a4),VoiSlB(a4)
	move.b	VoiVol+1(a4),0(a3,d6.w)
MuSt1	move.l	a2,VoiAdr(a4)
	rts
* Label entry
MuEtiq	move.w	d0,d1
	and.w	#$7F00,d0
	lsr.w	#6,d0
	lea	MuJumps(pc),a0
	jmp	0(a0,d0.w)

******* Jmup table to labels
MuJumps	bra	EtEnd			* 00-> Fin pattern
	bra	EtSlUp			* 01-> Slide up
	bra	EtSlDo			* 02-> Slide down
	bra	EtSVol			* 03-> Set volume
	bra	MuStep			* 04-> 
	bra	EtRep			* 05-> Repeat
	bra	EtLOn			* 06-> Led On
	bra	EtLOff			* 07-> Led Off
	bra	EtTemp			* 08-> Set Tempo
	bra	EtInst			* 09-> Set Instrument
******* End of a pattern
EtEnd	clr.w	VoiCpt(a4)
	clr.w	VoiRep(a4)
	clr.l	VoiDeb(a4)
	move.l	VoiPat(a4),a0
RePat	move.w	(a0)+,d0
	bmi.s	EtEnd1
	move.l	a0,VoiPat(a4)
	move.l	BankPat-MB(a3),a0
	cmp.w	(a0),d0
	bhi.s	EtEndX
	lsl.w	#2,d0
	add.w	d6,d0
	lsl.w	#1,d0
	move.w	2(a0,d0.w),d0
	beq.s	EtEndX
	lea	0(a0,d0.w),a2
	bra	MuSt0
EtEndX	rts
EtEnd1	cmp.w	#-1,d0
	beq.s	EtEndX
 	move.l	VoiDPat(a4),a0
	bra.s	RePat
******* Change instrument
EtInst	and.w	#$00FF,d1
	move.l	BankInst-MB(a3),a1
	lsl.w	#5,d1
	lea	2(a1,d1.w),a1
	move.l	a1,VoiInst(a4)
	move.w	12(a1),d0
	cmp.w	#64,d0
	bcs.s	EtInst1
	moveq	#63,d0
EtInst1	move.w	d0,VoiDVol(a4)
	mulu	MuVolume-MB(a3),d0
	lsr.w	#6,d0
	move.w	d0,VoiVol(a4)
	bra	MuSt0
******* Slide up 
EtSlUp	and.w	#$00FF,d1
	neg.w	d1
	move.w	d1,VoiSlide(a4)
	move.w	d1,VoiSlB(a4)
	clr.w	VoiSlC(a4)
	bra	MuSt0
******* Slide down
EtSlDo	and.w	#$00FF,d1
	move.w	d1,VoiSlide(a4)
	move.w	d1,VoiSlB(a4)
	clr.w	VoiSlC(a4)
	bra	MuSt0
******* Set Volume
EtSVol	and.w	#$00FF,d1
	cmp.w	#64,d1
	bcs.s	EtSVol1
	moveq	#63,d1
EtSVol1	move.w	d1,VoiDVol(a4)
	mulu	MuVolume-MB(a3),d1
	lsr.w	#6,d1
	move.w	d1,VoiVol(a4)
	bra	MuSt0
******* Set Tempo
EtTemp	and.w	#$00FF,d1
	move.w	d1,MuTempo(a5)
	bra	MuSt0
******* Led On
EtLOn	bclr	#1,$bfe001
	bra	MuSt0
******* Led Off
EtLOff	bset	#1,$bfe001
	bra	MuSt0
******* Repeat
EtRep	and.w	#$00FF,d1
	bne.s	EtRep1
	move.l	a2,VoiDeb(a4)
	bra	MuSt0
EtRep1	tst.w	VoiRep(a4)
	bne.s	EtRep2
	move.w	d1,VoiRep(a4)
	bra	MuSt0
EtRep2	subq.w	#1,VoiRep(a4)
	beq	MuSt0
	move.l	VoiDeb(a4),d0
	beq	MuSt0
	move.l	d0,a2
	bra	MuSt0

*******	Routine call every VBL
MuEvery	
* Update VOLUME and FREQUENCE
	move.l	MuChip0-MB(a3),a6		* Voix 0
	move.w	VoiSlide0(a5),d0
	add.w	d0,VoiNote0(a5)
	move.w	VoiNote0(a5),$06(a6)
	move.w	VoiVol0(a5),$08(a6)
	move.l	MuChip1-MB(a3),a6		* Voix 1
	move.w	VoiSlide1(a5),d0
	add.w	d0,VoiNote1(a5)
	move.w	VoiNote1(a5),$06(a6)
	move.w	VoiVol1(a5),$08(a6)
	move.l	MuChip2-MB(a3),a6		* Voix 2
	move.w	VoiSlide2(a5),d0	
	add.w	d0,VoiNote2(a5)
	move.w	VoiNote2(a5),$06(a6)
	move.w	VoiVol2(a5),$08(a6)
	move.l	MuChip3-MB(a3),a6		* Voix 3
	move.w	VoiSlide3(a5),d0
	add.w	d0,VoiNote3(a5)
	move.w	VoiNote3(a5),$06(a6)
	move.w	VoiVol3(a5),$08(a6)

* Second step of sample?
MuRsXX	move.w	MuStop(a5),d0
	beq	MuEvX
	move.l	BankInst-MB(a3),d1
	btst	#0,d0				* Voix 0
	beq.s	MuEv0
	move.l	MuChip0-MB(a3),a6
	move.l	VoiInst0(a5),a0
	move.l	d1,d2
	add.l	4(a0),d2
	move.l	d2,(a6)
	move.w	10(a0),$04(a6)
MuEv0	btst	#1,d0				* Voix 1
	beq.s	MuEv1
	move.l	MuChip1-MB(a3),a6
	move.l	VoiInst1(a5),a0
	move.l	d1,d2
	add.l	4(a0),d2
	move.l	d2,(a6)
	move.w	10(a0),$04(a6)
MuEv1	btst	#2,d0				* Voix 2
	beq.s	MuEv2
	move.l	MuChip2-MB(a3),a6
	move.l	VoiInst2(a5),a0
	move.l	d1,d2
	add.l	4(a0),d2
	move.l	d2,(a6)
	move.w	10(a0),$04(a6)
MuEv2	btst	#3,d0				* Voix 3
	beq.s	MuEv3
	move.l	MuChip3-MB(a3),a6
	move.l	VoiInst3(a5),a0
	move.l	d1,d2
	add.l	4(a0),d2
	move.l	d2,(a6)
	move.w	10(a0),$04(a6)
MuEv3	

* Start a voice
MuEvX	move.w	MuStart(a5),d1
	move.w	d1,MuStop(a5)
	clr.w	MuStart(a5)
	or.w	d1,d0
	and.w	MuDMAsk-MB(a3),d0
	bset	#15,d0
	move.w	d0,$DFF096

* Restart voices?
	move.w	MuReStart-MB(a3),d0
	beq	MuRsX
	moveq	#0,d3
	btst	#0,d0				* Voix 0
	beq.s	MuRs0
	lea	$DFF0A0,a6
	move.l	a6,MuChip0-MB(a3)
	move.w	#2,$04(a6)
	tst.l	VoiInst0(a5)
	beq.s	MuRs0
	bset	#0,d3
MuRs0	btst	#1,d0				* Voix 1
	beq.s	MuRs1
	lea	$DFF0B0,a6
	move.l	a6,MuChip1-MB(a3)
	move.w	#2,$04(a6)
	tst.l	VoiInst1(a5)
	beq.s	MuRs1
	bset	#1,d3
MuRs1	btst	#2,d0				* Voix 2
	beq.s	MuRs2
	lea	$DFF0C0,a6
	move.l	a6,MuChip2-MB(a3)
	move.w	#2,$04(a6)
	tst.l	VoiInst2(a5)
	beq.s	MuRs2
	bset	#2,d3
MuRs2	btst	#3,d0				* Voix 3
	beq.s	MuRs3
	lea	$DFF0D0,a6
	move.l	a6,MuChip3-MB(a3)
	move.w	#2,$04(a6)
	tst.l	VoiInst3(a5)
	beq.s	MuRs3
	bset	#3,d3
MuRs3	clr.w	MuReStart-MB(a3)
	or.w	d0,MuDMAsk-MB(a3)
	or.w	d3,MuStop(a5)
MuRsX	
	rts


***********************************************************
*	LED INSTRUCTION
LedOn:
*******
	bclr	#1,$BFE001
	rts
LedOf:	
*******
	bset	#1,$BFE001
	rts


***********************************************************
* 	MUSIC TOKEN TABLE
*	
*	This table is the crucial point of the extension! It tells
*	everything the tokenisatioin process needs to know. You have to 
*	be carefull when writing it!
*
*	The format is simple:
*	dc.w	Address of instruction-Tk,Address of function-Tk
*	dc.b	"instruction nam","e"+$80,"Param list",-1[or -2]
*
*	1- Address of instr/function
*		You must state the one that is needed. Just put
*	a 1 in the function field for an instruction, and in the 
*	instruction field for a function. Reserved variables need
*	TWO address!
*
*	2- Instruction name
*		It must be finished by the letter plus $80. Be carefull
*	ARGASM assembler produces bad code if you do "a"+$80, he wants
*	$80+"a"!!!
*		-You can SET A MARK in the token table with a "!" before
*	the name. See later
*		-Using a $80 ALONE as a name definition, will force AMOS
*	to point to the previous "!" mark...
*	
*	3- Param list
*		This list tells AMOS everything about the instruction.
*
*	- First character:
*		The first character defines the TYPE on instruction:
*			I--> instruction
*			0--> function that returns a integer
*			1--> function that returns a float
*			2--> function that returns a string
*			V--> reserved variable. In that case, you must
*				state the type int-float-string
*	- If your instruction does not need parameters, then you stop
*	- Your instruction needs parameters, now comes the param list
*			Type,TypetType,Type...
*		Type of the parameter (0 1 2)
*		Comma or "t" for TO
*
*	4- End of instruction
*			"-1" states the end of the instruction
*			"-2" tells AMOS that another parameter list
*			     can be accepted. if so, MUST follow the
*			     complete instruction definition as explained
*			     but with another param list.
*	If so, you can use the "!" and $80 facility not to rewrite the
*	full name of the instruction...See SAM LOOP ON instruction for an
*	example...
*
*	Remember that AMOS token list comes first, so names like:
*	PRINTHELLO will never work: AMOS will tokenise PRINT first!
*	Extension token list are explored in order of number...

*	The next two lines NEED to be there...
Tk:	dc.w 	1,0
	dc.b 	$80,-1

	dc.w	1,FMB-Tk
	dc.b	"mubas","e"+$80,"0",-1
	dc.w	1,FVu-Tk
	dc.b	"vumete","r"+$80,"00",-1
	dc.w	IVoice-Tk,1
	dc.b	"voic","e"+$80,"I0",-1
	dc.w	IMusOff-Tk,1
	dc.b	"music of","f"+$80,"I",-1
	dc.w	IMuStop-Tk,1
	dc.b	"music sto","p"+$80,"I",-1
	dc.w	ITempo-Tk,1
	dc.b	"temp","o"+$80,"I0",-1
	dc.w	IMusic-Tk,1
	dc.b	"musi","c"+$80,"I0",-1
	dc.w	INoTo-Tk,1
	dc.b	"noise t","o"+$80,"I0",-1
	dc.w	Boom-Tk,1
	dc.b 	"boo","m"+$80,"I",-1
	dc.w	Shoot-Tk,1
	dc.b	"shoo","t"+$80,"I",-1
	dc.w	ISBank-Tk,1
	dc.b	"sam ban","k"+$80,"I0",-1
	dc.w	ISLOn0-Tk,1
	dc.b	"!sam loop o","n"+$80,"I",-2
	dc.w	ISLOn1-Tk,1
	dc.b	$80,"I",-1
	dc.w	ISLOf0-Tk,1
	dc.b	"sam loop of","f"+$80,"I",-2
	dc.w	ISLOf1-Tk,1
	dc.b	$80,"I0",-1
	dc.w	ISamTo-Tk,1
	dc.b	"sampl","e"+$80,"I0t0",-1
	dc.w 	ISam1-Tk,1
	dc.b 	"!sam pla","y"+$80,"I0",-2
	dc.w	ISam2-Tk,1
	dc.b	$80,"I0,0",-2
	dc.w 	ISam3-Tk,1
	dc.b	$80,"I0,0,0",-1 
	dc.w 	ISamR-Tk,1
	dc.b 	"sam ra","w"+$80,"I0,0,0,0",-1	
	dc.w	Bell0-Tk,1
	dc.b 	"!bel","l"+$80,"I",-2
	dc.w 	Bell1-Tk,1
	dc.b	$80,"I0",-1
	dc.w	IPlOf0-Tk,1
	dc.b	"!play of","f"+$80,"I",-2
	dc.w	IPlOf1-Tk,1
	dc.b	$80,"I0",-1
	dc.w 	IPlay2-Tk,1
	dc.b	"!pla","y"+$80,"I0,0",-2
	dc.w	IPlay3-Tk,1
	dc.b	$80,"I0,0,0",-1
	dc.w 	ISWave-Tk,1
	dc.b 	"set wav","e"+$80,"I0,2",-1
	dc.w	IDWave1-Tk,1
	dc.b	"del wav","e"+$80,"I0",-1
	dc.w	ISEnv-Tk,1
	dc.b	"set enve","l"+$80,"I0,0t0,0",-1
	dc.w	IMVol-Tk,1
	dc.b	"mvolum","e"+$80,"I0",-1
	dc.w 	IVol1-Tk,1
	dc.b	"!volum","e"+$80,"I0",-2
	dc.w 	IVol2-Tk,1
	dc.b	$80,"I0,0",-1
	dc.w	IWave-Tk,1
	dc.b 	"wav","e"+$80,"I0t0",-1
	dc.w	LedOn-Tk,1
	dc.b	"led o","n"+$80,"I",-1
	dc.w	LedOf-Tk,1
	dc.b	"led of","f"+$80,"I",-1
	dc.w	ISay1-Tk,1
	dc.b	"!sa","y"+$80,"I2",-2
	dc.w	ISay2-Tk,1
	dc.b	$80,"I2,0",-1
	dc.w	ITalk-Tk,1
	dc.b	"set tal","k"+$80,"I0,0,0,0",-1
* You MUST finish the table by a ZERO
	dc.w 	0

*************** Enveloppes definitions
*	Be carefull, ARGASM is bugged with __Rs!!!
		RsReset
EnvNb:		rs.w	1
EnvDVol:	rs.w	1
EnvVol:		rs.l	1
EnvDelta:	rs.l 	1
EnvAd:		rs.l	1
EnvDeb:		rs.l	1
EnvLong:	equ 	__Rs

*************** Wave definition
LWave:		equ 	256+128+64+32+16+8+4+2
LNoise:		equ 	LWave
		RsReset
WaveNext:	rs.l	1
WaveNb:		rs.w	1
WaveEnv:	rs.w	16*2
WaveDeb:	rs.b	LWave
WaveLong:	equ 	__Rs

*************** Music voice data
		RsReset
VoiAdr		rs.l	1
VoiDeb		rs.l	1
VoiInst		rs.l	1
VoiDPat		rs.l	1
VoiPat		rs.l	1
VoiCpt		rs.w	1
VoiRep		rs.w	1
VoiNote		rs.w	1
VoiDVol		rs.w	1
VoiVol		rs.w	1
VoiSlide	rs.w	1
VoiSlB		rs.w	1
VoiSlC		rs.w	1		
VoiLong		equ 	__Rs

*************** MUBASE table
		RsReset
* Voix 0
MuVoix0		equ	__Rs
VoiAdr0		rs.l	1
VoiDeb0		rs.l	1
VoiInst0	rs.l	1
VoiDPat0	rs.l	1
VoiPat0		rs.l	1
VoiCpt0		rs.w	1
VoiRep0		rs.w	1
VoiNote0	rs.w	1
VoiDVol0	rs.w	1
VoiVol0		rs.w	1
VoiSlide0	rs.w	1
VoiSlB0		rs.w	1
VoiSlC0		rs.w	1		
* Voix 1
MuVoix1		equ	__Rs
VoiAdr1		rs.l	1
VoiDeb1		rs.l	1
VoiInst1	rs.l	1
VoiDPat1	rs.l	1
VoiPat1		rs.l	1
VoiCpt1		rs.w	1
VoiRep1		rs.w	1
VoiNote1	rs.w	1
VoiDVol1	rs.w	1
VoiVol1		rs.w	1
VoiSlide1	rs.w	1
VoiSlB1		rs.w	1
VoiSlC1		rs.w	1		
* Voix 2
MuVoix2		equ	__Rs
VoiAdr2		rs.l	1
VoiDeb2		rs.l	1
VoiInst2	rs.l	1
VoiDPat2	rs.l	1
VoiPat2		rs.l	1
VoiCpt2		rs.w	1
VoiRep2		rs.w	1
VoiNote2	rs.w	1
VoiDVol2	rs.w	1
VoiVol2		rs.w	1
VoiSlide2	rs.w	1
VoiSlB2		rs.w	1
VoiSlC2		rs.w	1		
* Voix 3
MuVoix3		equ	__Rs
VoiAdr3		rs.l	1
VoiDeb3		rs.l	1
VoiInst3	rs.l	1
VoiDPat3	rs.l	1
VoiPat3		rs.l	1
VoiCpt3		rs.w	1
VoiRep3		rs.w	1
VoiNote3	rs.w	1
VoiDVol3	rs.w	1
VoiVol3		rs.w	1
VoiSlide3	rs.w	1
VoiSlB3		rs.w	1
VoiSlC3		rs.w	1		
* Other data
MuCpt		rs.w	1
MuTempo		rs.w	1
MuStart		rs.w	1
MuStop		rs.w	1
* Total length
MuLong		equ 	__Rs

***************	MUSIC extension data zone
		even
MB:	
MuVu		dc.l	0		* Vu Meters
MuBase		dc.l	0		* Curretn music address
MusAdr		dc.l	0		* Branch table address
MusClock	dc.l 	3546895		* Clock speed
WaveBase	dc.l	0		* Wave tree
Waves		dc.w 	0,0,0,0
EnvOn:		dc.w 	0		* ADSR running?
EnvBase:	ds.b	EnvLong*4	* ADSR table
SamBank:	dc.w 	0		* Sample bank
BSeed:		dc.w 	0		* Random seed
Noise:		dc.w	0		* Noise on?
PNoise:		dc.w	0		* Pointer to noise buffer
* 		Musique
MusBank		dc.l 	0		* Music bank
MusCheck	dc.l	0		* Check sum
BankInst	dc.l	0		* Instruments
BankSong	dc.l	0		* Songs
BankPat		dc.l 	0		* Patterns
MuNumber	dc.w	0		* Music priority
MuVolume	dc.w	0		* Music volume
MuDMAsk		dc.w	0		* Voice mask
MuReStart	dc.w	0		* Restart the voice
MuChip0		dc.l	0		* Circuits 0
MuChip1		dc.l 	0		*	   1
MuChip2		dc.l 	0		*          2
MuChip3		dc.l 	0		*          3
FoEnd		dc.w	$8000		* Fake empty pattern
MuBuffer	ds.b	MuLong*3	* Music tables

*************** Default enveloppes
EnvDef:		dc.w 1,64,4,55,5,50,25,0,0,0
EnvShoot	dc.w 1,64,10,0,0,0
EnvBoom		dc.w 1,64,10,50,50,0,0,0
EnvBell		dc.w 1,64,4,40,25,0,0,0

*************** Sample enveloppes
EnvSam		dc.w 1,64,1,64,0,0,0,0
		dc.w 1,64,1,64,0,0,0,0
		dc.w 1,64,1,64,0,0,0,0
		dc.w 1,64,1,64,0,0,0,0

*************** Bank headers
BkSam:		dc.b "Samples "
BkMus:		dc.b "Music   "

*************** Frequency / notes
TFreq:	dc.w 000,256/2
	dc.w 000,256/2
	dc.w 256,128/2
	dc.w 384,64/2
	dc.w 448,32/2
	dc.w 480,16/2
	dc.w 496,8/2
	dc.w 504,4/2
	dc.w 504,4/2
TNotes:	dc.w 00,00,00,33,35,37,39,41,44,46,49,52
	dc.w 55,58,62,65,69,73,78,82,87,92,98,104
	dc.w 110,117,123,131,139,147,156,165,175,185,196,208
	dc.w 220,233,247,262,277,294,311,330,349,370,392,415
	dc.w 440,466,494,523,554,587,622,659,698,740,784,830
	dc.w 880,932,988,1046,1109,1175,1245,1319,1397,1480,1568,1661
	dc.w 1760,1865,1986,2093,2217,2349,2489,2637,2794,2960,3136,3322
	dc.w 3520,3729,3952,4186,4435,4699,4978,5274,5588,5920,6272,6645
	dc.w 7040,7459,7902,8372

*************** NARRATOR
Amaps:		dc.b	3,5,10,12
TranBase	dc.l	0
TalkIO:		ds.l	20
WriteRep:	ds.l	8
TranName	dc.b	"translator.library",0
NarDevice	dc.b	"narrator.device",0

*************** Welcome message
*		27 Y,position is like locate ,position...
MusWel:	dc.b 	27,"Y8Music player V 1.1",0

*************** ERROR MESSAGES
MusErr:	dc.b	"Wave not defined",0			*0
	dc.b 	"Sample not defined",0			*1
	dc.b 	"Sample bank not found",0		*2
	dc.b	"256 characters for a wave",0		*3
	dc.b	"Wave 0 and 1 are reserved",0		*4
	dc.b	"Music bank not found",0		*5
	dc.b 	"Music not defined",0			*6
	dc.b	"Can't open narrator",0			*7

*************** That's it!
	dc.l	0