; SNDH Parx module
; Guillaume Tello
; guillaume.tello@orange.fr
; january 2023
;
; from the original work of :
;
********************************************
* Example Play Source for XLR8 Music Files *
*  All code by F.v.Nispen/Eagle of Sentry  *
********************************************

MAX_HEADER:	equ	200

GEMDOS MACRO    ; fn,pile
   move #\1,-(sp)
   trap #1
   if \2<=8
      addq.l #\2,sp
   else
      add.w #\2,sp
   endif
   ENDM

		section	text
		
	dc.b "READ_SND"	; identifiant module de lecture de son
	dc.b "XLR8"			; type de son support‚
	dc.w $0400			; type (4 pour n‚cessit‚ de vider le cache aprŠs MODPAL) et 0 pour "chargement total"
	dc.b "XLR8_SMP"	; nom court
	dc.w 100				; version 1.00
	dc.b "XLR8 - Sentry Music Player    ",0,0	; long name
	bra modinfo
	bra modpal
	bra modexe

; sur la pile RTS/4:sndb.l
; en entr‚e seul le handle est fourni
; en sortie remplit taille et taille d‚compress‚e
; ainsi que le type de fichier
; renvoie 0,1 ou 2.

modinfo:
	move.l 4(sp),d0	; le sndb
	movem.l d1-d3/a0-a4,-(sp)
	move.l d0,a4
	move.l 12(a4),d0	; handle
	bsr fseek1			; va … la fin !
	move.l d0,4(a4)	; stocke la taille
	move.l 12(a4),d0	; reprend le handle
	bsr fseek0			; ramŠne au d‚but
	lea buffer(pc),a3	; zone
	moveq #16,d3		; taille … lire
	move.l	a3,-(sp)
	move.l	d3,-(sp)
	move.w	d0,-(sp)
	GEMDOS 63,12
	cmp.l d3,d0
	bne.s .inconnu
	cmp.l #'XLR8',10(a3)
	bne.s .inconnu
	move.l 10(a3),(a4)	; le type XLR8
	move.l 4(a4),8(a4)	; renvoie la taille originale comme taille d‚compress‚e
	moveq #2,d0				; son nom compress‚
	bra.s .exit
.inconnu:
	moveq #0,d0
	move.l d0,(a4)			; type z‚ro, inconnu
.exit:
	movem.l (sp)+,d1-d3/a0-a4
	rts	

; d0 = handle, ramŠne au d‚but
fseek0:
	movem.l d0-d2/a0-a2,-(sp)
	moveq #0,d1
	move d1,-(sp)
	move d0,-(sp)
	move.l d1,-(sp)
	GEMDOS 66,10
	movem.l (sp)+,d0-d2/a0-a2
	rts	

; d0 = handle, va … la fin
fseek1:
	movem.l d1-d2/a0-a2,-(sp)
	moveq #0,d1
	move #2,-(sp)
	move d0,-(sp)
	move.l d1,-(sp)
	GEMDOS 66,10
	movem.l (sp)+,d1-d2/a0-a2
	rts	

;------------------------------------------------------------------------------
set_super:	movem.l	d0-a6,-(sp)
		move.l	#1,-(sp)
		move.w	#$20,-(sp)
		trap	#1
		addq.l	#6,sp
		tst.w	d0
		bne.s	.insuper
		clr.l	-(sp)
		move.w	#$20,-(sp)
		trap	#1
		addq.l	#6,sp
		lea sav_usp(pc),a0
		move.l	d0,(a0)
.insuper:	movem.l	(sp)+,d0-a6
		rts

set_user:	movem.l	d0-a6,-(sp)
		move.l	#1,-(sp)
		move.w	#$20,-(sp)
		trap	#1
		addq.l	#6,sp
		tst.w	d0
		beq.s	.inuser
		move.l	sav_usp(pc),-(sp)
		move.w	#$20,-(sp)
		trap	#1
		addq.l	#6,sp
.inuser:	movem.l	(sp)+,d0-a6
		rts
sav_usp:	ds.l	1

find_cookie:	move.l	$5a0.w,d0		;Get address of cookie jar in D0
		beq.s	.nojar			;If zero, there's no jar.
		move.l	d0,a0			;Move the address of the jar to A0
.search:	tst.l	(a0)			;Is this jar entry the last one ?
		beq.s	.nofind			;Yes, the cookie was not found
		cmp.l	(a0),d1			;Does this cookie match what we're looking for?
		beq.s	.foundit		;Yes, it does.
		addq.l	#8,a0			;Advance to the next jar entry
		bra.s	.search			;And start over
.nofind:	moveq	#-1,d0			;A negative (-1) means cookie not found
		rts
.nojar:		moveq	#-2,d0			;A negative (-2) means there's no jar
		rts
.foundit:	moveq	#0,d0			;A null in D0 means the cookie was found.
.exit:		rts

