Player de fichiers midi sur Thomson

Cette catégorie traite de développements récents destinés à nos vieilles machines, applications, jeux ou démos... Amis programmeurs, c'est ici que vous pourrez enfin devenir célèbres!

Modérateurs : Papy.G, fneck, Carl

jester
Messages : 2328
Inscription : 01 janv. 2009 23:16
Localisation : Grenoble

Re: Player de fichiers midi sur Thomson

Message par jester »

Le truc le plus simple pour se faire la main est de rejouer juste les dumps de musique AY-3 qui pilulent sur le web... il s'agit de fichiers contenant directement le contenu des données à envoyer au AY-3 pour rejouer la musique. Les fichiers sont assez gros (dump des registres réalisé via émulateur) mais ça permet déjà de tester le hard et de maitriser les techniques ASM nécessaire.
Ensuite bien sur un vrai player devra jouer des fichiers dans un format soundtrack avec gestion temps réel des différents effets prévus... ça doit bien prendre entre 10 et 30% du CPU selon la complexité du soundtrack et la maitrise du programmeur.

Bon courage (surtout pour trouver quelqu'un motivé pour réaliser ton prototype).
Fool-DupleX
Messages : 2366
Inscription : 06 avr. 2009 12:07

Re: Player de fichiers midi sur Thomson

Message par Fool-DupleX »

Bien que je me sois moi-même essaye a faire un sequenceur MIDI sur Thomson et sur les TO, grâce au timer, je confirme que c'est plus que faisable pour piloter un synthetiseur externe sur 16 canaux, dans le contexte present, je crois effectivement que la piste a suivre n'est pas celle-la, mais celle d'un tracker plus optimise, dedie a l'ay-3. Il y a beaucoup de bonnes choses a prendre même dans les grands classiques comme les players de mod, screamtracker etc. ainsi sans doute que dans toutes les demos faites sur des machines qui ont l'ay-3.

la reduction automatique d'un multi-track est un probleme sans bonne solution encore aujourd'hui. Il vaut mieux composer des musiques specialement dediees au materiel a disposition. les tests peuvent se faire en reprenant des musiques existantes pour ay-3.

Cela etant dit, l'extension synthese de parole a un gros potentiel encore inexplore pour la musique; Seul PulkoMandy s'est pour le moment essaye a l'utiliser. Elle est tres legere en bande passante et autorise l'utilisation des interruptions. Convertir une musique echantillonnée en data pour le MEA est un challenge interessant.

@jester: j'ai realise quantite de protos hardware pour les thomson et je ne ferme pas la porte a ce projet. je dois cependant evaluer la charge.
jester
Messages : 2328
Inscription : 01 janv. 2009 23:16
Localisation : Grenoble

Re: Player de fichiers midi sur Thomson

Message par jester »

Un syntéhtiseur de parole marche très bien pour générer des échantillons de paroles et certains bruitages sur qqs centaines d'octets... suffit de voir la démo de Transylvania pour Exelvision... à condition d'avoir l'outil approprié pour générer la séquence binaire. Par contre ça coince coté musique et pour pas mal de bruitages, même si je suis sur qu'avec un outil adapté ça doit être possible. Mais la il faut un gros spécialiste en traitement du signal.
__sam__
Messages : 7987
Inscription : 18 sept. 2010 12:08
Localisation : Brest et parfois les Flandres

Re: Player de fichiers midi sur Thomson

Message par __sam__ »

Salut!

Existe il un format de tracker chiptune tout simple qui soit documenté et ayant des exemples? J'aurais besoin de "nourriture" simple pour un truc ASM que je suis en train de faire. Je lui ai bien donné à manger la sortie de mon convertisseur midi modifié pour dépasser le simple <beep>, mais c'est déjà trop compliqué. En fait je voudrais quelque chose de plus simple et plus mélodique tout en tenant compte des limitations de la bébête (style 3 octaves).

sam (ais-je dit que je cherchais quelque chose de simple? :P )
Samuel.
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
Avatar de l’utilisateur
gilles
Messages : 2782
Inscription : 07 août 2008 13:44
Localisation : Nantes
Contact :

Re: Player de fichiers midi sur Thomson

Message par gilles »

lorsque je me suis amusé sur l'exl100 je suis reparti de beepola qui est un outil basé sur les formats de player 1bit du zx spectrum.
http://freestuff.grok.co.uk/beepola/
__sam__
Messages : 7987
Inscription : 18 sept. 2010 12:08
Localisation : Brest et parfois les Flandres

Re: Player de fichiers midi sur Thomson

Message par __sam__ »

Les exemples de beepola sont très sympathiques. J'ai retrouvé Cauldron2 que j'avais utilisé dans HNY2013. A noter: les fichirs BBSong sont plutôt gros pour les memory map thomson (~14-15K pour les plus courts).
Samuel.
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
__sam__
Messages : 7987
Inscription : 18 sept. 2010 12:08
Localisation : Brest et parfois les Flandres

Re: Player de fichiers midi sur Thomson

Message par __sam__ »

Les amateurs de rock sudiste américain connaissent peut être cette version de Sweet Home Alabama des Lynyrd Skynyrd jouée par deux bobines Tesla:

Voici une version made-in Thomson: multivoix.zip (lien cassé, mais voir en fin de message)

Bon avec les 12V de l'alim standard, ne vous attendez pas à ce que cela fasse de grosses étincelles. C'est juste une preview, un truc expérimental pour tester mon moteur multivoix et voir ce qu'il peut fournir (nota: il ne monopolise pas 100% du CPU, l'animation écran est jouée indépendamment de la musique). Pour l'instant je trouve qu'il imite pas mal les tronçonneuses (et les bobines Tesla). C'est déjà un début. Mais à vous de vous faire une opinion :P

Dans le ZIP se trouve le midi que j'ai converti dans le format (expérimental) de mon player multivoix (encore plus expérimental). La D7 contient plusieurs variations (MV1.BIN .. MV7.BIN) correspondant à différents paramétrage du convertisseur midi. La version jouée par défaut quand on appuie sur "B" est "MV.BIN" et correspond à la dernière que j'ai traduite. Cela n'est pas forcément la meilleure. Pour moi c'est MV3.BIN, mais je pense que ceux qui ont l'oreille musicale vont la trouver moins nettes que d'autres. Oui c'est vrai le spectre est plus embrouillé, mais du coup pour moi c'est la plus riche en harmoniques et donc la plus intéressante.
Image
Son le spectre présente des jolis sinus-cardinals (sinus-cardinaux? bref des sinc) qui marquent un PULS ( :wink: ) précis dans le temps, mais du coup une grosse imprécision de la note dans le domaine fréquentiel. Cela porte un nom... le théorème de je ne sais plus qui? Heisenberg.. non, ca pourrait, mais c'est pas ca. Je ne sais plus. Enfin bref, cette imprécision de la note jouée masque plutôt bien le désaccordement des notes aigües qui sont horribles à entendre avec un signal trop propre type sinus ou créneaux.

Allez petit sondage: qui préfère quelle version du ZIP? (sortir avec CTRL-C, retourner au basic et lancer LOADM"MV3",,r ou tout autre MV au choix).

/!\ aux oreilles sensibles. Le fort taux d'inharmonie peut être très déplaisant à entendre pour ceux qui n'aiment pas les guitares électriques saturées et desaccordées. Image

[edit] Les liens sont cassé, j'ai re-trouvé le zip:
multivoix.zip
(156.74 Kio) Téléchargé 396 fois
Dernière modification par __sam__ le 24 août 2015 19:01, modifié 3 fois.
Samuel.
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
rinnaudin
Messages : 24
Inscription : 30 mars 2013 13:39

Re: Player de fichiers midi sur Thomson

Message par rinnaudin »

Moi je préfère MV3.BIN

Je n'ai pas tout suivi, il y a vraiment un rapport avec les bobines tesla? car apparemment ça utilise l'interface musique et jeux, aucun rapport avec des bobines? Ou alors c'était juste pour dire que le son ressemblait au son des bobines?

SONG.ASM a été créé sur PC non? Car trop gros pour avoir avec la cartouche assembleur sur TO8.

En tout cas moi j'adore le concept, faire la même chose avec une carte son c'est une des choses que je voudrais faire (si c'est possible).
__sam__
Messages : 7987
Inscription : 18 sept. 2010 12:08
Localisation : Brest et parfois les Flandres

Re: Player de fichiers midi sur Thomson

Message par __sam__ »

Le fichier ASM n'a pas besoin d'être en mémoire pour être compilé. Certains assembleurs (Assembleur v3), peuvent faire de la compilation "sur disk" sans charger l'ensemble du code source en mémoire (c'est l’intérêt de la directive INCLUD):
Image Image
Image Image

Sinon oui "bobines Tesla" c'est parce que le son ressemble beaucoup à ce que ces haut-parleurs sans masse et autres plasma-speakers sont capables de faire. Sinon, si tu vois des étincelles dans le Thomson, c'est plutôt mauvais signe :mrgreen:.


J'ai mis à jour la D7 thomson avec le thème "mario" (ici). Ca rend étonnamment bien.
Samuel.
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
Avatar de l’utilisateur
farvardin
Messages : 436
Inscription : 27 déc. 2014 16:07
Contact :

Re: Player de fichiers midi sur Thomson

Message par farvardin »

très chouette la musique ! Ça sonne bien 1-bit, oui :)
Le mario n'est plus disponible, tu l'as encore ? [edit: je l'ai trouvé sur la disquette, c'est "mv"]

et les sources du convertisseur sont publiées ou pas ? Ça pourrait être amusant comme moteur de musique...
__sam__
Messages : 7987
Inscription : 18 sept. 2010 12:08
Localisation : Brest et parfois les Flandres

Re: Player de fichiers midi sur Thomson

Message par __sam__ »

farvardin a écrit :et les sources du convertisseur sont publiées ou pas ? Ça pourrait être amusant comme moteur de musique...
Il me semble oui peut-être dans les sources des version soumises à la forever, sinon le voici dans sa dernière version "brut de décoffrage" (player 2 canaux + voix avec du bruit)

Code : Tout sélectionner

#!/bin/perl
# conversion de fichier midi en asm
# Samuel DEVULDER 2013-2015

# no buffering
$| = 1;

&init_globals;

# frequence de base
$glb_period = 478;
	
# durée des arpèges
$glb_arpg_ticks = 0b00000001;

# décalage
$glb_pitch = undef;

# nombre de notes maxi dans un arpège
$glb_arpg_max = 2;

# utilisation du noise ?
$glb_noise = 0;

# skyline par instrument
$glb_skyline_per_inst = 0;

# volume constant
$glb_vol = undef;

