💾 Archived View for thrig.me › blog › 2023 › 10 › 09 › marimba-madness2.pl captured on 2023-12-28 at 16:54:59.

View Raw

More Information

⬅️ Previous capture (2023-11-04)

-=-=-=-=-=-=-

#!/usr/bin/env perl
# marimba-madess2 - something of a mess but it works?
use 5.36.0;
use MIDI;
use Object::Pad;
use List::Util 'shuffle';

my $srand = time();
srand $srand;

my @ps = (
    [qw(51 52)], [qw(56 58)], [qw(59 63)], [qw(64 68)],
    [qw(70 71)], [qw(75 76)], [qw(80 82)]
);

class Generator {
    method reset () { }

    method update ( $epoch, $maxlen ) {
        die "need a better implementation";
    }
}

class DoubleBeat :isa(Generator) {
    field $chan :param = 0;    # MIDI channel
    field $mul :param  = 1;
    field $pitch :param;       # callback
    field $velo :param;        # callback

    method update ( $epoch, $maxlen ) {
        my $p = $pitch->($epoch);
        my $d = 96;
        $epoch += $d;
        if ( $epoch > $maxlen ) {
            $d -= $epoch - $maxlen;
            return $d, [ [ note_off => $d, $chan, 0, 0 ] ];
        }
        my $v = $velo->($epoch);
        return 96,
          [ [ note_on  => 0,  $chan, $p, $v ],
            [ note_off => 32, $chan, $p, 0 ],
            [ note_on  => 0,  $chan, $p, $v ],
            [ note_off => 64, $chan, $p, 0 ],
          ];
    }
}

class Periodic :isa(Generator) {
    field $chan :param = 0;    # MIDI channel
    field $mul :param  = 1;
    field $pitch :param;       # callback
    field $velo :param;        # callback
    field $interval :param = 96;
    method reset () { $interval = 32 * ( 1 + int rand 4 ) * $mul }

    method update ( $epoch, $maxlen ) {
        my $p = $pitch->($epoch);
        my $d = $interval;
        $epoch += $d;
        if ( $epoch > $maxlen ) {
            $d -= $epoch - $maxlen;
            return $d, [ [ note_off => $d, $chan, 0, 0 ] ];
        }
        return $interval,
          [ [ note_on  => 0,  $chan, $p, $velo->($epoch) ],
            [ note_off => $d, $chan, $p, 0 ],
          ];
    }
}

class Random :isa(Generator) {
    field $chan :param = 0;    # MIDI channel
    field $mul :param  = 1;
    field $pitch :param;       # callback
    field $velo :param;        # callback
    field $rand :param = 96;

    method update ( $epoch, $maxlen ) {
        my $p = $pitch->($epoch);
        my $d = ( 16 + int rand $rand ) * $mul;
        $epoch += $d;
        if ( $epoch > $maxlen ) {
            $d -= $epoch - $maxlen;
            #return $d, [ [ note_off => $d, $chan, 0, 0 ] ];
            return $d;
        }
        return $d,
          [ [ note_on  => 0,  $chan, $p, $velo->($epoch) ],
            [ note_off => $d, $chan, $p, 0 ],
          ];
    }
}

class Silence :isa(Generator) {
    field $chan :param = 0;    # MIDI channel

    method update ( $epoch, $maxlen ) {
        return $maxlen, [ [ note_off => $maxlen, $chan, 0, 0 ] ];
    }
}

class Sectionator {
    field $events :param;      # MIDI events
    field $gen :param;         # generator object
    field $maxlen :param;      # maxiumum duration to generate

    method update {
        $gen->reset;
        my ( $epoch, $done, $overflow ) = ( 0, 0 );
        while (1) {
            my ( $dur, $newev ) = $gen->update( $epoch, $maxlen );
            my $newepoch = $epoch + $dur;
            if ( $newepoch > $maxlen ) {
                # kick overflows back to the caller to figure out
                $overflow = [ $dur, $newev ];
                last;
            } elsif ( $newepoch == $maxlen ) {
                $done = 1;
            }
            $epoch = $newepoch;
            push $events->@*, $newev->@* if defined $newev and $newev->@*;
            last if $done;
        }
        return $epoch, $events, $overflow;
    }
}

sub make_events {
    my %param = @_;
    $param{chan} //= 0;
    my @events = (
        [ track_name   => 0, $param{name} ],
        [ set_tempo    => 0, 750_000 ],
        [ patch_change => 0, $param{chan}, 12 ],
    );
    return \@events;
}

my @velo = qw( 105 75 75 75 );

sub velonoise { int( rand 4 + rand 4 + rand 4 ) }

sub makeatrack ( $name, $chan, $pitch ) {
    my $events = make_events( chan => $chan, name => $name );
    my @makers = (
        Sectionator->new(
            events => $events,
            gen    => Silence->new( chan => $chan ),
            maxlen => 16,
        ),
        Sectionator->new(
            events => $events,
            gen    => Silence->new( chan => $chan ),
            maxlen => 32,
        ),
        Sectionator->new(
            events => $events,
            gen    => DoubleBeat->new(
                chan  => $chan,
                pitch => sub ($epoch) {
                    state $index  = 0;
                    state $switch = 4;
                    if ( $switch == 0 ) {
                        $switch = 4;
                        $index ^= 1;
                    } else {
                        $switch--;
                    }
                    $ps[$chan][$index];
                },
                velo => sub ($epoch) { 85 + velonoise() },
            ),
            maxlen => 672,
        ),
        Sectionator->new(
            events => $events,
            gen    => Periodic->new(
                chan  => $chan,
                pitch => sub ($epoch) {
                    state $index  = 0;
                    state $switch = 4;
                    if ( $switch == 0 ) {
                        $switch = 4;
                        $index ^= 1;
                    } else {
                        $switch--;
                    }
                    $ps[$chan][$index];
                },
                velo => sub ($epoch) {
                    state $i = 0;
                    $i = 0 if $epoch == 0;
                    my $v = $velo[$i];
                    $i = ( $i + 1 ) % @velo;
                    $v + velonoise();
                },
            ),
            maxlen => 1152,
        ),
    );

    for ( 1 .. 16 ) {
        @makers = shuffle @makers;
        $_->update for @makers;
    }
    MIDI::Track->new( { events => $events } );
}

#my @pitches = qw(48 60 67 72 76 79 84 87);
# 51 52 56 58 59 63 64 68 70 71 75 76
my @pitches = qw(51 58 59 63 68 71 76);

sub onefile ($file) {
    my @tracks;
    for my $i ( 1 .. 6 ) {
        my $chan  = $i - 1;
        my $pitch = $pitches[$chan];
        my $track = sprintf "Track %03d $pitch $srand", $i;
        push @tracks, makeatrack( $track, $chan, $pitch );
    }
    MIDI::Opus->new( { tracks => \@tracks } )->write_to_file($file);
}

sub manyfiles {
    for my $i ( 1 .. 6 ) {
        my $chan  = $i - 1;
        my $file  = sprintf 'out%03d.midi', $i;
        my $pitch = $pitches[$chan];
        my $track = sprintf "Track %03d $pitch $srand", $i;
        MIDI::Opus->new(
            { tracks => [ makeatrack( $track, $chan, $pitch ) ] } )
          ->write_to_file($file);
    }
}

onefile('out.midi');