; MIDIPlay Parx module
; Guillaume Tello
; guillaume.tello@orange.fr
; august 2023

	opt P=68000

VBL = 1	
DEBUG = 0
MAX_TRACKS  =  32

	if VBL=1
	
		output "MIDIPVBL.PRG"
		
TIMER MACRO
	move.l $4ba.w,d0
	ENDM
	
MIDIOUT MACRO
.mo\@:
	btst #1,$FFFFFC04.w
	beq.s .mo\@
	move.b d0,$FFFFFC06.w
	ENDM

	else
		output "MIDIPLAY.PRG"

TIMER MACRO
	trap #10
	ENDM
	
MIDIOUT MACRO
	trap #11
	ENDM


	endif


TICK2TIME MACRO
	btst #28,d6
	bne.s .a\@
	bsr muldiv
	bra.s .b\@
.a\@:
	opt P=68030
	muls.l d7,d1:d0
	divs.l d5,d1:d0
	opt P=68000
.b\@:
	ENDM

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

	if VBL=1
	
	dc.b "READ_SND"	; identifiant module de lecture de son
	dc.b "MIDI"			; type de son support‚
	dc.w $0300			; type (4 pour n‚cessit‚ de vider le cache aprŠs MODPAL) et 0 pour "chargement total"
	dc.b "MIDI-VBL"	; nom court
	dc.w 101				; version 1.00
	dc.b "MIDI File VBL player (G.Tello)",0,1	; long name + flag "configurable"	

	else
			
	dc.b "READ_SND"	; identifiant module de lecture de son
	dc.b "MIDI"			; type de son support‚
	dc.w $0300			; type (4 pour n‚cessit‚ de vider le cache aprŠs MODPAL) et 0 pour "chargement total"
	dc.b "MIDIPlay"	; nom court
	dc.w 101				; version 1.00
	dc.b "MIDI File player (G.Tello)    ",0,1	; long name + flag "configurable"
	
	endif 
	
	bra modinfo
	bra modpal
	bra modexe
	bra doparam			; configuration au d‚marrage