# -loop <0|1|2> -track a,b,c file.mid
$file = "<missing-file>";
%glb_tracks = ();
$prev = "";
for $curr (@ARGV) {
	if(-e $curr) {$file = $curr;}
	if("-h" eq $curr) {&usage;}
	if("-p" eq $prev) {$glb_pitch = $curr;}
	if("-n" eq $prev) {$glb_arpg_max = $curr;}
	if("-i" eq $curr) {$glb_skyline_per_inst = 1;}
	if("-d" eq $curr) {$glb_noise = 1;}
	if("-v" eq $prev) {$glb_vol = $curr;}
	if("-x" eq $prev) {
		my($i, @t) = (0, split(/,/,$curr));
		foreach $i (split(/,/, $curr)) {$glb_tracks{$i} = -1;}
	}
	$prev = $curr; 
}
die "file: $file" unless -e $file;
die "loop: $loop" if $loop<0 || $loop>2;

@trk = &read_midi($file);
#@trk = &norm_bpm(@trk);
@trk = &norm_inst(@trk);

@trk = &convert($glb_arpg_max, 0.5, @trk);

#print "\n\n";
#for $k (keys %stat) {$tats{$stat{$k}} = $k;}
#for $k (sort {$a<=>$b} keys %tats) {
#	print sprintf("%6d => %d\n", $tats{$k}, $k);
#}
#exit;

#@trk = &convert($glb_arpg_max, 0.5, @trk);
@tom = &compress_track(@trk);

$file=~/.*[\/\\](.*)(\.[^\.]*)?/;
$nom = $1;
print "* $nom (", 1+$#tom, " octets)\n";
&print_trk(@tom);
print "* ", 1+$#tom, " octets ($nom)\n";

exit(0);


sub usage {
	print __FILE__, " [-h] [-p <pitch-offset>] [-n <MIP>] [-s] [-d] [-x <t1,t2,t3,...>] <file.mid>";
	exit(0);
}

