Kyoto.pmでつくったやつ

scalable_mml.pl

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;
}

usage

% perl scalable_mml.pl 1 | ./cin2audio

cin2audio
https://gist.github.com/8144af463e36b5ae8836