Player de fichiers midi sur Thomson
Modérateurs : Papy.G, fneck, Carl
Re: Player de fichiers midi sur Thomson
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).
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).
-
- Messages : 2366
- Inscription : 06 avr. 2009 12:07
Re: Player de fichiers midi sur Thomson
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.
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.
Re: Player de fichiers midi sur Thomson
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.
-
- Messages : 7987
- Inscription : 18 sept. 2010 12:08
- Localisation : Brest et parfois les Flandres
Re: Player de fichiers midi sur Thomson
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? )
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? )
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
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
Re: Player de fichiers midi sur Thomson
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/
http://freestuff.grok.co.uk/beepola/
-
- Messages : 7987
- Inscription : 18 sept. 2010 12:08
- Localisation : Brest et parfois les Flandres
Re: Player de fichiers midi sur Thomson
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
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
-
- Messages : 7987
- Inscription : 18 sept. 2010 12:08
- Localisation : Brest et parfois les Flandres
Re: Player de fichiers midi sur Thomson
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
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.
Son le spectre présente des jolis sinus-cardinals (sinus-cardinaux? bref des sinc) qui marquent un PULS ( ) 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.
[edit] Les liens sont cassé, j'ai re-trouvé le zip:
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
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.
Son le spectre présente des jolis sinus-cardinals (sinus-cardinaux? bref des sinc) qui marquent un PULS ( ) 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.
[edit] Les liens sont cassé, j'ai re-trouvé le zip:
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
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
Re: Player de fichiers midi sur Thomson
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).
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).
-
- Messages : 7987
- Inscription : 18 sept. 2010 12:08
- Localisation : Brest et parfois les Flandres
Re: Player de fichiers midi sur Thomson
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):
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 .
J'ai mis à jour la D7 thomson avec le thème "mario" (ici). Ca rend étonnamment bien.
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 .
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
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
Re: Player de fichiers midi sur Thomson
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...
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...
-
- Messages : 7987
- Inscription : 18 sept. 2010 12:08
- Localisation : Brest et parfois les Flandres
Re: Player de fichiers midi sur Thomson
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)farvardin a écrit :et les sources du convertisseur sont publiées ou pas ? Ça pourrait être amusant comme moteur de musique...
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; #&l($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;
}
- -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 ).
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
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
Re: Player de fichiers midi sur Thomson
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 :
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.
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
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.
-
- Messages : 7987
- Inscription : 18 sept. 2010 12:08
- Localisation : Brest et parfois les Flandres
Re: Player de fichiers midi sur Thomson
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: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 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)
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
Code : Tout sélectionner
c6809.exe -c -bh -am -oOP mv.ass MV.BIN
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
A500 Vampire V2+ ^8^, A1200 (030@50mhz/fpu/64mb/cf 8go),
A500 GVP530(MMU/FPU) h.s., R-Pi, TO9, TO8D, TO8.Démos
Re: Player de fichiers midi sur Thomson
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.
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.
Re: Player de fichiers midi sur Thomson
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 ?
Ç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