Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

#!/usr/bin/env perl
# This is an example of a bass groove + "melodic phrase" generator.
use strict;
use MIDI::Util qw(set_chan_patch);
my $bars = shift || 4;
my $bpm = shift || 70;
my $note = shift || 'A';
my $bscale = shift || 'pminor';
my $tscale = shift || 'dorian';
my $octave = 1;
my $bpatch = 35;
my $tpatch = 0;
my $d = MIDI::Drummer::Tiny->new(
file => "$0.mid",
bpm => $bpm,
volume => 100,
signature => '7/8',
bars => $bars,
kick => 'n36', # Override default patch
snare => 'n40', # "
);
$d->score->synch(
\&drums,
\&bass,
\&top,
);
$d->write;
sub bass {
set_chan_patch($d->score, 1, $bpatch);
my $mdp = Music::Duration::Partition->new(
size => 3.5,
pool => [qw(qn en)],
weights => [2, 1],
);
my $motif1 = $mdp->motif;
my $motif2 = $mdp->motif;
my @pitches = get_scale_MIDI($note, $octave, $bscale);
my @intervals = qw(-3 -2 -1 1 2 3);
my $voice = Music::VoiceGen->new(
pitches => \@pitches,
intervals => \@intervals,
);
my @notes1 = map { $voice->rand } @$motif1;
my @notes2 = map { $voice->rand } @$motif2;
for my $n (1 .. $d->bars + 2) {
for my $i (0 .. $#$motif1) {
$d->note($motif1->[$i], $n % 2 ? $notes1[$i] : $notes2[$i]);
}
for my $i (0 .. $#$motif2) {
$d->note($motif2->[$i], $n % 2 ? $notes1[$i] : $notes2[$i]);
}
}
$d->note($d->whole, $pitches[0]);
}
sub top {
set_chan_patch($d->score, 0, $tpatch);
my $mdp = Music::Duration::Partition->new(
size => 3.5,
pool => [qw(qn en)],
);
my $motif1 = $mdp->motif;
my $motif2 = $mdp->motif;
my @pitches = (
get_scale_MIDI($note, $octave + 1, $tscale),
get_scale_MIDI($note, $octave + 2, $tscale)
);
my @intervals = qw(-4 -3 -2 -1 1 2 3 4);
my $voice = Music::VoiceGen->new(
pitches => \@pitches,
intervals => \@intervals,
);
my @notes1 = map { $voice->rand } @$motif1;
my @notes2 = map { $voice->rand } @$motif1;
my @notes3 = map { $voice->rand } @$motif2;
my @notes4 = map { $voice->rand } @$motif2;
$d->rest($_) for @$motif1;
$d->rest($_) for @$motif2;
for my $n (1 .. $d->bars) {
for my $i (0 .. $#$motif1) {
$d->note($motif1->[$i], $n % 2 == 0 ? $notes2[$i] : $notes1[$i]);
}
for my $i (0 .. $#$motif2) {
$d->note($motif2->[$i], $n % 2 == 0 ? $notes4[$i] : $notes3[$i]);
}
}
$d->rest($_) for @$motif1;
$d->rest($_) for @$motif2;
$d->note($d->whole, $pitches[0]);
}
sub drums {
$d->metronome78($d->bars * 2 + 4);
}