sub convert {
	my($glb_arpg_max, $tol, @zik) = @_;

	print STDERR "Conversion...";
	
	my($nz_dk) = 0.7;
	my($scale) = 2*16/128;
	
	# récup du tempo
	
	my($arpg) = int($glb_ticks_per_note*$glb_arpg_ticks/0b00100000 + .5);

	#my($ALG) = 2+8; #1+2;
	
	loop: for(my $restart=1; $restart; $restart = 0) {
	my(@trk, $i);
	my(%note); # notes théoriquements jouées
	my($curr, $inst, $lvol) = (0, -1, 0);  # derniere note jouée
	my($time, $next, $chl, $key, $vol);      # dernier instant
	
	# notes en cours
	my($k0, $v0, $k1, $v1);
	
	my(%lNSE);
	
	my($last_tempo) = 0;
	my(@bpm) = (sort {$a <=> $b} keys %glb_bpm);
	
	for($i=0; $i<=$#zik;) {
		($time, $chl, $key, $vol) = @{$zik[$i]};
		
		# nouveau tempo?
		if($#bpm>=0 && $bpm[0]<=$time) {
			my($tempo) = int(60000000/32/$glb_period/$glb_bpm{shift(@bpm)});
			push(@trk, "cTEMPO", $last_tempo = $tempo) if $tempo!=$last_tempo;
		}
		
		# calcule dans %note les notes jouees a l'instant $time
		do {
			#$key = $key<0?-1:1 if $glb_noise && $chl==9;
			$vol = int($vol * $scale);
			my($k) = abs($key).",$chl";
			#print "$time $chl $key $vol\n";
			if($key>0) {$note{$k} = $vol if $vol>$note{$k};} 
			else {$note{$k} = 0;}
			delete $note{$k} if $note{$k} <= 0;
			($next, $chl, $key, $vol) = @{$zik[++$i]};
		} while($time==$next && $i<=$#zik);
		
		#print "$time=[";
		#for $key (sort keys %note) {my($k,$i) = split(',', $key); ² "$glb_note{$k}($i:$k)=>$note{$key} ";}
		#print "]\n";
		
		my($delay) = &time2tick($next - $time);
				
		#print "$time=[";
		#for $key (sort keys %sp) {print "$glb_note{$key}($key)$is{$key}=>$sp{$key} ";}
		#print "]\n";
		
		my(%imp) = &important_notes($tol, %note);
		
		#print "IMP=",join(' ', sort keys %imp),"\n";

	
		# on atténue les intensité des plus vielles pour le tour suivant
		#for $key (keys %note) {
		#	$note{$key} = int($note{$key}*(.7**(($next-$time)/$glb_ticks_per_note)));
		#}
	
		#print "    [", join(' ', keys %keys), "]  $nxti\n\n";
		$xx = $v0;
		my($s) = scalar keys %imp;
		#print "X=$delay $s $nz $k0=$v0 $k1=$v1\n";
		if($s == 0) {
			push(@trk, "n0P") if $k0>0; $k0 = 0; 
			push(@trk, "n1P") if $k1>0; $k1 = 0;
		} 
		if($s == 1) {
			# si l'une des notes precedentes est conserve
			my($k) = (keys %imp);
			if($k == $k0 || $k!=$k1) {
				push(@trk, "cVOL0",($v0=$imp{$k})) if $v0!=$imp{$k};
				push(@trk, "n0".$glb_note{$k0=$k}) if $k0!=$k;
				push(@trk, "n1P") if $k1>0; $k1=0;
			} else {
				push(@trk, "cVOL1",($v1=$imp{$k})) if $v1!=$imp{$k};
				push(@trk, "n0P") if $k0>0; $k0=0;
			}
			$s = 0;
		} 

		my($k, $j);
		if($s>1) {
			# cas général: la fréquence la plus élevée reste sur un canal fixe
			for $j (keys %imp) {$k=$j if $j>$k;}
			if($k==$k0) {
				$j = 1;
				push(@trk, "cVOL0",($v0=$imp{$k})) if $v0!=$imp{$k};
			} else {
				$j = 0;
				push(@trk, "cVOL1",($v1=$imp{$k})) if $v1!=$imp{$k};
				push(@trk, "n1".$glb_note{$k1=$k}) if $k1!=$k;
			}
			delete $imp{$k}; --$s;
		}
		#print "X=$delay $s $nz $j $k0=$v0 $k1=$v1\n";
		
		my(@k) = (sort keys %imp);
		if($s==1) { #si un seul autre
			$k = shift(@k);
			push(@trk, "cVOL0",($v0=$imp{$k})) if $j==0 && $v0!=$imp{$k};
			push(@trk, "cVOL1",($v1=$imp{$k})) if $j==1 && $v1!=$imp{$k};
			push(@trk, "n0".$glb_note{$k0=$k}) if $j==0 && $k0!=$k;
			push(@trk, "n1".$glb_note{$k1=$k}) if $j==1 && $k1!=$k;
			--$s;
		}
		
		# percussions non interruptives mais ayant la priorité 
		my($nz) = 0;
		my($min_z) = 1000;
		while(my ($k, $v) = each %note) {
			my($z,$i) = split(',', $k);
			next if $i!=9;
			$min_z = $z if $z<$min_z;
 			$nz += $v*$v if $glb_noise;
		}
		
		# TODO prévoir un volume tunable pour le noise
		$nz = int(sqrt($nz)*$scale*6); #int(sqrt($nz)*$scale*4);
		$nz = 47 if $nz>47;
		
		if($v0 + $v1 + $nz > 63) {
			$scale = int($scale*63/($v0 + $v1 + $nz)*128)/128;
			print STDERR "rescale ", int(128*$scale),"/128...";
			goto loop;
		}
				
		# optim: mise en facteur des effets "bruits"

		#push(@trk, " x set $delay");
		$nz &= ~1;
		#print STDERR "$min_z\n" if $nz;
		if($s==0 && $nz>0) {
			my($li, $lo);
			
			$nz_dk = 0.7**($min_z / 36);
			#$nz_dk = 0.9 if $min_z == 38;
			#$nz_dk = 0.1 if $min_z == 36;
			$nz_dk = 0.99 if $nz_dk>0.99;
			
			my($dur) = 0;
			for(my $t = $nz; $t>0 && $delay>0; ++$dur) {$t = int($t*$nz_dk);--$delay;}
			$li = $lNSE{"$nz,$dur"};
			if(!$li) {
				$li = &tmp_lbl."i".(scalar keys %lNSE);
				$lo = &tmp_lbl."o".(scalar keys %lNSE);
				$lNSE{"$nz,$dur"} = $li;
				push(@trk, "cJMP", "$lo<-8", "$lo&255");
				push(@trk, sprintf("%-6s set    *", $li));
				$delay += $dur;
				while($nz>0 && $delay>0) {
					push(@trk, "cNOISE", $nz);
					push(@trk, "s128");
					$nz=int($nz*$nz_dk);
					--$delay;
				}
				push(@trk, "cNOISE", 0);
				push(@trk, "cRTS", sprintf("%-6s set    *", $lo));
			}
			
			push(@trk, "cJSR", "$li<-8", "$li&255");
			
			# bourrage pour atteindre une duree connue
			while($delay>0) {push(@trk, "s128");--$delay;}
			#push(@trk, &convert_duree($delay)) if $delay>0;
				
			$delay = $nz = 0;
		}

		# =======================
		push(@trk, "cNOISE", $nz) if $nz>0;
		my($x)=0;
		while(($s>0||$nz>0) && $delay>0) {
			if($s>0) {
				$k = $k[$x++]; $x=0 if $x>$#k;
				push(@trk, "cVOL0",($v0=$imp{$k})) if $j==0 && $v0!=$imp{$k};
				push(@trk, "cVOL1",($v1=$imp{$k})) if $j==1 && $v1!=$imp{$k};
				push(@trk, "n0".$glb_note{$k0=$k}) if $j==0 && $k0!=$k;
				push(@trk, "n1".$glb_note{$k1=$k}) if $j==1 && $k1!=$k;
			}
			push(@trk, "s128"); --$delay;
			if($nz>0) {
				$nz = int($nz*$nz_dk);
				# optim orig
				$nz = 0 if ($nz<$v0/2 || $nz<$v1/2 || $delay==0);
				push(@trk, "cNOISE", $nz);
			}
		}
		#print join(' ', @trk[$#trk-4...$#trk]), "\n";
		
		#die if $xx==63 && $v0==62;
		
		push(@trk, "cNOISE", ($nz=0)) if $nz>0; # inutile?
		push(@trk, ("s128")x$delay);
		
		#print "$inst $curr\n";
	}
	push(@trk, "n0P") if $k0>0; $k0 = 0; 
	push(@trk, "n1P") if $k1>0; $k1 = 0;
	
	print STDERR "done\n";
	
	return @trk;
	}
}

# retourne un label temporaire statistiquement unique
sub tmp_lbl {
	if(!$glb_lbl) {
		$glb_lbl = "A";
		for(my $j=26*26*26*rand; $j-->0;) {++$glb_lbl;}
		$glb_lb1 = 0;
	}
	return $glb_lbl.($glb_lb1++);
}

sub freq2note {
        my($f) = int($_[0]);
        my($n) = $glb_freq2note{$f};
        if(!defined $n) {
                my($d) = 1000000;
                for(my $i=0; $i<=$glb_max_note; ++$i) {
                        my($t) = $f - &freq($i);
                        $t = -$t if $t<0;
                        if($t<$d) {$d = $t; $n = $i;}
                }
                $glb_freq2note{$f} = $n;
        }
        return $n;
}

sub freq {
        my($key) = @_;
        my($f) = $glb_freq{$key};
        $glb_freq{$key} = $f = int(440*(2**(($key-69.0)/12))) unless defined $f;
        return $f;
}

# calcule le spectre d'une note
sub spectrum {
        my($key, $vol) = @_;
        my(%vol, $m);

        my($f) = &freq($key);

        $vol{$key} += $vol; #&ampl($vol, $f);
        foreach $m (3, 5, 7, 9) {
                last if $f*$m>$glb_max_freq;
                $vol{&freq2note($f*$m)} += $vol/($m**5);
        }
        return %vol;
}

sub important_notes {
	my($tol, %note) = @_;
	my(%sp, %keys, $key, $vol);
	
	if($glb_noise) {
		my(%sp) = %note;
		while(my ($k, $v) = each %sp) {
			my($z,$i) = split(',', $k);
			delete $note{$k} if $i==9;
		}	
	}
	
	if($glb_skyline_per_inst) {
		# pour chaque channel, on ne garde que la note la
		# plus haute (skyline)
		while(($key, $vol) = each %note) {
			my($k,$i) = split(',', $key);
			$sp{$i} = $k if $k>$sp{$i};
		}
		while(my ($i, $k) = each %sp) {$keys{"$k,$i"} = $note{"$k,$i"};}
		%note = %keys; %keys = (); %sp = ();
	}
	
	# calcul du spectre: on prends le sup
	# autre possibilite: on somme les harmoniques
	my($p) = 2;
	while(($key, $vol) = each %note) {
		my($k,$i) = split(',', $key);
		$sp{$k} += $vol**$p;
		#$sp{$k} = $vol if $vol>$sp{$k};
		#$sp{$k} = 63 if $sp{$k}>63;
	}
	for $key (keys %sp) {
		$sp{$key} = int($sp{$key}**(1/$p));
		$sp{$key} = 63 if $sp{$key}>63;
	}
	%note = %sp; %sp = ();
	
	#	print join(' ', %note),"\n";

	while(($key, $vol) = each %note) {
		my(%z) = &spectrum($key, $vol);
		while(my($k, $v) = each %z) {$sp{$k} += $v;}
	}
	
	if(0) {
	for $key (keys %note) {
		my($f, $g) = &freq($key);
		for $g (2 .. 20) {my($t) = &freq2note($f/$g); delete $note{$t};}
	}
	}
	
	#for $q (keys %note) {print $q,"=>",$note{$q}," ";} print "\n";
	
	
	# on trie les notes par intensité, et à intensité identique
	# par frequence
	my(@k) = (sort {($sp{$a}<=>$sp{$b} or $a<=>$b)} keys %note);
	#for $q (@k) {print $q,"=>",$sp{$q}," ";} print "\n";
	
	while(scalar keys %keys<$glb_arpg_max && $#k>=0) {
		my($t) = pop(@k);
		$keys{$t} = defined $glb_vol?$glb_vol:$note{$t};
	}
	return %keys;
}

sub dist_to_set {
        my($key, @keys) = @_;

        my($m, $k) = 10000;
        for $k (@keys) {
                my $d = $k - $key;
                $d = -$d if $d<0;
                $m = $d if $d<$m;
        }

        return $m;
}

sub by_time {
	my($time1, $ch1, $note1, $vol1) = @$a;
	my($time2, $ch2, $note2, $vol2) = @$b;
	
	#$note1 = -$note1 if $note1<0;
	#$note2 = -$note2 if $note2<0;
	
	my($d) = $time1 <=> $time2;
	#$d = abs($note1)<=>abs($note2) unless $d;
	$d = $note1<=>$note2 unless $d;
	
	return $d;
}

sub print_trk {
	my(@t) = @_;
	my($n);
	
	&flush_line;
	for $n (@t) {&add_note($n);}
	&flush_line;
}

# comprime les s128 s128 en s64 etc
sub compress_sXX {
	my(@t) = @_;
	my($i, $d, $s, @r);
	
	my(%m);	while(my ($k, $v) = each %glb_duree) {$m{$v} = $k;}
	
	for $i (@t) {
		if($i=~/^s(\d+)/) {
			die "durée inconnue: $i" unless defined $m{$i};
			$s += $m{$i};
		} else {
			while($s>0) {
				for $d (@glb_duree) {
					if($s>=$d) {
						$s -= $d;
						push(@r, "$glb_duree{$d}");
						last;
					}
				}
			}
			push(@r, $i);
		}
	}
	print STDERR "sXX(",1+$#r,")...";	
	return (@r);
}

sub compress_track {
	my(@t) = @_;
	return @t if 0;
	
	print STDERR "Compression(",1+$#t,")...";
	
	@t = compress_sXX(@t);
	#@t = compress_LZ(@t);
	#@t = compress_rpt(@t);
	@t = compress_SAM(@t);
	
	if(0) {
	@t = compress_SAM(("sA")x2,("sA","sB")x48,("sA")x2);
	
	}
		
	my($do) = 0;
	while(1) {
		my($l)=1+$#t;
		print STDERR "($l)...";
		@t = &compress_track_aux(@t);
		last if 1+$#t == $l;
	}
	
	if(0) {
		#@t = (("cB", ("cA")x8)x2, "cD")x2;#@t = @t[0..256];
		my($lbl,$l) = "l00";
		do {
			$l = 1+$#t;	
			print STDERR "$l...";
			@t = &comp($lbl++, @t);
		} while($l!=1+$#t);
		#print STDERR "\n";
	}

	
	print STDERR "(",1+$#t,")...done\n";
	return @t;
}

sub expand_code {
	my(@in) = @_;
	my(@out);
	
	# lookup label
	my(%lbl);
	for my $i (0..$#in) {
		$lbl{$1} = $i+1 if $in[$i]=~/([^\s]*)\s*set\s*[*]/;
	}

	# virtually execute the score, but record notes
	my(@out, @for, @jsr);
	for(my $i=0; $i<=$#in;) {
		my $c = $in[$i++];
		#print STDERR "$i     $c\n";
		if($c=~/.*\sset\s/) {
			# ignore
		} elsif($c=~/cRPT1\+(\d+)/) {
			unshift(@for, $1, $i);
			push(@out, "$c,$1=$i") if $DBG;
		} elsif($c=~/cNXT/) {
			push(@out, "$c,$for[0]=$i") if $DBG;
			if($for[0]-->0) {
				$i = $for[1];
			} else {
				shift(@for); 
				shift(@for);
			}
		} elsif($c=~/cJMP/) {
			$in[$i] =~ /(.*)<-8/;
			$i = $lbl{$1};
			last unless defined $i;
			push(@out, "$c,$1=$i") if $DBG;
		} elsif($c=~/cJSR/) {
			$in[$i] =~ /(.*)<-8/;
			unshift(@jsr, $i+2);
			$i = $lbl{$1};
			push(@out, "$i $c,$1 : ".join(',', @jsr)) if $DBG;
		} elsif($c=~/cRTS/) {
			$i = shift(@jsr);
			push(@out, "$i $c ".$in[$i-1]." : " . join(',', @jsr)) if $DBG;
		} else {
			push(@out, $c);
		}
	}
	
	die "for not empty" if @for;
	die "jsr not empty" if @jsr;
	#print STDERR "input:",1+$#in," expanded:",1+$#out;

	return @out;
}

# regroupe les codes en mots atomiques
sub group_atomic {
	my(@d);
	for my $s (@_) {
		if($s =~ /^[scn]/ || $s =~ /\sset\s/) {push(@d, $s);}
		else {$d[$#d] .= ",$s";}
	}
	return @d;
}

# taille d'un code en octet
sub code_size {
	my($l, @in) = (0, @_);
	for my $s (@in) {$l += scalar split(/,/, $s) unless $s=~/\sset\s/;}
	return $l;
}

sub compress_SAM {
	local(@data) = &group_atomic(&expand_code(@_));
	
	#$DBG = 1;
	
	my($in) = join("\n", &expand_code(split(/,/, join(',', @data))));
	
	print STDERR "SAM";
	
	while(1) {
		print STDERR "(",&code_size(@data),")...";
		#for my $i (@data) {print "$i\n";}
	
		# ajout du semaphore
		push(@data, "--END--");
		
		#print STDERR "sam(",$#data,")...";
	
		# conversion symboles -> entier (plus rapide)
		my(%h, @d);
		for my $s (@data) {
			$h{$s}=keys %h unless defined $h{$s};
			push(@d, $h{$s});
		}
		undef %h;
		print STDERR ".sort";

		# tri
		my(@t) = sort { my($i,$j) = ($a,$b);
			while($d[$i] == $d[$j]) {++$i;++$j;}
			$data[$i] cmp $data[$j];
		} (0..$#data-1);
		
		print STDERR ".patt";		
		# recherche des motifs répétitifs
		my(%gain, %xgain, $last, %precalc);
		&perc(0);
		for(my $i=0; $i<$#t; ++$i) {
			#print STDERR "$i / $#t \r";
			&perc($i/$#t);
			my($deb) = $t[$i];
			my($len) = &pfx($deb, $t[$i+1], \@d);
			
			# un prefix doit contenir cRPT1 et cNXT
			my($for) = 0;
			for(my $j=0; $j<$len;++$j) {
				++$for if $data[$deb+$j]=~/cRPT1/;
				--$for if $data[$deb+$j]eq"cNXT";
				$len = $j if $for<0;
			}
			while($for>0) {
				--$len;
				--$for if $data[$deb+$len]=~/cRPT1/;
				++$for if $data[$deb+$len]eq"cNXT";
			}
			next unless $len; undef $for;
		
			# taille du code local
			my($k) = join(',',@data[$deb..$deb+$len-1]);
			my($cz) = scalar split(/,/, $k); 

			# saute si trop petit
			next if $cz<=3;
				
			# saute si déjà traité
			next if $last eq $k; $last = $k; 
			#next if $done{$k}; $done{$k} = 1; undef $k;
			
			#print STDERR "\n$i:$len $k";
		
			# trouve les répétitions
			my(@o) = &occurs($deb, $len, $i, \@t, \@d);
			
			# gain possible
			my($gain) = $cz*($#o+1) - ($cz + 1);
			++$gain if $data[$deb+$len-1]=~/cJMP/;
			for(my $j=0; $j<=$#o; ++$j) {
				my($c) = 0;
				while($j<$#o && $o[$j+1]-$o[$j]==$len) {++$j; ++$c;}
				if($c>0) {$gain -= 2 + 3;} else {$gain -= 3;}
			}
			
			# saute si aucun gain
			next if $gain<=0;
			
			#next if $gain<$min;
			#if($gain>$max) {$max = $gain; $min = $max>>1;}
			
			#print STDERR "$gain (o=$#o, cz=$cz): $k\n";
			#$gain = $#o+1;
			
			#print STDERR "o=$#o, $cz, $gain\n";
			
			#print STDERR "$zz * ",(1+$#o), "=$z: $k\n";
			$gain{$i} = $gain;
			#$xgain{$i} = ($data[$deb+$len-1]=~/c(JSR|JMP|RTS)/);
			
			$precalc{$i} = "$deb,$len,".join(',', @o);
		}
		&perc(1.1);
		undef %done;
		
		# si aucun gain => terminé
		last unless %gain;
		
		# tri des motifs par gains
		print STDERR ".sort";	
		my(@ordered) = sort {$gain{$b} <=> $gain{$a} || $b<=>$a} (keys %gain);
		undef %gain; undef %xgain;
		
		# placement + bibliotheque
		print STDERR ".alloc";
		my(@alloc) = (0) x $#data;
		my(@lib, %lbl);
		for my $i (@ordered) {
			my($deb, $len, @o) = split(/,/, $precalc{$i});
		
			my($used) = 0;
			for my $o (@o) {for my $j (0..$len-1) {$used |= $alloc[$j+$o];}}
			next if $used;
			
			for my $o (@o) {
				for my $j (0..$len-1) {$alloc[$j+$o] = 2*($i+1);}
				$alloc[$o] |= 1;
			}
			
			my(@code) = @data[$deb...$deb+$len-1];
				
			#print STDERR "<<<<<\n", join("\n", @code),">>>>>\n\n";
				
			pop(@code) if $code[$#code]=~/cRTS/;
			if($code[$#code]=~/c(JSR|JMP)/) {
				$code[$#code]=~s/cJSR/cJMP/;
			} else {
				push(@code, "cRTS");
			}
				
			#print STDERR join("\n", @code),"\n\n";
				
			$lbl{$i} = &tmp_lbl;
			#die if $lbl{$i}=~/[^\d]34$/;
			push(@lib, sprintf("%-6s set    *", $lbl{$i}), @code);
		}
		undef %precalc;
		print STDERR ".score";
	
		# generation du code
		my(@out);
		for(my $j=0; $j<$#data;) {
			#print STDERR $j," ",$alloc[$j]&1," ",($alloc[$j]>>1)-1," ",$data[$j],"\n";
			if(!$alloc[$j]) {
				if($data[$j] eq "cRTS" && $out[$#out]=~/cJSR/) {
					$out[$#out]=~s/cJSR/cJMP/;
				} else {
					push(@out, $data[$j]);
				}
				++$j;
			} elsif($alloc[$j] & 1) {
				my($i) = $alloc[$j]>>1;
				my($lbl) = $lbl{$i-1};
				if($lbl=~/37$/) {
				}
				# boucle for ?
				my($c) = 0;
				while(($alloc[++$j]>>1)==$i) {++$c if ($alloc[$j]&1);}
				if($c>0) {
					push(@out, "cRPT1+$c");
					push(@out, "cJSR,$lbl<-8,$lbl&255");
					push(@out, "cNXT");
				} else {
					my($jmp) = $data[$j-1]=~/c(RTS|JMP)/?"cJMP":"cJSR";
					
					#print "ZZZZZZZZZZZZZ ",$data[$j-1] if $lbl =~ /[^\d]61$/;
					# XXX JMP si le label se termine par RTS
					push(@out, "$jmp,$lbl<-8,$lbl&255");
				}
			} else {++$j;}
		}
		
		#@lib = ("sIN: $cpt", @lib, "sOUT: $cpt");
		# adjonction de la bibliothèque
		if($out[$#out] =~ /\sset\s/) {
			splice(@out, $#out, 0, @lib);
		} else {
			my($lbl) = &tmp_lbl;
			push(@out, "cJMP,$lbl<-8,$lbl&255");
			push(@out, @lib);
			push(@out, sprintf("%-6s set    *", $lbl));
		}
		
		# elimination des jmp vers jmp
		for(my $i=0; $i<$#out; ++$i) {
			next unless $out[$i]=~/([^\s]+)\s+set\s/;
			my($l1) = "$1<-8,$1&255";
			next unless $out[$i+1]=~/cJMP,([^\s]+)<-8/;
			#	print STDERR "\n",$out[$i],"\n",$out[$i+1],"\n";
			my($l2) = "$1<-8,$1&255";
			splice(@out,$i,2,());
			#print STDERR "$l1 -> $l2";
			for($i=$#out;$i>=0;--$i) {
				$out[$i] =~ s/$l1/$l2/;
			}
		}
		
		@data = @out;
		
		my($out) = join("\n", &expand_code(split(/,/, join(',', @data[0..$#data-1]))));
		
		#open(OUT, ">out".(++$cpt));
		#print STDERR ">$cpt<";
		#print OUT $out;
		#$DBG = 1;
		#print OUT join("\n", &expand_code(split(/,/, join(',', @data[0..$#data-1]))));
		#$DBG = 0;
		#for my $s (@data) {
		#	print OUT "\tfcb\t" if $s!~/ set /;
		#	print OUT "$s\n";
		#}
		#close(OUT);
		
		my(@a) = split(/\n/, $in);
		my(@b) = split(/\n/, $out);
		
		if($#a!=$#b) {
			$DBG = 1;
			print STDERR "$in\nXXXXXXXXXXXXXXXX\n".join("\n", &expand_code(split(/,/, join(',', @data[0..$#data-1]))));
			die "$#a $#b";
		}
		for(my $i=0; $i<=$#a;++$i) {die "$i: $a[$i]!=$b[$i]" if $a[$i] ne $b[$i];}
		die "IN\n$in\nXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXxx\nOUT\n$out\n" unless $in eq $out;
	}
		
	pop(@data);
	@data = &reorg_lib(@data);
	
	#print "in: $in\n";
	#print "out: $out\n";
	
	return split(/,/, join(',', @data));
}

sub perc {
	my($perc) = @_;
	
	if($perc>0) {
		my($z) = int($perc*100);
		return if $z == $glb_perc_last;
		$glb_perc_last = $z;
	}
	
	my($t) = time;
	if($perc<=0) {
		$glb_perc_time = $t;
	} elsif($perc>=1) {
	        print STDERR " " x length($glb_perc_txt), "\b" x length($glb_perc_txt);
		undef $glb_perc_last;
		undef $glb_perc_time;
		undef $glb_perc_txt;
	} elsif($t>$glb_perc_time+30) {
		my($old) = length($glb_perc_txt);
		$glb_perc_txt = sprintf("%3d%% (%ds rem)", $perc*100, int(($t-$glb_perc_time)*(1/$perc-1)));
		my($end) = " " x ($old-length($glb_perc_txt));
		print STDERR $glb_perc_txt, $end, "\b" x (length($glb_perc_txt) + length($end));
	}
}

sub reorg_lib {
	my(@in) = @_;
	my(%lbl, %gto, $l);
	for my $i (0..$#in-1) {
		$lbl{$l=$1} = $i if $in[$i]=~/([^\s]+)\s+set/;
		$gto{$l} = $1 if defined($l) && $in[$i]=~/cJMP,(.*)<-8/;
	}
	my(%todo, @lib) = %lbl;
	for(my @t = keys %todo; $#t>=0; @t = keys %todo) {
		my($i, $maxl, $maxi);
		for $i (@t) {
			$l = 0;
			for(my $j=$i; defined($j) && $todo{$j}; $j = $gto{$j}) {++$l;}
			#print STDERR "q$i : $l\n";
			if($l>$maxl) {$maxl = $l;$maxi = $i;}
		}
		for($i = $maxi; defined($i) && $todo{$i}; $i=$gto{$i}) {
			delete $todo{$i};
			$l = $lbl{$i};
			do {
				#print STDERR $l,":",$in[$l],"\n";
				push(@lib, $in[$l]);
			} while($in[++$l]!~/c(RTS|JMP)/);
		}
		push(@lib, $in[$l]);
		#print STDERR "XXXX\n";
	}
	my($lib) = 0; while($lib<=$#in && $in[$lib++]!~/cJMP/) {}
	splice(@in, $lib, $#in-$lib, @lib);
	return @in;
}

# essai: tentative à base de LZ(W,78)
sub compress_LZ {
	my(@in) = @_;
	my(@data, @r);
	
	for my $i (&expand_code(@in[0..$#_])) {
	#for my $i (@_) {
		if(0 && $i =~ /^s\d+/ && $data[$#data] =~ /cNOISE/) {$data[$#data] .= ",$i";} 
		elsif($#data>=0 && $data[$#data]=~/cNOISE,/ && $i=~/$cNOISE/) {$data[$#data]=$i;}
		elsif($i =~ /^[scn]/ || $i =~ / set /) {push(@data, $i);}
		else {$data[$#data] .= ",$i";}
	}

	my($start) = "--START--";
	push(@data, $start);
	
	# detecte les procédures
	for(my $i=0; 0 && $i<=$#in;++$i) {
		my $s = $in[$i];
		if($s =~ /i\d+\sset\s+\*/i) {
			my(@p);
			while(($s = $in[++$i]) !~ /rts/i) {
				if($s =~ /^[scn]/) {push(@p, $s);} else {$p[$#p] .= ",$s";}
			}
			#print STDERR join(' ', @p),"\n";
			for my $j (0..$#p) {push(@data, @p[$j..$#p]);}
			push(@data, "c".rnd);
		}
	}
	
	#@data=@data[0..$#data/4];
	#push(@data, @data, @data, @data, @data);
	
	#for(my ($l,$i)=($#data,$#data-6); $i<$l; ++$i) {push(@data, @data[$i..$l]);}
	
	#return &expand_code(@_);
	
	#@data = (("sA", "sB", "sC")x20);
	
	#for my $i (@data) {
	#	print "$i\n";
	#}
	
	my($lbl) = &tmp_lbl;
	
	# 1ere etape: compression LZ
	my($w, %D, @c, @C, @L);
	$D{$w = ""} = $C[0] = 0;
	push(@c, 0, "<empty>");
	for my $i (reverse @data) {
		my $t = $w.",".$i;
		my $l = $D{$t};
		
		if(defined $l) {$w = $t;}
		else {
			#print $t,"\n";
			my $n = scalar keys %D;
			if(1 || $n<10000) {
				$L[$D{$t} = $n] = (scalar split(/,/, $t))-1;
				$C[$n] = 0;
			}
			$n = $D{$w} + 0;
			$C[$n] = 1;
			
			push(@c, $n, $i);
			$w = "";
		}
	}

	for my $i (0..$#C) {
		$C[$i] = 0 if $L[$i]<=4;
	}
	
	# TODO: mettre à jour les C[$i] via les used transitifs
	
	for my $i (0..$#c/2) {
		print sprintf("%4d\t%4d %14s (%4d) ...%d...\n", $i, $C[$i], $c[$i*2+1], $c[$i*2], $L[$i]);
	}	
	
	my($lbl, @r) = $glb_lbl; #&tmp_lbl;
	
	push(@r, "cJMP", "${lbl}_<-8", "${lbl}_&255");
	# BIBLIOTHEQUE;;; ON prend la sequence la plus longue
	my(%todo); for my $i (1..$#c/2) {$todo{$i} = 1 if $C[$i];}
	for(my @t = keys %todo; $#t>=0; @t = keys %todo) {
		my($i, $maxl, $maxi);
		for $i (@t) {
			my($l) = 0;
			for(my $j=$i; $j>0 && $todo{$j}; $j = $c[$j*2]) {++$l;}
			if($l>$maxl) {
			$maxl = $l;
				$maxi = $i;
			}
		}
		for($i = $maxi; $i>0 && $todo{$i}; $i=$c[$i*2]) {
			push(@r, sprintf("%-6s set    *", "${lbl}$i"));
			push(@r, split(/,/,$c[$i*2+1]));
			delete $todo{$i};
		}
		if($i>0) {
			if(!$C[$i]) {
				while($i>0) {
					push(@r,split(/,/,$c[$i*2+1]));
					$i = $c[$i*2];
				}
			} else {
				push(@r, "cJMP", "$lbl$i<-8", "$lbl$i&255");
			}
		}
		push(@r, "cRTS") unless $i>0;
	}
	
	push(@r, sprintf("%-6s set    *", "${lbl}_"));
	
	
	for my $i (reverse 1..$#c/2) {
		while($i>0 && $C[$i]==0) {
			push(@r,split(/,/, $c[$i*2+1]));
			$i = $c[$i*2];
		}
		push(@r, "cJSR", "$lbl$i<-8", "$lbl$i&255") if $i>0 && $C[$i];
	}
	
	
	my($z) = 0;
	for my $i (@r) {++$z unless $i=~/ set /;}
	print STDERR "lz($z)";
	
	return @r;
	&print_trk(@r);
	
	exit;
}

sub occurs {
	my($s,$l, $i,$t, $d, @r) = @_;

	while($i<$#{$t} && &pfx($s,$t->[++$i],$d)>=$l) {}
	#print "? ",join(' ', @data[$s..$s+$l-1]);
	
	while(--$i>=0 && (&pfx($s,$t->[$i],$d)>=$l)) {push(@r, $t->[$i]);};
	@r = sort {$a<=>$b} @r;
	
	#print STDERR "occurs ", join(',', @r), "\n";
	
	# remove overlapping elements
	for($i=0; $i<$#r;) {if($r[$i]+$l-1>=$r[$i+1]) {splice(@r, $i+1, 1, ());} else {++$i;}}
		
	#print "=$joint ",join(' ',@r),"\n";
	
	return (@r);
}

sub pfx {
	my($s, $t, $d) = @_;
	
	return $#{$d}+1-$s if $s==$t;
	
	#print STDERR "pfx $s,$t";
	my($i) = 0;
	while($d->[$s+$i]==$d->[$t+$i]) {++$i;}
	#print STDERR "=> $i\n";
	return $i;
}

sub by_data {
	#my($a, $b) = @_;
	my($i) = 0;
	while($data[$a+$i] eq $data[$b+$i]) {++$i;}
	return $data[$a+$i] cmp $data[$b+$i];
#	return ($i==$#data ? +1 : $j==$#data ? -1 : $data[$i] cmp $data[$j]);
}

sub valid {
	my($i, $l) = @_;
	return 0 unless $l;
	return 0 unless $data[$i]=~/^[scn]/;
	for(my $j=0; $j<$l; ++$j) {
		return 0 if $data[$j]=~/cNXT/;
		last if $data[$j]=~/cRPT/;
	}
	return 1;
}

sub compress_track_aux {
	my(@track) = @_;
	my(@compr);
	
	return @_ if 0;
	
	my($len) = $#track;
	my($i, $k, $p, $n, $m, $t, $g);
	
	# optim. carte chaine => liste d'occurrence
	my(%occur);
	for($i=0; $i<=$len; ++$i) {
		my($s) = $track[$i];
		my($l) = $occur{$s};
		$occur{$s} = $l = [] unless defined $l;
		push(@$l, $i);
	}
	
	# compression
	for($i=0; $i<=$len;) {
		$n = 0; $g = 0;
		$m = ($len-$i)>>1;
		
		if(1) {
			# optimized way about 50% faster
			my($l) = $occur{$track[$i]};
			do {$k = shift(@$l);} while($k!=$i && @$l);
			#print $track[$i]," ",$i,"=>", join(',', @$l), "\n";
			for $k (@$l) {
				last if $k-$i>$m;
				$t = &compress_rep_count($i, $k-$i, \@track);
				#print "rep=$t ", $k-$i, "\n" if $t;
				my($gg) = $t*($k-$i); #push(@compr, "=$gg i=$i t=$t l=".($k-$i));
				if($gg>$g && $t<64) {$g = $gg; $n = $t; $p = $k-$i;}
				#print $n, " => ", $p, "\n";
			}
		} else {
			for($k=1; $k<=$m; ++$k) {
				$t = &compress_rep_count($i, $k, \@track);
				if($t>=$n && $t<64) {$n = $t; $p = $k;}
			}
		}
		
		#print "i=$i n=$n p=$p ", join(',', @track[$i .. $i+$p-1]), "\n" if $n>0;
		if($n>0 && $p>3 || $n>2 || $n*$p>2) {
			#print "*\n";
			push(@compr, "cRPT1+$n", @track[$i .. $i+$p-1], "cNXT");
			$i += $p*($n+1);
		} else {
			push(@compr, $track[$i++]);
		}
	}
	#print "in: ", $#track, " out: ", $#compr, "\n";
	
	return @compr;
}

sub compress_rep_count {
	my($i, $l, $tab) = @_;
	#print "$i ($l) -->";
	my($s, $m, $e) = ($i, $#{$tab}, 1);
	return 0 if $tab->[$i]=~/^[0-9]+/;
	while($i+$l<=$m && $tab->[$i] eq $tab->[$i+$l]) {
		$e = 0 if $tab->[$i] =~ /cRPT1/;
		last if $e && $tab->[$i] =~ /cNXT/;
		++$i;
	}
	#print "$i ", $tab->[$i],"!=",$tab->[$i+$l], "\n";
	return int(($i-$s)/$l);
}

# traduit une duree
sub convert_duree {
	my($duree) = @_;

	my($d, @r);
	
	my($z, $Z) = 10000;
	
	#print "duree=$duree : ";
	for $d (@glb_duree) {
		my($t) = $duree - $d;
		$t = -$t if $t<0;
		if($t < $z) {
			$z = $t;
			$Z = $d;
		}
	}
	
	$last_off = 0;
#	return () if  $last_duree == $Z;
#	$last_duree = $Z;
	print "over: $z\n" if $z & 0;
	return ("$glb_duree{$Z}");
}

# traduit une duree
sub convert_duree_orig {
	my($note, $duree) = @_;
	my($d, @r);
	
	return @r if $duree<$glb_min_duree;
	
	#print "duree=$duree : ";
	do {
		for $d (@glb_duree) {
			if($duree>=$d) {
				$duree -= $d;
				push(@r, "$note+$glb_duree{$d}");
				last;
			}
		}
	} while(1 && $duree>=$glb_min_duree);
	
	return @r;
}

# initialise les variables globales
sub init_globals {
	my($i, $o, $n) = 12;
	
	# construction du mapping des notes midi -> format track
	%glb_note = ();
	foreach $o (0 .. 7) {
		foreach $n ("C", "Cs", "D", "Ds", "E", "F", "Fs", "G", "Gs", "A", "As", "B") {
			$glb_note{++$i} = "$n$o";
		}
	}
	$glb_max_note = $i;
	$glb_max_freq = &freq($i);
	
	%glb_duree = (
	0b11110000 => "s1ddd",
	0b11100000 => "s1dd",
	0b11000000 => "s1d",
	0b10000000 => "s1",
	0b01111000 => "s2ddd",
	0b01110000 => "s2dd",
	0b01100000 => "s2d",
	0b01000000 => "s2",
	0b00111100 => "s4ddd",
	0b00111000 => "s4dd",
	0b00110000 => "s4d",
	0b00100000 => "s4",
	0b00011110 => "s8ddd",
	0b00011100 => "s8dd",
	0b00011000 => "s8d",
	0b00010000 => "s8",
	0b00001111 => "s16ddd",
	0b00001110 => "s16dd",
	0b00001100 => "s16d",
	0b00001000 => "s16",
	0b00000111 => "s32dd",
	0b00000110 => "s32d",
	0b00000100 => "s32",
	0b00000011 => "s64d",
	0b00000010 => "s64",
	0b00000001 => "s128");
	@glb_duree = (sort {$b <=> $a} keys %glb_duree); # valeur décroissante
	$glb_max_duree = $glb_duree[0];
	$glb_max_code  = $glb_duree{$glb_max_duree};
	$glb_min_duree = $glb_duree[$#glb_duree];
}

# tous les instruments doivent être entre C1(24) et C5(72)
sub norm_inst {
	my(@trk) = @_;
	
	my($C1, $C5) = (25, 72);
	my($nMIN, $nMAX) = ($C1, $C5);
	
	if(!defined $glb_pitch) {
		my($n, $m, $NUM);
		
		for($n=0; $n<9*12; $n+=12) {
			my(%num);
			for $t (@trk) {
				my ($next, $chl, $key, $vol) = @{$t};
				next if $key<0 || ($glb_noise && $chl==9);
				$key += $n;
				$num{$chl} = 1 if $key<$nMIN || $key>$nMAX;
			}
			my($num) = scalar keys %num;
			if($n==0 || $num < $NUM) {$NUM = $num; $m = $n;}
		}
		for($n=0; ($n-=12)>-9*12;) {
			my(%num);
			for $t (@trk) {
				my ($next, $chl, $key, $vol) = @{$t};
				next if $key<0 || ($glb_noise && $chl==9);
				$key += $n;
				$num{$chl} = 1 if $key<$nMIN || $key>$nMAX;
			}
			my($num) = scalar keys %num;
			if($n==0 || $num <= $NUM) {$NUM = $num; $m = $n;}
		}
		print STDERR "Pitch-corr : $m (", $NUM, ")\n";
		if($m) {
			for $t (@trk) {
				my ($next, $chl, $key, $vol) = @{$t};
				next if ($glb_noise && $chl==9);
				$t->[2] = (abs($key)+$m)*($key<0?-1:1);
			}
		}
	}
	
	my(%min, %max, $t, $k);	
	for $t (@trk) {
		my ($next, $chl, $key, $vol) = @{$t};
		next if $key<0 || ($glb_noise && $chl==9);
		$min{$chl} = $key if !defined($min{$chl}) || $min{$chl}>$key;
		$max{$chl} = $key if $max{$chl}<$key;
	}

	my(%shift);
	for $k (keys %min) {
		my($min, $max) = ($min{$k}, $max{$k});
		print STDERR sprintf("%2d =%3d -> %-2d : ", $k, $min{$k}, $max{$k});
		
		if($min>=$nMIN && $max<=$nMAX) {
			print STDERR "ok\n";
		}
		
		if($min<$nMIN) {
			my($t);
			for($t=12;$min+$t<$nMIN; $t+=12) {}
			if($max+$t>$nMAX) {print STDERR "ko\n"; next;}
			else              {$shift{$k} = $t; print STDERR "+$t\n";}
		}
		if($max>$nMAX) {
			my($t);
			for($t=12;$max-$t>$nMAX; $t+=12) {}
			if($min-$t<$nMIN) {print STDERR "ko\n"; next;}
			else              {$shift{$k} = -$t; print STDERR "-$t\n";}
		}
	}

	for $t (@trk) {
		my ($next, $chl, $key, $vol) = @{$t};
		next if ($glb_noise && $chl==9);
		my($sgn) = $key<0?-1:1;
		$t->[2] = abs($key);
		if($shift{$chl}) {
			$t->[2] += $shift{$chl};
		} else {
			while($t->[2]<$nMIN) {$t->[2] += 12;}
			while($t->[2]>$nMAX) {$t->[2] -= 12;}
		}
		$t->[2] *= $sgn;
	}
	
	return @trk;
}

# change les BPM 
sub norm_bpm {
	my(@trk) = @_;
	my($MAX) = 60000000/32/$glb_period/16;
	my($MIN) = 60000000/32/$glb_period/256;
	
	my($t, $max, $min);
	$min = $MAX;
	foreach $t (values %glb_bpm) {
		$max = $t if $t>$max;
		$min = $t if $t<$min;
	}
	print STDERR "BPM=",$min,"...",$max;
	
	my($scale) = 1;
	
	if($min<$MIN) {
		$scale = int($MIN/$min);
		$scale = int($MAX/$max) if $scale<int($MAX/$max);
		$scale = $MIN/$min if $scale==1;
	} elsif($max>$MAX) {
		$scale = 1/int($max/$MAX);
		$scale = $MAX/$max if $scale==1;
	} elsif($max<$MAX) {
		$scale = int($MAX/$max);
		$scale = $MAX/$max if $scale==1;
	} 
	if($scale!=1) {
		my(%t);
		print STDERR " x",$scale,"...";
		#$glb_ticks_per_note = int($glb_ticks_per_note*$scale);
		for $t (keys %glb_bpm) {
			$t{int($t*$scale)} = int($glb_bpm{$t}*$scale);
		}
		%glb_bpm = %t;
		for $t (@trk) {
			$t->[0] = int($t->[0]*$scale);
		}		
		print STDERR " done\n";
		
	} else {
		print STDERR "unchanged\n";
	}
	return @trk;
}

# lit un fichier midi
# retourne
# $glb_ticks_per_note = nb de ticks midi pour une noire
# %glb_tempo = map temps-midi -> tempo
# @glb_tracks = pistes 
sub read_midi {
	my($name) = @_;
	
	print STDERR "File       : ", $name, "\n";

	# open file
	open(MIDI, $midi_file=$name) || die "$name: $!, stopped";
	binmode(MIDI);

	# verif signature en-tete
	($_=&read_str(4)) eq "MThd" || die "$name: bad header ($_), stopped";
	($_=&read_long) == 6 || die "$name: bad header length ($_), stopped";

	# lecture en-tete
	my($format) = &read_short;
	my($tracks) = &read_short;
	my($delta)  = &read_short;

	print STDERR "FormatType : ", $format, "\n";
	print STDERR "#Tracks    : ", $tracks, "\n";
	print STDERR "Noire      : ", $delta, " ticks\n";
	
	$glb_ticks_per_note = $delta;

	%glb_bpm = ();
	$glb_bpm{0} = 120; # default value
	my($no, @trk);
	for($no=1; $no<=$tracks; ++$no) {
		push(@trk, &read_track($name, $no));
	}
	close(MIDI);
	
	@trk = (sort by_time @trk);
	#&dump_midi(@trk);

	return @trk;
}

# lit une piste
sub read_track {
	my($name, $no) = @_;
	my(@track);
	
	my($z);
	($z=&read_str(4)) eq "MTrk" || die "$name: Reading track $no: bad chunk ($z), stopped";
	my($size) = &read_long(1);

	my($time) = 0;
	my($meta_event, $event) = 0;
	do {
		$time += &read_vlv;
		my($timr) = &timeround($time);
		
		$_ = &read_byte;
		if($_>=0x80) {
			$event = $_;
		} else {
			seek(MIDI, -1, 1);
		}
				
		if(&between($event, 0x80, 0x8f)) {
			# note off
			my $ch   = $event & 0xf;
			my $note = &read_byte & 0x7f;
			my $vol  = &read_byte & 0x7f;
			if (!$glb_tracks{$ch+1}) {
				$note += $glb_pitch unless $glb_noise && $ch==9;
				push(@track, [$timr, $ch, -$note-1, $vol]);
			}
		}
		if(&between($event, 0x90, 0x9f)) {
			# note on
			my $ch   = $event & 0xf;
			my $note = &read_byte & 0x7f;
			my $vol  = &read_byte & 0x7f;
			if(!$glb_tracks{$ch+1}) {
				$note += $glb_pitch unless $glb_noise && $ch==9;
				push(@track, [$timr, $ch,  $note+1, $vol]) if $vol>0;
				push(@track, [$timr, $ch, -$note-1, $vol]) if $vol==0;
			}
		}
		if(&between($event, 0xa0, 0xbf) || 
		   &between($event, 0xe0, 0xef) ||
		   $event == 0xf2) {&read_short;}
		if(&between($event, 0xc0, 0xdf) || 
		   $event == 0xf1 ||
		   $event == 0xf2) {&read_byte;}
		if($event == 0xff) {
			$meta_event = &read_byte;
			my $size = &read_vlv;
			if($meta_event == 0x51) {
				# set tempo
				die "bad tempo ($size)" unless $size == 3;
				my $tempo = 0; # µS par noire
				while($size--) {$tempo = ($tempo<<8) + &read_byte;}
				$glb_bpm{$timr} = int(60000000/$tempo);
			} else {
				&read_str($size);
			}
		}
	} while($event != 0xff || $meta_event != 0x2f);
	return (@track);
}

# arrondi le temps en ticks thomson
sub timeround {
	my($t) = @_;
	my($div) = $glb_ticks_per_note/0b00100000;
	return int(int($t/$div+0.5)*$div);
}

# conversion temps midi en tick thomson
sub time2tick {
	my($t) = @_;
	return int(($t*0b00100000)/$glb_ticks_per_note+0.5);
}

sub time2tick_n {
	my($t) = @_;
	return 0 unless $t;
	$t = int(($t*0b00100000)/$glb_ticks_per_note+0.5);
	$t = $glb_min_duree if $t<$glb_min_duree;
	return $t;
}

# affiche une ligne de note à l'écran
sub flush_line {
	print "       fcb    $glb_line\n" if length($glb_line)>0;
	$glb_line = "";
}

# ajoute une note à la ligne courante
sub add_note {
	my($note) = @_;
	return if length($note)==0;
	
	if($note=~/^c/ && $note!~/^cNXT/) {
		&flush_line;
		$glb_line = $note;
		#&flush_line;
		return;
	}
	
	if($note=~/ (set|fcb|fdb) /) {
		&flush_line;
		print "$note\n";
		return;
	}
	
	my($len) = length($glb_line);
	
	++$len if $len>0;
	$len += length($note);
	
	&flush_line if $len>=40-16;
	
	$glb_line .= "," if length($glb_line)>0;
	$glb_line .= $note;
	
	&flush_line if $note=~/c(NXT|RTS)/;
}

# affiche une piste midi à l'écran
sub dump_midi {
	my($t, $tm);
	for $t (@_) {
		my($time,$trk,$note,$vol) = @$t;
		print "(",$time-$tm,")\n";
		print sprintf("%-6d %2d %3d *%-3d", $time, $trk, $note, $vol);
		$tm = $time;
	}
	print "\n";
}

# compare les index temporels des pistes
sub cmp_trk {
	return $a->[0] <=> $b->[0];
}

# test si un valeur tombe dans un intervale
sub between {
	return $_[1] <= $_[0] && $_[0] <= $_[2];
}

# lit une chaine de n caractères depuis le fichier midi
sub read_str {
	my($t, $l);
	($l=read(MIDI, $t, $_[0]))==$_[0] || die "$midi_file: read $l when $_[0] expected: $!, stopped";
	return $t;
}

# lit 1 octet (8bits)
sub read_byte {
	return unpack("C*", &read_str(1));
}

# lit un short (16bits)	
sub read_short {
	my($a, $b) = (&read_byte, &read_byte);
	return $a*256+$b;
}

# lit un long (32bits)
sub read_long {
	my($a, $b) = (&read_short, &read_short);
	return $a*65536+$b;
}

# lit un nombre de longueur variable
sub read_vlv {
	my($n, $s, $t) = (0,0,0);
	do {
		$t = &read_byte;
		$n <<= 7; $n |= $t & 0x7f;
	} while($t & 0x80);
	return $n;
}
Il prends un fichier MIDI en argument et produit le code ASM de la partition. Il y a divers options
  • -d pour émuler les "drums" (recommandé)
  • -i pour ne garder qu'une seule note par instrument à chaque instant (recommandé)
  • -x n1,n2,n3,... pour exclure certaines pistes
  • -p n pour modifier le pitch du morceau
  • -n n pour changer le nombre de notes en parallèle (au delà de 2 il introduit des asperges, oops des arpèges :mrgreen: ).
Samuel.
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
Avatar de l’utilisateur
farvardin
Messages : 436
Inscription : 27 déc. 2014 16:07
Contact :

Re: Player de fichiers midi sur Thomson

Message par farvardin »

Merci pour ça.
Voici ce que j'ai réussi à faire :
- convertir un petit midi de 2 mesure en asm avec le script perl.
- installer un assembleur assembleur-6809-v3_memo7.rom dans dcmoto
- envoyer le fichier asm dans une fichier .fd avec le logiciel dcfdutil

seulement, l'assembleur refuse de lire mon fichier .asm, en effet, si j'exporte ceux de la disquette, l'encodage est un peu spécial :

Code : Tout sélectionner

Song
*ñsmb1-Theme
øfcbõcTEMPO,37
øfcbõcVOL1,32
øfcbõn1Fs3
de plus, si j'exporte puis réimporte les fichiers d'exemple, l'assembleur refuse également de les lire (ça indique "bad file"), peut-être parce que j'utilise dcfdutil depuis linux ? En tout cas je peux lire, visualiser et éditer la disquette d'origine (par exemple mv.asm)

Il y a quelque chose que l'on peut faire pour avoir le bon encodage ? si j'ouvre un fichier exporté ça me dit que c'est au format mac / iso8859 mais ça ne suffit pas.
__sam__
Messages : 7987
Inscription : 18 sept. 2010 12:08
Localisation : Brest et parfois les Flandres

Re: Player de fichiers midi sur Thomson

Message par __sam__ »

en fait c'est pas comme ca que je fais. Le fichier ASM est pour l'assembleur v1 ou v2 (les tabulation sont encodés dans un bit du caractère suivant. C'était une époque ou la ram était rare).

J'utilise le script avec "perl conv_midi.pl -d -i fichier.midi > musique.txt", ensuite j'ouvre un editeur text avec musique.txt, puis avec le fichier "mv.ass" suivant:

Code : Tout sélectionner

(main)MV
***************************************
* Son 2 voix + bruit en utilisant le
* timer
*
* Auteur: S.Devulder
* Date:   Avril 2013
***************************************
	
       org    $8000
       
PULSE  set    0
       
STATUS equ    $6019
TIMEPT equ    $6027

* 6848
CRC    equ    $E7C1  ; ctrl port C
DDRC   equ    $E7C2  ; sens port C
PRC    equ    $E7C3  ; data port C

TCR    equ    $E7C5  ; reg cont timer
TMSB   equ    $E7C6  ; compteur timer

* 6821 musique et jeux
PRA    equ    $E7CC  ; data port A
PRB    equ    $E7CD  ; data port B
CRA    equ    $E7CE  ; ctrl port A
CRB    equ    $E7CF  ; ctrl port B

***************************************
* Alignement
***************************************
ALIGN  macro
       org    ((*+\0-1)/\0)*\0
       endm

***************************************
* boucle:
*      REPEAT
*      ....
*      WHILE  condition
***************************************
REPEAT macro
loop   set    *
       endm
WHILE  macro
       b\0    loop
       endm
	
***************************************
* variable dans code auto-modifiable
*
*      VAR1   opcode,val,label ;8 bits
*      VAR2   opcode,val,label ;16 bits
***************************************
VAR1   macro
       \0     \1
\2     set    *-1
       endm
VAR2   macro
       \0     \1
\2     set    *-2
       endm
       
***************************************
* Point d'entree
***************************************
ini    jsr    $E800
       ldb    #12
       jsr    $E803
       ldb    #$14
       jsr    $E803
       ldb    #$1B
       jsr    $E803
       ldb    #$68
       jsr    $E803
       setdp  SndInt<-8
       lda    #SndInt<-8
       tfr    a,dp
***************************************
* Initialise la gestion du son.
* D pointe sur la musique
***************************************
       orcc   #$50

* 8 interrupts timer pour DO 4
* (octave du LA 440)      
       ldd    #478
       std    TMSB
       lda    #$42
       sta    TCR
  
* Init musique et jeux
       ldd    #$043F
       clr    CRB
       stb    PRB
       sta    CRB
       stb    PRB     ; volume full

* autorisation interrupt timer       
       ldd    #SndInt ; intr timer
       std    TIMEPT
       lda    #32
       ora    STATUS
       sta    STATUS

* TO7: buzzer clavier off
       sta    $6073
       
* Memoire forme
       lda    PRC
       ora    #1
       sta    PRC       

* interruptions ON       
       andcc  #255-$50 ; int. on

       REPEAT
       bsr    wait
       WHILE  ra
       
       swi
       
wait   ldx    #prec
       ldd    #$4000+199*40
       REPEAT
       std    ,x++
       subd   #40
       cmpx   #prec+64*2
       WHILE  ne

       ldu    #buf
       ldx    #$4000+199*40
       clra
       clrb
       REPEAT
       com   ,x+
       std   ,u++
       std   ,u++
       std   ,u++
       std   ,u++
       cmpu  #buf+320
       WHILE ne       
       
       ldu    #buf
       ldy    #prec
       lda    #$80
       REPEAT
       sta    ,-s
       lda    ,u
       lsla
       ldx    a,y
       lda    ,s
       eora   b,x
       sta    b,x
*       lda    PRB
*       anda   #63
       lda    samp
       if     1
       adda   ,u
       adda   ,u
       adda   ,u
       rora
       lsra
       endc
       if     0
       adda   ,u
       adda   ,u
       adda   ,u
       adda   ,u
       adda   ,u
       adda   ,u
       adda   ,u
       rora
       lsra
       lsra
       endc
       if     0
       adda   ,u
       lsra
       endc
       sta    ,u+
       lsla
       ldx    a,y
       lda    ,s
       eora   b,x
       sta    b,x
       lda    ,s+
       lsra
       WHILE  cc
       rora
       incb
       cmpb   #40
       WHILE  ne
       clrb
       ldu    #buf
       WHILE  ra
       
waitx3   ldx    #prec
       ldd    #$8000
       REPEAT
       std    ,x++
       lsra
       WHILE  cc
       rora
       incb
       cmpb   #9
       WHILE  ne
       
       ldu    #buf
       ldx    #$4000+17
       REPEAT
       clr    ,u+
       lda    ,x
       eora   #128
       sta    ,x
       leax   40,x
       cmpx   #$5F40+17
       WHILE  lt
       
       ldy    #prec
aaa    ldu    #buf
       ldx    #$4000+17
       REPEAT
       ldb    ,u
       lslb
       ldd    b,y
*       eora   b,x
*       sta    b,x
       clr    b,x
       ldb    PRB
       andb   #63
       addb   ,u
       addb   ,u
       addb   ,u
       lsrb
       lsrb
       stb    ,u+
       lslb
       ldd    b,y
*       eora   b,x
       sta    b,x
       leax   40,x

       cmpx   #$4000+40*200+17
       WHILE  ne
       bra    aaa  

prec   rmb    2*64       
       
waitx2   ldx    #buf+320
       ldy    #$4000+32*40+40
       
       REPEAT
       com    ,-y
       cmpy   #$4000+32*40
       WHILE  ne
     
       REPEAT
       clr    ,-x
       cmpx   #buf
       WHILE  ne
     
       lda    #128       
       REPEAT
       pshs   a,y
       lda    #40
       ldb    ,x
       mul
       leay   d,y
       lda    ,s
       eora   ,y
       sta    ,y
       ldb    PRB
       andb   #63
       stb    ,x+
       lda    #40
       mul
       addd   1,s
       tfr    d,y
       lda    ,s
       eora   ,y
       sta    ,y
       puls   a,y
       rora
       WHILE  ne
       rora
       leay   1,y
       cmpx   #buf+320
       WHILE  ne
       ldx    #buf
       leay   -40,y
       WHILE  ra
       
hex2   pshs   d
       bsr    hex
       lda    1,s
       bsr    hex
       puls   d,pc      
hex    pshs   d,x
       ldx    #hextab
       tfr    a,b
       lsrb
       lsrb
       lsrb
       lsrb
       ldb    b,x
       bsr    putc
       tfr    a,b
       andb   #15
       ldb    b,x
       bra    putc+2
putc   pshs   d,x
       ldx    $60CF
       subb   #32
       lda    #8
       mul
       leax   d,x
       ldd    ,x
       sta    160,y
       stb    120,y
       ldd    2,x
       sta    80,y
       stb    40,y
       ldd    4,x
       sta    ,y+
       stb    -41,y
       ldd    6,x
       sta    -81,y
       stb    -121,y
       puls   d,x,pc
       
puts2  bsr    putc
puts   ldb    ,u+
       bne    puts2
       rts
       
waitx  pshs   d,x,y,u
       ldy    #$4000+120
       ldu    #prntab
     
       bsr    puts
       lda    <frq1
       bsr    hex

       bsr    puts
       lda    <frq2
       bsr    hex
       
       bsr    puts
       lda    <noise
       bsr    hex
       
       bsr    puts
       ldd    <SongPtr
       bsr    hex2
       
       ldx    #50
       REPEAT
       VAR2   ldd,#0,coord
       bsr    plot
       bsr    move
       std    coord
       jsr    $E809
       bcc    wait2  
       jsr    $E806
       cmpb   #3
       beq    reset
       cmpb   #32
       beq    wait1
wait2  leax   -1,x
       WHILE  ne
           
wait1  puls   x,y,u,d,pc       
reset  jmp    [$FFFE]       

plot   pshs   x,d
       lda    #40
       mul
       addd   #$4000+4*40+8*40
       tfr    d,x
       ldb    ,s
       abx
       com    -160,x
       com    -120,x
       com    -80,x
       com    -40,x
       com    ,x
       com    40,x
       com    80,x
       com    120,x       
       puls   x,d,pc
       
move   set    *
       VAR1   adda,#1,dir1
       cmpa   #39       
       bls    move2
       neg    dir1
       adda   dir1
       adda   dir1
move2  set    *
       VAR1   addb,#8,dir2
       cmpb   #200-40
       bls    move3
       neg    dir2
       addb   dir2
       addb   dir2
move3  rts
hextab fcc    /0123456789ABCDEF/       
prntab fcc    /F0=/
       fcb    0
       fcc    / F1=/
       fcb    0
       fcc    / NS=/
       fcb    0
       fcc    / ADR=/
       fcb    0
       
buf    rmb    320

***************************************
* Interruption timer
***************************************  
       ALIGN  256
       setdp  $E7
SndInt set    *
       VAR1   ldd,#*,samp
       stb    <PRB
       ldb    <TMSB
       setdp  *<-8
       tfr    a,dp
       dec    <tick
       bne    doSnd
       VAR1   ldb,#1,tckval
       stb    <tick
       dec    <tempo
       beq    Cmd
doSnd  set    *       
       VAR1   ldb,#0,noise
       beq    sndnor
* bruit: il est prioritaire sur
* le son normal.      
       lsrb
       bne    bruit
       VAR2   ldd,#$03F9,seed1
       mul
       VAR2   addd,#0,seed2
       sta    <seed2+1
       stb    <seed1
       coma
       rorb
bruit  stb    <noise
       ldb    #0     ; /!\ pas de clr
       sbcb   #0
       VAR1   andb,#63,vol3
* bruit interruptif: (stop le son)
*       bra    sndn3
* son normal       
sndnor set    *
       VAR1   lda,#0,frq1
       VAR1   adda,#0,osc1
       sta    <osc1
       ifne   PULSE
       bcc    sndn2
       else
       bpl    sndn2
       endc
       VAR1   addb,#31,vol1
sndn2  set    *
       VAR1   lda,#0,frq2
       VAR1   adda,#0,osc2
       sta    <osc2
       ifne   PULSE
       bcc    sndn3
       else
       bpl    sndn3
       endc
       VAR1   addb,#31,vol2
sndn3
       addb   <samp
       lsrb      
       stb    <samp
/
       lda    #3
       mul
       addb   <samp
       lsrb
       lsrb
       stb    <samp
/       
       rti
tick   fcb    1
tempo  fcb    1
***************************************
* Commandes
* %1yxxxxxx y=canal x=note
* %01xxxxxx RPT1+
* %001xxxxx x=duree simple
* %000xxxxx extra cmd
*     00000 NOISE
*     00001 BPM
*     00010 VOL0
*     00011 VOL1
*     00100 GOTO
*     00101 CALL
*     00110 RETURN
*     00111 DELAY (extended)
*     xxyyy END
***************************************
Cmd    set    *
       VAR2   ldu,#Song,SongPtr
NxtCmd 
       ldb    ,u+
       bmi    CmdFRQ
       beq    CmdNSE
       bitb   #%01000000
       bne    CmdRPT
       bitb   #%00100000
       bne    CmdDLY
       cmpb   #%00001000
       bge    CmdEnd
       lslb
       ldx    #CmdXTR-2
       jmp    [b,x]
CmdEnd ldb    STATUS
       andb   #255-32
       stb    STATUS
       clr    <noise
       clr    <frq1
       clr    <frq2
       bra    doSnd
***************************************
* %001xxxxx DUREE (simple)
***************************************
CmdDLY stu    <SongPtr
       ldx    #tabtck-%00100000
       ldb    b,x
CmdDL1 stb    <tempo
       bra    doSnd
***************************************
* %1yxxxxxx NOTE
***************************************
CmdFRQ subb   #%01000000
       bmi    CmdFR1
       ldx    #tabfrq-%01000000
       ldb    b,x
       stb    <frq1
       bra    NxtCmd
CmdFR1 ldx    #tabfrq+%10000000
       ldb    b,x
       stb    <frq2
       bra    NxtCmd
***************************************
* %01xxxxxx RPT 1+xxxxxx
***************************************
CmdRPT set    *
       VAR2   ldx,#fortab,RPTSTK
       andb   #%00111111
       bne    CmdRP3
       dec    ,x
       beq    CmdRP2
       ldu    1,x
       bra    NxtCmd
CmdRP2 leax   3,x 
CmdRP1 stx    <RPTSTK
       bra    NxtCmd
CmdRP3 leax   -3,x
       incb
       stb    ,x
       stu    1,x
       bra    CmdRP1
***************************************
*     00001 BPM
***************************************
CmdBPM ldb    ,u+
       stb    <tckval
       stb    <tick
       bra    NxtCmd
***************************************
*     00100 GOTO
***************************************
CmdGTO ldu    ,u
       bra    NxtCmd
***************************************
*     00111 DELAY (extended)
***************************************
CmdPSE ldb    ,u+
       bra    CmdDL1
***************************************
*     00000 NOISE
***************************************
CmdNSE ldb    ,u+
       beq    CmdNS2
       tst    <noise
       bne    CmdNS1
       inc    <noise
       bra    CmdNS1
CmdNS2 stb    <noise
CmdNS1 stb    <vol3
       jmp    <NxtCmd      
***************************************
*     00010 VOL0
***************************************
CmdVL0 ldb    ,u+
       stb    <vol1
       jmp    <NxtCmd
***************************************
*     00011 VOL1
***************************************
CmdVL1 ldb    ,u+
       stb    <vol2
       jmp    <NxtCmd
***************************************
*     00110 RETURN
***************************************
CmdRTS set    *
       VAR2   ldx,#caltab,CalPtr
       ldu    ,x++
       stx    <CalPtr
       jmp    <NxtCmd
***************************************
*     00101 CALL
***************************************
CmdJSR ldx    <CalPtr
       leau   2,u
       stu    ,--x
       stx    <CalPtr       
       ldu    -2,u
       jmp    <NxtCmd
***************************************
* Tableau des commandes supplementaires
***************************************
CmdXTR fdb    CmdBPM	;1001
       fdb    CmdVL0	;1010
       fdb    CmdVL1	;1011
       fdb    CmdGTO	;1100
       fdb    CmdJSR	;1101
       fdb    CmdRTS	;1110
       fdb    CmdPSE    ;1111   
       
***************************************
* Commandes
***************************************
cRPT1  set    %01000000
cNXT   set    cRPT1+0
cNOISE set    %00000000
cTEMPO set    %00000001
cVOL0  set    %00000010
cVOL1  set    %00000011
cJMP   set    %00000100
cJSR   set    %00000101
cRTS   set    %00000110
cDELAY set    %00000111
cEND   set    %00001000


***************************************
* Speed (001x xxxx)
* Durees simples = nb de ticks.
* le tick est 1/32 de noire
***************************************
TICKsi set    %00100000
TICKS  macro
\1     equ    TICKsi
TICKsi set    TICKsi+1
       fcb    \0
       endm
tabtck set   *
       TICKS %10000000,s1    ; ronde
       TICKS %11000000,s1d   ; .
       TICKS %11100000,s1dd  ; ..
       TICKS %11110000,s1ddd ; ...
       TICKS %01000000,s2    ; blanc
       TICKS %01100000,s2d   ; .
       TICKS %01110000,s2dd  ; ..
       TICKS %01111000,s2ddd ; ...
       TICKS %00100000,s4    ; noire
       TICKS %00110000,s4d   ; .
       TICKS %00111000,s4dd  ; ..
       TICKS %00111100,s4ddd ; ...
       TICKS %00010000,s8    ; croche
       TICKS %00011000,s8d   ; .
       TICKS %00011100,s8dd  ; ..
       TICKS %00011110,s8ddd ; ...
       TICKS %00001000,s16   ; 2croch
       TICKS %00001100,s16d  ; .
       TICKS %00001110,s16dd ; ..
       TICKS %00001111,s16ddd
       TICKS %00000100,s32   ; 4croch
       TICKS %00000110,s32d  ; .
       TICKS %00000111,s32dd ; ..
       TICKS %00000010,s64   ; 8croc
       TICKS %00000011,s64d  ; .
       TICKS %00000001,s128  ; 16croc       
       
***************************************
* Definition des notes
***************************************
* DO     set    128
* RE     set    9*DO/8
* MI     set    10*DO/8
* FA     set    4*DO/3
* SOL    set    12*DO/8
* LA     set    5*DO/3
* SI     set    15*DO/8

n0P    set    %10000000
n1P    set    %11000000

* Game temperee
nC     set    128  ; do
nCs    set    136  ; do#
nD     set    144  ; re
nDs    set    152  ; re#
nE     set    161  ; mi
nF     set    171  ; fa
nFs    set    181  ; fa#
nG     set    192  ; sol
nGs    set    203  ; sol#
nA     set    215  ; la
nAs    set    228  ; la#
nB     set    242  ; si

       ifne   0
* Gamme naturelle (diminuee)
nCs    set    nC*16/15
nD     set    nC*9/8
nDs    set    nC*6/5
nE     set    nC*5/4
nF     set    nC*4/3
nFs    set    nC*64/45
nG     set    nC*3/2
nGs    set    nC*8/5
nA     set    nC*5/3
nAs    set    nC*9/5
nB     set    nC*15/8
       endc

       ifne   0
* Gamme naturelle (augmentee)
nCs    set    nC*25/24
nDs    set    nC*75/64
nFs    set    nC*45/32
nGs    set    nC*25/16
nAs    set    nC*225/128
       endc

iOCTAV set    1
NOTE   macro
n0\0\1 equ    iOCTAV+n0P
n1\0\1 equ    iOCTAV+n1P
iOCTAV set    iOCTAV+1
iOCT   set    1<+(4-\1)
       fcb    ((n\0+iOCT)<-(5-\1))
       endm

OCTAVE macro
       NOTE   C,\0
       NOTE   Cs,\0
       NOTE   D,\0
       NOTE   Ds,\0
       NOTE   E,\0
       NOTE   F,\0
       NOTE   Fs,\0
       NOTE   G,\0
       NOTE   Gs,\0
       NOTE   A,\0
       NOTE   As,\0
       NOTE   B,\0
       endm

tabfrq fcb    0       
       OCTAVE 1
       OCTAVE 2
       OCTAVE 3
       OCTAVE 4
       NOTE   C,5
*       OCTAVE 5

***************************************
* Tableaux des boucles
***************************************
       rmb    3*4
fortab set    *

***************************************
* Pile des morceaux
***************************************
       rmb    2*80
caltab set    * 

***************************************
* Inclusion musique
***************************************
       includ SONG.ASM
       end    ini
(include)SONG.ASM
***************************************
* musique
***************************************
Song
* inserer ici la musique

* attente puis rebouclage
       fcb    s1,s1,s1,s1	
       fcb    cJMP,Song<-8,Song&255
       
       end    ini
Je copie colle le fichier musique.txt au niveau du commentaire "* inserer ici la musique" après le label Song vers la fin du fichier. Enfin je lance c6809 avec

Code : Tout sélectionner

c6809.exe -c -bh -am -oOP mv.ass MV.BIN
et la je récupère tout un tas de fichiers: les *.asm, un code.lst, mais surtout "MV.BIN" (mv pour multivoix au fait) que je mets sur d7 virtuelle pour écouter sous émulateur. Pfew! (c'est pas de la tarte)
Samuel.
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
Avatar de l’utilisateur
farvardin
Messages : 436
Inscription : 27 déc. 2014 16:07
Contact :

Re: Player de fichiers midi sur Thomson

Message par farvardin »

ah mais c'est génial ! En cross-compilation c'est plus facile finalement.
J'ai réessayé avec mon petit morceau de 2 mesures, et ça fonctionne très bien. Je fignole un peu ça et je le posterai ce soir. Merci.
Avatar de l’utilisateur
farvardin
Messages : 436
Inscription : 27 déc. 2014 16:07
Contact :

Re: Player de fichiers midi sur Thomson

Message par farvardin »

bon, ce n'est pas aussi bien que j'espérais, mais c'est un début... (en pièce jointe).
Ça va assez vite à compiler avec un petit script qui assemble automatiquement la musique dans le fichier mv.ass et lance ensuite c6809.
Ce qui prend du temps ensuite c'est pour envoyer le .bin dans l'image de disque. Est-ce qu'il y aurait un utilitaire en ligne de commande pour ça ? Avec dcfdutil.exe ça va assez vite (effacer l'image, remplacer le fichier bin dessus), mais quand on fait la procédure 20 fois, ça devient un peu long...
Est-ce qu'il est également possible de démarrer automatiquement un programme au démarrage du thomson ?
Pièces jointes
disk_garvalf.zip
(2 Kio) Téléchargé 183 fois
Répondre