; pile RTS/4:sndb/8:adrsource/12:adrdest	
modpal:
	movem.l d1-d2/a0-a4,-(sp)	; 28 octets de d‚calage
	move.l 4+28(sp),a3
	move.l 12(a3),d0			; handle
	bsr fseek0					; revient au d‚but
	move.l 8+28(sp),a4
	move.l a4,-(sp)			; adresse source
	move.l 4(a3),-(sp)		; taille source
	move.w d0,-(sp)			; handle
	GEMDOS 63,12				; lire tout le fichier
	moveq #2,d0					; par d‚faut, retour OK non compress‚
	moveq #0,d2
	move 6(a4),d2
	lea -8(a4,d2.l),a2		; identifiant
	cmp.l #'XLR8',(a2)+		; premier
	bne.s .erreur
	cmp.l #'SONG',(a2)		; second
	bne.s .erreur
	move.l a4,16(a3)			; dans le mfdb (adresse donn‚es d‚comp)
	moveq #0,d2
	move 8(a4),d2
	lea 0(a4,d2.l),a2			; pointe sur l'auteur
	lea 60(a3),a0
	clr.b (a0)					; met le titre … z‚ro
	lea 92(a3),a0
	bsr.s .copystring			; puis l'auteur
	moveq #1,d2
	move.l d2,20(a3)			; stocke le nombre de morceaux, 1 par d‚faut
	bra.s .out
.erreur:
	moveq #0,d0					; si ce n'est pas le cas, erreur.
	move.l d0,(a3)				; annule le type
.out:
	movem.l (sp)+,d1-d2/a0-a4
	rts
.copystring:
	moveq #15,d2
.cs0:
	move.b (a2)+,(a0)+
	dbeq d2,.cs0
	clr.b (a0)
	rts

; pile RTS/4:sndb/8:code commande
modexe:	
	movem.l d1/a0/a3,-(sp)	; d‚calage 12
	move.l 4+12(sp),a3		; sndb
	move.l 16(a3),a0			; adresse morceau
	moveq #-2,d0
	cmp.l #'XLR8',10(a0)
	bne.s .exit
	cmp.l 8+12(sp),d0			; valeur -2?
	beq .commande				; oui, une commande
	bsr set_super
	move.l	#'_SND',d1
	bsr	find_cookie
	bsr set_user
	tst.l	d0
	bmi.s	.ok					; par d‚faut, pas de cookie, on suppose que ‡a marche
	moveq #-1,d0
	btst #0,7(a0)				; le bit 0 pour le Yamaha
	beq.s .exit					; non pr‚sent !
.ok:
	move.l 8+12(sp),d0		; commande !
	beq.s .stop
	bmi.s .status
	move.l d0,24(a3)			; morceau en cours
	bsr start_play
	bra.s .status
.stop:	
	tst.l 24(a3)
	beq.s .status				; d‚j… z‚ro, renvoie z‚ro
	bsr stop_play				; sinon, arrˆte le son
	clr.l 24(a3)				; et annule le marqueur
.status:
	move.l 24(a3),d0			; lit l'‚tat en cours
	beq.s .exit
	nop
;	lea playing(pc),a0		; si ce n'est pas z‚ro, on v‚rifie...
;	tst.b (a0)					; si le son est physiquement fini
;	bne.s .exit
;	moveq #0,d0					; si oui, on annule l'‚tat
;	move.l d0,24(a3)			; dans sndb
.exit:
	movem.l (sp)+,d1/a0/a3
	rts
.commande:
	move.l 32(a3),d0	; valeur
	move.l 36(a3),d1	; commande
	cmp #$102,d1		; le 50Hz
	bne.s .status
	lea flag(pc),a0
	tst.l d0
	sne (a0)				; mis … FF si forcer 50Hz
	bra.s .status

start_play:
	bsr set_super
	move.l 16(a3),a0
	pea 2(a0)			; music+2
	moveq	#1,d0			; normal song-play mode
	jsr (a0)
	lea $4ce.w,a0
.find_vbl:				; cherche une vbl libre
	tst.l (a0)+
	bne.s .find_vbl
	move.b flag(pc),d0
	beq.s .normal_vbl
	lea timer(pc),a1
	move.l $4ba.w,(a1)+	; premiŠre valeur timer
	move.l (sp)+,(a1)		; music+2 ou on doit sauter
	lea force50(pc),a1	; ma VBL pour 50Hz
	move.l a1,-(a0)		; dans la vbl queue
	bra.s .commun
.normal_vbl:
	move.l (sp)+,-(a0)	; music+2 in VBL
.commun:
	move.l a0,d0
	lea my_vbl(pc),a0
	move.l d0,(a0)
	bsr set_user
	rts
	
force50:
	lea timer(pc),a0
	move.l $4ba.w,d0	; timer courant
	cmp.l (a0),d0
	blt.s .exit			; temps pas atteint
	addq.l #4,(a0)+	; ajoute 4/200 = 50hz
	move.l (a0)+,-(sp)	; remet l'adresse du vrai VBL comme retour
.exit:
	rts					; quitte ou saute au VBL
	
stop_play:
	bsr set_super
	move.l 16(a3),a0
	moveq	#0,d0			; exit music
	jsr (a0)
	
	move.l my_vbl(pc),a1
	clr.l	(a1)			; clear VBL
	bsr set_user
	rts
	
		section	bss
flag: ds.w 1	; 0 VBL normal, 1 forcer 50Hz
my_vbl: ds.l 1
buffer: ds.b 16
; ne pas s‚parer
timer: ds.l 1	; en cas de force 50Hz
_vbl: ds.l 1	; la vraie VBL
; ***

		end