flags: dc.w %0000000000001110		; par d‚faut, 68000

	; flags  d6
	; 15		31 ne pas utiliser sinon code<0, c'est demande de statut
	; 14		30
	; 13		29
	; 12		28 f_cpu (1 si >=68020, 0 si 68000)
	; 11		27 f_alloff (1 par d‚faut, remis … 0 s'il reste encore une piste)
	; 10		26 f_text
	;  9		25 f_copyright
	;  8		24 f_track_name
	;  7		23 f_instrument
	;  6		22 f_lyric
	;  5		21 f_marker
	;  4		20 f_prompt
	;  3		19 f_program
	;  2		18 f_channel_pressure
	;  1		17 f_sysex
	;  0		16 f_timing

	; sur la pile RTS / 4 code.w / 6 chemin_parx.l(inutilis‚)
	; si code=1 , renvoie z‚ro (proc‚dure PARX standard)
	; si code=0 , renvoie 0 pour 68000 et 1 pour 68020+
doparam:
	pea .cookie(pc)
	move #38,-(sp)
	trap #14
	addq.l #6,sp
	lea flags(pc),a0
	or.b d0,(a0)	; conserve 0 ou 1 dans le bit CPU
	tst 4(sp)		; code
	beq.s .out		; code=0 renvoie la valeur d0 de la routine
	moveq #0,d0		; sinon, renvoie toujours z‚ro
.out:
	rts
.cookie:
	move.l $5a0.w,a0
	moveq #0,d0		; par d‚faut, CPU = 68000
	cmp.l d0,a0
	beq.s .fin		; pointeur nul, c'est fini
.encore:	
	move.l (a0)+,d1
	beq.s .fin		; 0 = fin de liste
	cmp.l #'_CPU',d1
	beq.s .ok
	addq.l #4,a0
	bra.s .encore
.ok:
	move.l (a0),d1
	cmp.l #20,d1
	bmi.s .fin
	moveq #16,d0	; pile le masque pour le bit CPU
.fin:
	rts

; 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 tracks(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 #'MThd',(a3)
	bne.s .inconnu
	move.l #'MIDI',(a4)	; le type MIDI
	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	

; 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‚
	cmp.l #'MThd',(a4)		; premier
	bne.s .erreur
	move.l a4,16(a3)			; dans le sndb (adresse donn‚es d‚comp)
	lea 60(a3),a0
	clr.b (a0)					; met le titre … z‚ro
	lea 92(a3),a0
	clr.b (a0)					; puis l'auteur
	moveq #0,d2
	moveq #1,d1
	move 10(a4),d2				; nombre de morceaux (1 pour format 0/1, sinon n)
	cmp #MAX_TRACKS,d2
	bmi.s .assez
	moveq #-2,d0				; renvoie -2, trop de pistes
	moveq #MAX_TRACKS,d2
.assez
	cmp #2,8(a4)				; format 2 ?
	bne.s .ok					; non on garde d1=1 par d‚faut
	move.l d2,d1				; sinon, nombre de morceaux
.ok:
	move.l d1,20(a3)			; stocke le nombre de morceaux, 1 par d‚faut
	moveq #32,d1
	sub.l d2,d1
	moveq #-1,d2
	move d2,42(a3)				; masque touts les channels ON
	lsr.l d1,d2					; masque des pistes ON (exemple %b1111 pour 4 pistes)
	move.l d2,28(a3)			; toutes les pistes sur ON
	move #100,40(a3)			; vitesse 100% 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/(si code=-2 )sndb+32/36 contient param1 & param2 
modexe:	
	movem.l d1/a0/a3,-(sp)	; d‚calage 12
	move.l 4+12(sp),a3		; sndb
	; ici tester si le mat‚riel est dispo (sortie MIDI?)
	if VBL=1
		lea playing(pc),a0	; ne pas s'encombrer de BCOSTAT si d‚j… en route
		tst.b (a0)
		bne.s .ok
	endif
	move #3,-(sp)				; midi
	move #8,-(sp)				; bcostat
	trap #13
	addq.l #4,sp
	tst.l d0
	bne.s .ok					; d0 non nul, MIDI prˆt … recevoir
	moveq #-1,d0				; mat‚riel manquant
	bra.s .exit					; on quitte
.ok:
	move.l 16(a3),a0			; adresse morceau
	moveq #-2,d0				; erreur si mauvais fichier
	cmp.l #'MThd',(a0)+
	bne.s .exit
	move.l 8+12(sp),d0		; commande !
	cmp.l #-2,d0				; cas particulier!
	beq.s .commande
	tst.l d0
	beq.s .stop
	bmi.s .status
	if VBL=1
		lea playing(pc),a1
		tst.b (a1)				; si il y a d‚j… un son, on quitte!
		bne.s .status
	endif
	cmp.l 20(a3),d0				; nombre max de morceaux (limit‚ … 65535...)
	ble.s .ok2
	moveq #1,d0					; si on d‚passe, on revient au morceau 1
.ok2:
	move.l d0,24(a3)			; morceau en cours
	cmp #2,4(a0)				; format 2?
	bne.s .ok3
	moveq #0,d1					; oui, on isole une piste
	subq.w #1,d0
	bset d0,d1					; cr‚e le masque "un seul morceau"	
	move.l d1,28(a3)			; masque … jour
.ok3:
	movem.l d2-d7/a1/a2/a4-a6,-(sp)
	bsr interprete
	movem.l (sp)+,d2-d7/a1/a2/a4-a6	
	bmi.s .exit					; en cas d'erreur
	bra.s .status
.stop:	
	if VBL=1
		tst.l 24(a3)
		beq.s .status				; d‚j… z‚ro, renvoie z‚ro
		lea playing(pc),a0		; sinon, arrˆte le son (la routine VBL d‚tecte ce 00
		sf (a0)						; et se d‚sintalle d'elle mˆme)
	endif
	clr.l 24(a3)				; et annule le marqueur
.status:
  	move.l 24(a3),d0			; lit l'‚tat en cours
  	if VBL=1
	   beq.s .exit
		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
	endif
.exit:
	movem.l (sp)+,d1/a0/a3
	rts
.commande:		; ici cas "-2"
	move.l 32(a3),d0	; valeur
	move.l 36(a3),d1	; commande
	cmp #$00FF,d1
	bhi.s .cc0
	cmp #32,d1
	bmi.s .trackonoff
	; ici commandes 00ii ON ou MUTE le channel (ii de 32 … 47 pour 0-15)
	move.w 42(a3),d2
	tst.l d0
	beq.s .ccc3
	bset d1,d2	; d1 modulo 32
	bra.s .ccc4
.ccc3:
	bclr d1,d2
.ccc4:
	move d2,42(a3)
	bra.s .status	
.trackonoff:
	; ici commandes 00ii ON ou MUTE la piste (ii de 0 … 31)
	move.l 28(a3),d2
	tst.l d0
	beq.s .cc1
	bset d1,d2
	bra.s .cc2
.cc1:
	bclr d1,d2
.cc2:
	move.l d2,28(a3)
	bra.s .status
.cc0:
	cmp #$01FF,d1
	bhi.s .cc3
	; ici commandes sp‚ciales
	cmp #$0100,d1	; speed (100=normal)
	bne.s .cc10
	move d0,40(a3)	; new speed ! (sur un WORD)
	bra.s .status
.cc10:	
	cmp #$0101,d1	; sys_ex
	beq.s .cc5
	cmp #$0102,d1	; pressure
	beq.s .cc5
	cmp #$0103,d1	; program
	bne.s .status	; code inconnu on abandonne
.cc5:
	lea flags(pc),a0
	tst.l d0
	beq.s .cc6
	bset d1,1(a0)	; met le flag, option valid‚e.
	bra .status
.cc6:
	bclr d1,1(a0)	; enlŠve le flag, option d‚sactiv‚e
	bra .status	
.cc3:
	cmp #$02FF,d1
	bhi.s .cc4
	; r‚glage volume
	move #$D0,d2
.cc7:
	and #$000F,d1	; garde canal 0-15
	or d2,d1			; fabrique $Di
	lsl #8,d1
	move.b d0,d1	; $Dinn
	swap d1			; $Dinnxxxx
	moveq #1,d0		; 1+1 octets … envoyer
	bsr midiws
	bra .status	
.cc4:
	cmp #$03FF,d1
	bhi.s .cc8
	; ici r‚glage instrument
	move #$C0,d2
	bra.s .cc7
.cc8:
	cmp #$04FF,d1
	bhi.s .cc9
	; ici r‚glage volume
	and #$000F,d1	; canal i
	or #$00B0,d1	; Bi
	lsl #8,d1
	move.b #7,d1	; Bi07
	lsl.l #8,d1
	move.b d0,d1	; Bi07nn
	lsl.l #8,d1		; $Bi07nnxx
	moveq #2,d0		; 2+1 … envoyer
	bsr.s midiws
	bra .status
.cc9:

	bra .status
	

midiws:
	lea .send(pc),a0
	move.l d1,(a0)		; up to 4 chars
	pea (a0)
	move d0,-(sp)
	move #12,-(sp)		; midiws
	trap #14
	addq.l #8,sp
	rts
.send: dc.l 0	
	
	; A0 pointe sur le fichier (mis … jour)
	; structure de longueur variale (de 1 … 4 octets)
	; renvoie dans d0, utilise d1
	
get_varlen:
	moveq #0,d0
.lb0:
	lsl.l #7,d0			; 7 bits significatifs
	move.b (a0)+,d1	; nouvel octet
	bclr #7,d1
	beq.s .fin			; si bit7=0 on a fini
	or.b d1,d0			; sinon, on ajoute les 7 bits et n continue
	bra.s .lb0
.fin:
	or.b d1,d0			;ajoute les 7 bits et fin
	rts

	if VBL=0
	
_timer:
	move.l $4ba.w,d0
	rte
	
_midiout:
	btst #1,$FFFFFC04.w
	beq.s _midiout
	move.b d0,$FFFFFC06.w
	rte
	
	endif
	
	; A0 = d‚but du fichier
	; A3 = structure SNDB
	
	; utilis‚s:
	; d5/d7 pour le calcul de proportion des "ticks" en "1/200"
	; d6 flags 31-16 et nombre de pistes 15-0
	; d4 bits 31-16 flags channelsON/OFF (sndb+42), bits 15-0 boucle
	; d2 last running status
	; d0-d1-d3 fourre tout
	; d0 utilis‚ comme donn‚e … transmettre au MIDI
	;    et ‚galement comme valeur du timer lue
	; A6 pointeur sur les structures de tracks

	; **** flags d6: ****
	; ceux du mot FLAGS dans son mot de poids fort

	
interprete:
	move.l (a0)+,d0	; taille header, au moins 6 !
	subq.l #6,d0	
	bmi.s .bad_file
	move (a0)+,d7		; format limit‚ … 0 ou 1 ou 2
	bmi.s .bad_file
	cmp #2,d7
	bgt.s .bad_file
	move flags(pc),d6
	swap d6				; les flags dans le mot sup‚rieur
	move (a0)+,d6		; tracks
	cmp #MAX_TRACKS,d6
	bgt.s .bad_file
	move (a0)+,d5		; frequence
	bmi.s .bad_file
	mulu 40(a3),d5		; x vitesse (base 100)
	divu #100,d5		;
	add.l d0,a0			; a0 avance de (taille header -6 d‚j… lus)
	muls #5000,d5		; d‚nominateur pour le calcul des temps
	move.l #500000,d7	; num‚rateur pour le calcul des temps avec par d‚faut 120 bpm
	lea tracks(pc),a6
	bsr optimise_d5d7
	move d6,d4
	move d6,d3			; pistes restantes
	move.l 28(a3),d2	; masque des pistes ON/MUTE
	bra.s .lb0
.bad_file:
	moveq #-2,d0
	rts
.find_tracks:
	cmp.b #'M',(a0)+	; octet par octet car a0 peut ˆtre impair
	bne.s .bad_file	; on ‚vite les bombes sur 68000
	cmp.b #'T',(a0)+
	bne.s .bad_file
	cmp.b #'r',(a0)+
	bne.s .bad_file
	cmp.b #'k',(a0)+
	bne.s .bad_file
	move.b (a0)+,d0
	lsl #8,d0
	move.b (a0)+,d0
	swap d0
	move.b (a0)+,d0
	lsl #8,d0
	move.b (a0)+,d0	; taille	
	move.l d0,8(a6)	; left
	lsr.l #1,d2			; on ou mute?
	scc 12(a6)			; fin si 0 (mute)
	bcs.s .lb00
	subq #1,d3			; une piste en moins alors...
.lb00:
	move.b #$fe,14(a6)	; status
	lea (a0,d0.l),a1	; next
	bsr get_varlen
	TICK2TIME			; transforme en 1/200 pour notre timer
	move.l d0,(a6)		; delta
	move.l a0,4(a6)	; pos
	move.l d1,16(a6)	; reste division
	move.l a1,a0
	lea 20(a6),a6
.lb0:
	dbf d4,.find_tracks

	if VBL=0		; ici suite de la routine dans le cas normal

	bsr install_traps
	TIMER
	lea start_time(pc),a0
	move.l d0,(a0)
	move.b #$FE,d2		; last running status
	move.l 42(a3),d4	; juste pour les bits 31-16 flags channels on/off
.principal:
	move d6,d4
	lea tracks(pc),a6
	bset #27,d6			; effac‚ ensuite s'il reste une piste encore
	bra.s .loop
.next_track:
	lea delta_time(pc),a0
	move.l (a0),d1		; delta_time
	tst.b 12(a6)		; piste finie?
	bne.s .loop1		; oui on passe
	bclr #27,d6			; il reste au moins une piste
	cmp.l (a6),d1
	bmi.s .loop1		; pas encore son temps, on passe
	bsr traite_event
.loop1:
	lea 20(a6),a6		; next track
.loop:
	dbf d4,.next_track
	btst #27,d6
	bne.s .exit			; bit encore l…, il ne reste plus rien !
.next_time:
	lea kbshift(pc),a0
	move.l (a0),a0
	btst #2,(a0)		; touche CONTROL ?
	bne.s .exit			; oui on quitte !
	TIMER
	lea start_time(pc),a0
	sub.l (a0)+,d0
	move.l d0,(a0)
	bra.s .principal
.exit:
	bsr all_notes_off
	bsr remove_traps
	moveq #0,d0
	rts	
	
	else					; ici routine pour la VBL
	
	lea sauve_reg(pc),a0
	movem.l d2/d5-d7/a3,(a0)
	bsr install_traps	; la VBL est install‚e ?
	tst.l d0
	bne.s .exit			; si <>0 code d'erreur (VBL inaccessible)
	move.l 24(a3),d0	; renvoie l'‚tat (morceau en cours)
.exit:
	rts

init_vbl:
	movem.l a2-a3/a6/d2-d7,-(sp)
	move.l my_vbl(pc),a0
	lea next_vbl(pc),a1
	move.l a1,(a0)		; prochaine VBL, pas d'initialisation
	lea start_time(pc),a0
	TIMER
	move.l d0,(a0)+	; start time
	clr.l (a0)			; delta time … z‚ro
	bra.s _vbl_commun

next_vbl:
	movem.l a2-a3/a6/d2-d7,-(sp)
	TIMER
	lea start_time(pc),a0
	sub.l (a0)+,d0
	move.l d0,(a0)
_vbl_commun:
	lea sauve_reg-1(pc),a0		; pointe sur playing !
	tst.b (a0)+						; si z‚ro..? arrˆt demand‚
	beq.s .arret
	movem.l (a0),d2/d5-d7/a3

.principal:
	move.l 42(a3),d4	; bits 31-16 pour les flags channels on/off
	move d6,d4
	lea tracks(pc),a6
	bset #27,d6			; effac‚ ensuite s'il reste une piste encore
	bra.s .loop
.next_track:
	lea delta_time(pc),a0
	move.l (a0),d1		; delta_time
	tst.b 12(a6)		; piste finie?
	bne.s .loop1		; oui on passe
	bclr #27,d6			; il reste au moins une piste
	cmp.l (a6),d1
	bmi.s .loop1		; pas encore son temps, on passe
	bsr traite_event
.loop1:
	lea 20(a6),a6		; next track
.loop:
	dbf d4,.next_track
	btst #27,d6
	beq.s .exit			; bit ot‚, il reste encore une piste
.arret:
	bsr stop_play		; sinon, fini !!
.exit:
	lea sauve_reg(pc),a0
	movem.l d2/d5-d7/a3,(a0)	
	movem.l (sp)+,a2-a3/a6/d2-d7
	rts	
		
	endif

traite_event:
	move.l 4(a6),a0	; position
	moveq #0,d0
.lbff:
	move.b (a0)+,d0	; octet ‚v‚nement
	cmp #$FF,d0
	bne.s .lb0
	bsr meta_event
	bra .lb9
.lb0:
	cmp.b #$f0,d0
	beq.s .lb1
	cmp.b #$f7,d0
	bne.s .lb2
.lb1:
	bsr sysex_event
	bra .lb9
.lb2:
	cmp #$f6,d0
	bgt.s .lb3
	cmp #$f1,d0
	bmi.s .lb3
	bsr system_common
	bra .lb9
.lb3:
	cmp #$f8,d0
	bmi.s .lb4
;	bsr system_real_time	; routine vide … priori...
	bra .lb9
.noteon:		; si $8n tester bit 15+n en d4 pour valider
	bset #4,d0	; transforme en $9n
	btst d0,d4
	beq.s .skip	; channel off, on n'envoie pas la note
	bclr #4,d0	; remet $8n
	bra.s .ok	; sort la note
.noteoff:
	btst d0,d4
	bne.s .ok	; ok, sort le note off
.skip:
	addq.l #2,a0	; saute les deux paramŠtres
	bra .lb9		; suite !
.lb4:
	move d0,d1
	and #$00F0,d1
	cmp #$e0,d1
	beq.s .ok
	cmp #$80,d1
	bmi.s .lb5
	beq.s .noteon
	cmp #$b0,d1
	bgt.s .lb5
	cmp #$90,d1
	beq.s .noteoff
.ok:
	MIDIOUT		; envoie d0 ici MIDI EVENT
	move.b d0,d2	; last running status
	move.b (a0)+,d0 ; et ses 2 paramŠtres
	MIDIOUT
	move.b d2,14(a6)	; running status
	move.b (a0)+,d0
	MIDIOUT
	bra .lb9
.lb5:
	cmp #$c0,d1
	bne.s .lb6
	btst #19,d6
	bne.s .lb55
	addq.l #1,a0		; flag FAUX, on saute
	bra .lb9
.lb55:
	MIDIOUT				; ici PROGRAM CHANGE
	move.b d0,d2		; l r s
	move.b (a0)+,d0
	MIDIOUT
	move.b d2,14(a6)	; rs
	bra .lb9
.lb6:
	cmp #$d0,d0
	bne.s .lb7
	btst #18,d6
	bne.s .lb66
	addq.l #1,a0		; flag FAUX, on saute
	bra .lb9
.lb66:
	MIDIOUT				; ici CHANNEL PRESSURE
	move.b d0,d2		; lrs
	move.b (a0)+,d0
	MIDIOUT
	move.b d2,14(a6)	; rs
	bra .lb9
.lb7:						; ici DEFAULT
	cmp.b 14(a6),d2	; lrs = rs ?
	beq.s .lb8
	move.l d0,d2		; sauve event
	move.b 14(a6),d0	; rs
	MIDIOUT				; envoie running status
	exg.l	d0,d2			; r‚cupŠre event et lrs=rs
.lb8:
	MIDIOUT				; envoie event
	move.b 14(a6),d1
	and #$00F0,d1
	cmp #$e0,d1
	beq.s .ok2
	cmp #$80,d1
	bmi.s .lb9
	cmp #$b0,d1
	bgt.s .lb9
.ok2:
	move.b (a0)+,d0
	MIDIOUT
.lb9:
	move.l a0,d0		; nouvelle position
	sub.l 4(a6),d0		; d‚placement r‚alis‚
	move.l a0,4(a6)
	sub.l d0,8(a6)		; r‚duit la taille restante
	ble.s .lb10			; si <= 0 c'est fini !
	bsr get_varlen		; sinon lit le timing suivant
	tst.l d0				; si temps nul, on traite tout de suite le suivant !
	beq .lbff
	if DEBUG=1
		bsr debug
	endif
	TICK2TIME
	add.l 16(a6),d1	; accumule le reste
	cmp.l d1,d5			; le reste d‚passe le diviseur?
	bpl.s .lb99
	addq.l #1,d0		; si oui, quotient+1
	sub.l d5,d1			; et r‚duit le reste
.lb99:
	add.l d0,(a6)		; ajoute le nouveau temps
	move.l d1,16(a6)	; et met … jour le reste
	move.l a0,d0		; nouvelle position
	sub.l 4(a6),d0
	move.l a0,4(a6)
	sub.l d0,8(a6)
	ble.s .lb10
	rts
.lb10:
	st 12(a6)
	rts	

	; d‚cale d5 et d7 autant de fois qu'ils sont pairs
	; en esp‚rant avoir un D7 WORD pour optimiser les multiplications
	
_optimise_d5d7:
	lea sauve_d5d7(pc),a1	; ici dans meta event avec $51
	move.l (a1)+,d5
	bra.s _opt_commun
optimise_d5d7:					; ici au d‚pat avec interprete
	lea sauve_d5d7(pc),a1
	move.l d5,(a1)+
_opt_commun:
	move.l d7,(a1)+
.lb0:
	btst #0,d7
	bne.s .fin
	btst #0,d5
	bne.s .fin
	lsr.l #1,d5
	lsr.l #1,d7
	bra.s .lb0
.fin:
	rts

	; calcule d0*d7/d5
	; quotient dans d0 et reste dans d1
	
muldiv:
	movem.l d2-d4/d6,-(sp)
	; multiplie D0 par D7, r‚sultat dans D1:D4
	; d7 et d5 inchang‚s
	cmp.l #$FFFF,d0
	bhi.s .mulLL
	cmp.l #$FFFF,d7
	bhi.s .mulWL
	move d0,d4		; ici cas D0 et D7 WORD
	moveq #0,d1
	mulu d7,d4
	bra.s .divise
.mulWL:				; ici cas D0 WORD et D7 LONG
	move d0,d4
	mulu d7,d4
	move.l d7,d1
	swap d1
	mulu d0,d1
	move.l d1,d0
	swap d0
	clr d0
	clr d1
	swap d1
	add.l d0,d4
	bcc.s .divise
	addq.l #1,d1
	bra.s .divise
.mulLL:
	move d0,d3
	mulu d7,d3
	move d3,d4
	clr d3
	swap d3
	moveq #0,d2
	swap d0
	move d7,d1
	mulu d0,d1
	add.l d1,d3
	bcc.s .lbm1
	addq.l #1,d2
.lbm1:
	swap d7
	move d0,d1
	mulu d7,d1
	swap d0
	mulu d7,d0
	add.l d0,d3
	bcc.s .lbm2
	addq.l #1,d2
.lbm2:
	swap d2
	add.l d2,d1
	swap d4
	move d3,d4
	swap d4
	clr d3
	swap d3
	swap d7		
	add.l d3,d1
.divise:
	; division de D1:D4 par D5
	tst.l d1
	bne.s .div64_32
	tst.l d4
	bmi.s .div64_32	; si d4>$80000000 alors d‚calage d5 en 64 bits possible
						; ici division de D4 par D5 car D1 = 0
	moveq #0,d3		; nombre de d‚calages
	moveq #0,d0		; quotient
.lb32_2:
	cmp.l d4,d5		; on compare
	bhi.s .lb32_0		; plus grand, bien cal‚
.lb32_1:
	addq.l #1,d3	; si plus petit, un d‚calage de plus
	lsl.l d5			; et d‚cale!
	bra.s .lb32_2
.lb32_0:
	tst.l d3
	bmi.s .fin
	add.l d0,d0		; d‚cale le quotient
	cmp.l d4,d5		; si ‚gal, comparer parties basses
	bhi.s .lb32_4		; trop grand, juste d‚caler	
.lb32_3:
	sub.l d5,d4		; on soustrait
	addq.l #1,d0	; un de plus dans le quotient
.lb32_4:
	subq.l #1,d3	; un d‚calage de moins
	lsr.l d5			; revient en arriŠre
	bra.s .lb32_0
						; ici division D1:D4 par D5 car D1<>0
.div64_32:
	moveq #0,d6		; partie sup‚rieure de d6:d5
	moveq #0,d3		; nombre de d‚calages
	moveq #0,d0		; quotient
.lb2:
	cmp.l d1,d6		; d6:d5 > d1:d4
	bhi.s .lb0		; oui on est bien cal‚!
	bne.s .lb1		; si plus petit en d‚cale
	cmp.l d4,d5		; si ‚gaux, on compare le bas
	bhi.s .lb0		; plus grand, bien cal‚
.lb1:
	addq.l #1,d3	; si plus petit, un d‚calage de plus
	lsl.l d5			; et d‚cale!
	roxl.l d6
	bra.s .lb2
.lb0:
	tst.l d3
	bmi.s .fin
	add.l d0,d0		; d‚cale le quotient
	cmp.l d1,d6		; d6:d5 > d1:d4 ?
	bhi.s .lb4		; plus grand, on doit juste d‚caler
	bne.s .lb3 		; plus petit, donc on peut soustraire!
	cmp.l d4,d5		; si ‚gal, comparer parties basses
	bhi.s .lb4		; trop grand, juste d‚caler	
.lb3:
	sub.l d5,d4		; on soustrait
	subx.l d6,d1
	addq.l #1,d0	; un de plus dans le quotient
.lb4:
	subq.l #1,d3	; un d‚calage de moins
	lsr.l d6			; revient en arriŠre
	roxr.l d5
	bra.s .lb0
.fin:
	move.l d4,d1	; d4 est le reste
						; d0 le quotient
	add.l d5,d5		; corrige le dernier d‚calage
	movem.l (sp)+,d2-d4/d6
	rts
	
	; F0 et F7
sysex_event:
	btst #17,d6		; f_sysex
	bne.s .ok
	bsr get_varlen	; flag FAUX
	add.l d0,a0		; on saute le bloc
	rts
.ok:
	cmp.b #$f0,d0	; flag VRAI, on envoie
	bne.s .lb0
	MIDIOUT			; si F0, on l'envoie aussi
.lb0:
	bsr get_varlen
	move.l d0,d1
	bra.s .lb1
.lb2:
	move.b (a0)+,d0
	MIDIOUT
.lb1:
	dbf d1,.lb2
	rts
	
	; FF
meta_event:
	move.l a0,a1
	addq.l #1,a0
	bsr get_varlen	; longueur dans d0
	move.l d0,d1	; dans d1
	move.b (a1),d0	; et type dans d0
	cmp.b #$51,d0
	bne.s .lb0
	move.l d4,-(sp)
	lea sauve_d5d7(pc),a1
	move.l 4(a1),d5	; ancien num‚rateur D7
	moveq #0,d7
	move.b (a0)+,d7
	swap d7
	move.b (a0)+,d7
	lsl #8,d7
	move.b (a0)+,d7	; r‚cupŠre le timing sur 3 octets. Nouveau num‚rateur.
	lea delta_time(pc),a1
	move.l (a1),d4
	add.l d4,-4(a1)	; start_time+delta, nouveau d‚but
	clr.l (a1)			; et delta = 0
	lea tracks(pc),a1
	move d6,d3
	bra.s .lb2
.lb3:
	move.l (a1),d0		; ancien delta
	sub.l d4,d0			; nouveau
	bgt.s .lb4
	moveq #0,d0			; si n‚gatif, on revient … du positif
	bra.s .lb5
.lb4:
	TICK2TIME			; recalcule les proportions entre d5 et d7
.lb5:
	move.l d0,(a1)
	clr.l 16(a1)		; et r‚initialise le reste
	lea 20(a1),a1
.lb2:
	dbf d3,.lb3
	movem.l (sp)+,d4
	bsr _optimise_d5d7
	rts
.lb0:
	cmp.b #$2f,d0	; fin de piste?
	bne.s .lb1
	st 12(a6)		; oui, on marque la fin !!
	rts	
.lb1:					; ici tous les autres cas.
	add.l d1,a0		; saute par d‚faut les donn‚es
	rts

	; F1 … F6	
system_common:
	cmp.b #$f2,d0
	bne.s .lb0
	addq.l #2,a0	; F2 xx xx
	rts
.lb0:
	cmp.b #$f1,d0
	beq.s .lb1
	cmp.b #$f3,d0
	bne.s .lb2
.lb1:
	addq.l #1,a0	; F1 ou F3 xx
.lb2:
	rts				; tous les autres sans paramŠtres
		
install_traps:
	movem.l d0-d7/a0-a6,-(sp)
	pea .inst(pc)
	move #38,-(sp)
	trap #14
	addq.l #6,sp
	movem.l (sp)+,d0-d7/a0-a6
	rts
	
	if VBL=0		; installation des traps 10 et 11 pour timer et midiout
	
.inst:
	lea old_traps(pc),a0
	move.l $a8.w,(a0)+
	move.l $ac.w,(a0)+

	move.l $4f2.w,a1
	move.l 36(a1),(a0)	; kbshift

	lea _timer(pc),a0
	move.l a0,$a8.w
	lea _midiout(pc),a0
	move.l a0,$ac.w
	
	if DEBUG=1
		lea ptr(pc),a0
		lea zone(pc),a1
		move.l a1,(a0)
	endif
	rts
	
	else			; ici VBL, installation de la premiŠre routine d'initialisation

.inst:	
	lea $452.w,a0
	tst.w (a0)+			; VBL autoris‚?
	beq.s .erreur
	move (a0)+,d0		; nombre de VBL
	move.l (a0),a0		; pointeur sur la liste
	bra.s .loop
.find_vbl:				; cherche une vbl libre
	tst.l (a0)+
	beq.s .found
.loop:
	dbf d0,.find_vbl
	bra.s .erreur
.found:
	lea init_vbl(pc),a1
	move.l a1,-(a0)	; mon initialisation en VBL
	lea my_vbl(pc),a1
	move.l a0,(a1)		; en garde l'adresse pour l'effacement futur
	lea playing(pc),a0
	st (a0)
	moveq #0,d0			; tout est ok
	rts
.erreur:
	moveq #-1,d0		; mat‚riel pas prˆt
	rts
	
	endif

	if VBL=0

remove_traps:
	movem.l d0-d7/a0-a6,-(sp)
	pea .rem(pc)
	move #38,-(sp)
	trap #14
	addq.l #6,sp
	movem.l (sp)+,d0-d7/a0-a6
	rts
.rem:
	lea old_traps(pc),a0
	move.l (a0)+,$a8.w
	move.l (a0)+,$ac.w
	rts

	else
	
stop_play:
	move.l my_vbl(pc),a1
	clr.l	(a1)			; clear VBL
	lea playing(pc),a1
	sf (a1)
	bsr all_notes_off
	rts

	endif

all_notes_off:
	moveq #15,d1
.lb0:
	move.b d1,d0
	add.b #$B0,d0		; cr‚e $Bn avec le num‚ro de canal
	MIDIOUT
	moveq #123,d0		; $7B
	MIDIOUT
	moveq #0,d0
	MIDIOUT				; au final $Bn $7B $00 = all OFF sur canal n
	dbf d1,.lb0
	rts


	if DEBUG=1
debug:
	tst d4
	bne.s .exit
	cmp.l #$66d8,(a6)
	bne.s .exit
	illegal
.exit:
	rts
	endif
	
		section	bss
		
		if VBL=1
		
		ds.b 3		; pour aligner playing
		; *** ne pas s‚parer
playing: ds.b 1
sauve_reg: ds.l 5 ; d2,d5,d6,d7,a3
my_vbl: ds.l 1
		; ***

		else

; *** ne pas s‚parer
old_traps: ds.l 2
kbshift:	ds.l 1
; ***
		endif

start_time: ds.l 1
delta_time: ds.l 1

sauve_d5d7: ds.l 2

tracks: ds.l MAX_TRACKS*5	; pour chaque piste:
			; 0	LONG delta (temps du prochain ‚v‚nement)
			; 4	LONG pos   (position dans le fichier)
			; 8	LONG left  (ce qui reste … traiter)
			; 12	INT fin
			; 14	INT status
			; 16  LONG accumulateur reste division pour delta (correction d'arrondis)

	if DEBUG=1
ptr: ds.l 1
zone: ds.b 10000
	endif

		end