Skip to content

Instantly share code, notes, and snippets.

@mohayonao
Created June 23, 2012 23:47
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mohayonao/2980586 to your computer and use it in GitHub Desktop.
Save mohayonao/2980586 to your computer and use it in GitHub Desktop.
Kyoto.pmでつくったやつ
use strict;
use warnings;
my $bpm = 160;
my $samplerate = 48000;
my $scale = [0, 2, 3, 5, 7, 8, 10]; # minor
{
package Sine;
sub new {
my ($class) = @_;
bless {
freq=>0, velocity=>0, phase=>0
}, $class;
}
sub set {
my ($self, $freq, $velocity) = @_;
$self->{freq} = $freq;
$self->{velocity} = $velocity;
$self;
}
sub seq {
my ($self) = @_;
my $value = sin(6.28 * $self->{phase}) * ($self->{velocity} / 15) * 0.25;
$self->{phase} += $self->{freq} / $samplerate;
$value;
}
}
{
package Command;
sub new {
my ($class, $name, $sign, $length, $dot) = @_;
$length = $length ? $length + 0 : 0;
my $type = index("><lov", $name) != -1 || 0; # {0=>tone, 1=>control}
bless {
name=>$name, type=>$type,
sign=>$sign, length=>$length, dot=>length $dot
}, $class;
}
}
{
package Track;
sub new {
my $class = shift;
my $mml = shift;
my $commands = [];
while ($mml =~ /([><lovcdefgabr])([-+]?)(\d*)(\.*)/g) {
push $commands, Command->new($1, $2, $3, $4);
}
my $self = bless {
tone=>Sine->new, samples=>0,
mml=>$mml, commands=>$commands, index=>0,
velocity=>12, octave=>5, length=>4, dot=>0,
delay=>shift||0, shift=>shift||0, volume=>shift||1, overtone=>shift||1
}, $class;
$self->{samples} = int($self->{delay} * $samplerate / 1000);
$self;
}
sub scale {
my ($self, $cmd) = @_;
my $tone_id = {c=>0,d=>2,e=>4,f=>5,g=>7,a=>9,b=>11}->{$cmd->{name}};
if ($cmd->{sign} eq '-') {
$tone_id -= 1;
} elsif ($cmd->{sign} eq '+') {
$tone_id += 1;
}
my ($index, $delta, $octave) = (0, 0, 0);
# tone_id -> scale(g-moll)
my $n = [-4.5,-4,-3.5,-3,-2,-1.5,-1,-0.5,0,0.5,1,2,2.5,3]->[$tone_id+1];
$n += $self->{shift};
while ($n < -4.5) {
$n += 7; $octave -= 1;
}
while ($n > 3) {
$n -= 7; $octave += 1;
}
if ($n >= 0) {
$index = $n % 7;
$index += 0.5 if $n - int($n) != 0;
$octave += int($n / +7);
} else {
$index = (7 + int($n)) % 7;
$index -= 0.5 if $n - int($n) != 0;
$octave += int($n / -7) - 1;
}
$delta = $index - int($index);
$index = int($index);
# scale(g-moll) -> other scale
if ($delta == 0) {
$n = $scale->[$index];
} else {
if ($delta < 0) {
$index = (6 + $index) % 7;
$delta *= -1;
}
my ($x0, $x1);
if ($index == 6) {
$x0 = $scale->[$index];
$x1 = $scale->[0] + 12;
} else {
$x0 = $scale->[$index];
$x1 = $scale->[$index + 1];
}
$n = (1.0 - $delta) * $x0 + $delta * $x1;
}
$octave += $self->{octave} - 6;
# calc frequency (G3 = 392Hz)
392 * (2 ** (($n + $octave * 12) / 12)) * $self->{overtone};
}
sub seq {
my ($self) = @_;
if ($self->{samples} <= 0) {
my $cmd = $self->fetch();
if ($cmd->{name} eq 'r') {
$self->{tone}->set(0, 0);
} else {
$self->{tone}->set($self->scale($cmd), $self->{velocity});
}
my $dot = $cmd->{dot};
$dot = $self->{dot} if $dot == 0 && $cmd->{length} == 0;
my $len = $cmd->{length};
$len = $self->{length} if $len == 0;
$len = $samplerate * (60 / $bpm) * (4 / $len);
$len *= 1.5 while $dot--;
$self->{samples} += int($len);
}
$self->{samples} -= 1;
$self->{tone}->seq * $self->{volume};
}
sub fetch {
my ($self) = @_;
my $cmd = $self->{commands}->[$self->{index}++];
$self->{index} %= scalar @{$self->{commands}};
if ($cmd->{type} == 1) {
if ($cmd->{name} eq '>') {
$self->{octave} += 1;
} elsif ($cmd->{name} eq '<') {
$self->{octave} -= 1;
} elsif ($cmd->{name} eq 'l') {
$self->{length} = $cmd->{length};
$self->{dot} = $cmd->{dot};
} elsif ($cmd->{name} eq 'o') {
$self->{octave} = $cmd->{length};
} elsif ($cmd->{name} eq 'v') {
$self->{velocity} = $cmd->{length};
}
$cmd = $self->fetch();
}
$cmd;
}
}
my $mml = <<EOD; # BWV578 Fuge g-moll
l4v12>g2>d2<a+2.aga+agf+adrgdada+a8g8adgl8dga4daa+4agad>dc<a+aga+agf+agdgaa+>cdefedfedc+ed4<a4>d4e4fgfgl32agagagagl8fgagaa+agfefagac+agadagac+agafdc+dgdc+dadc+dgdc+dl4<a>f<g>e<fa>dfd+ard+dgrdl8c<a+>cdcagargf+grf+ef+l1g<<
EOD
my $tracks = [];
push $tracks, Track->new($mml);
push $tracks, Track->new($mml, 125, 0, 0.5, 1.01);
if ($ARGV[0]) {
$scale = [0, 2, 4, 5, 7, 9, 11]; # major (ionian)
$scale = [0, 2, 3, 5, 7, 9, 10]; # dorian
$scale = [0, 1, 3, 5, 7, 8, 10]; # phrigian
$scale = [0, 2, 4, 6, 7, 9, 11]; # lydian
$scale = [0, 2, 4, 5, 7, 9, 10]; # mixolydian
$scale = [0, 2, 3, 5, 7, 8, 10]; # minor (aeolian)
$scale = [0, 1, 3, 5, 6, 8, 10]; # locrian
$scale = [0, 2, 4, 4, 6, 8, 10]; # wholetone
$scale = [0, 2, 3, 5, 7, 8, 11]; # harmonic-minor
$scale = [0, 3, 5, 5, 6, 7, 10]; # blues
$scale = [0, 2, 3, 6, 7, 9, 11]; # hungarian
$scale = [0, 1, 4, 5, 7, 8, 11]; # gypsy
$scale = [0, 4, 5, 5, 7, 7, 11]; # ryukyu
push $tracks, Track->new($mml, 3000, +6, 0.4, 1.01);
push $tracks, Track->new($mml, 3125, +6, 0.2, 0.99);
push $tracks, Track->new($mml, 6000, +4, 0.4);
}
while (1) {
my $value = 0;
for my $t (@$tracks) {
$value += $t->seq;
}
$value = 0.001 if $value == 0;
print $value;
}
% perl scalable_mml.pl 1 | ./cin2audio
cin2audio
https://gist.github.com/8144af463e36b5ae8836
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment