#!perl
use
5.020;
no
warnings
'experimental::signatures'
;
GetOptions(
'mute=s'
=> \
my
@do_mute
,
'seed=s'
=> \
my
$seed
,
'voice'
=> \
my
$voice
,
'dry-run|n'
=> \
my
$dry_run
,
) or pod2usage(2);
if
(
$dry_run
) {
undef
$voice
;
}
@do_mute
=
map
{
split
/,/ }
@do_mute
;
if
(
$seed
) {
srand
(
$seed
);
}
my
$loop
= IO::Async::Loop->new();
my
$osc
= Net::Async::OSC->new(
loop
=>
$loop
,
);
if
( !
$dry_run
) {
$osc
->
connect
(
'127.0.0.1'
, 4560)->get;
}
my
@track_names
= (
qw(
<harmony>
chord
hh
snare
bassdrum
bass
melody
777
)
);
my
$t
= Term::Output::List->new();
my
$input
;
if
( $^O eq
'MSWin32'
) {
$input
= Win32::Console->new(Win32::Console::STD_INPUT_HANDLE());
}
sub
msg(
$msg
) {
$t
->output_permanent(
$msg
);
}
my
$bpm
= 94;
my
$beats
= 4;
my
$ticks
= 4;
my
$tracks
= 8;
sub
loc(
$tick
,
$track
) {
$tick
*$tracks
+
$track
}
sub
beat(
$beat
,
$track
) {
return
loc(
$ticks
*$beat
,
$track
)
}
sub
random_melody(
$sequencer
,
$track
) {
for
my
$beat
(0..7) {
$sequencer
->[beat(
$beat
*8+4,
$track
)] = [
"/trigger/tb303"
=>
'iiffi'
,
(40+
int
(
rand
(24)), 130, 0.1, 0.8+
rand
(0.15), 0)
];
}
}
sub
wailers(
$base
) {
my
@harmonies
= (
[
$base
,
'major'
],
[
$base
,
'major'
],
[
$base
+7,
'major'
],
[
$base
+7,
'major'
],
[
$base
+9,
'min'
],
[
$base
+9,
'min'
],
[
$base
+5,
'major'
],
[
$base
+5,
'major'
],
[
$base
,
'major'
],
[
$base
,
'major'
],
[
$base
+7,
'major'
],
[
$base
+7,
'major'
],
[
$base
,
'major'
],
[
$base
,
'major'
],
[
$base
+7,
'major'
],
[
$base
+7,
'major'
],
);
return
\
@harmonies
;
}
sub
tosh(
$base
) {
my
@harmonies
= ([
$base
,
'major'
],
[
$base
,
'major'
],
[
$base
+7,
'major'
],
[
$base
+7,
'major'
],
);
return
\
@harmonies
;
}
sub
get_harmonies(
$base
= 50 +
int
(
rand
(32)) ) {
my
$base
= 50 +
int
(
rand
(32));
return
wailers(
$base
)
}
my
$chord_track
= 1;
my
$info_track
= 0;
sub
generate_bassline(
$sequencer
,
$harmonies
,
$bassline
,
$chord_track
,
$info_track
) {
my
$bass_harmony
= -1;
my
@bassline
= (
split
//,
$bassline
);
my
$bass_ofs
= 0;
for
my
$beat
(0..
$#$harmonies
) {
$bass_harmony
= (
$bass_harmony
+1)%
@$harmonies
;
my
$ofs
= beat(
$beat
*8+4,
$info_track
);
$sequencer
->[
$ofs
+
$_
*$tracks
] =
sprintf
"%d %s"
,
$harmonies
->[
$bass_harmony
]->@*
for
0..
$ticks
*$beats
-1;
$sequencer
->[beat(
$beat
*8+4,
$chord_track
)] = [
"/trigger/chord"
=>
'is'
, (
$harmonies
->[
$bass_harmony
]->@* )
];
for
my
$ofs
(0..7) {
if
(
$bassline
[
$bass_ofs
] ne
'-'
) {
$sequencer
->[beat(
$beat
*8+
$ofs
,5)] = [
"/trigger/bass"
=>
'i'
, (
$harmonies
->[
$bass_harmony
]->[0] - 24 )
];
};
$bass_ofs
= ((
$bass_ofs
+1) %
scalar
@bassline
)
}
}
}
my
%chord_names
= (
'M7'
=>
'M7'
,
min
=>
'm'
,
major
=>
'base'
,
);
sub
octave(
$note
) {
return
int
(
$note
/12)-1
}
sub
melody_step(
$sequencer
,
$tick
,
$harmonies
,
$curr_harmony
,
$next_harmony
,
$last_note
,
$chord_track
,
$bass_track
) {
my
$h
=
$harmonies
->[
$curr_harmony
];
my
$chord_name
=
$chord_names
{
$h
->[1]} //
$h
->[1];
my
$base
=
$h
->[0];
my
%scales
= (
major
=>
'major'
,
min
=>
'minor'
,
'M7'
=>
'major'
,
);
my
$scale_name
=
$scales
{
$h
->[1] }
or
die
"Unknown harmony '$h->[1]'"
;
my
$chord_name
=
$chord_names
{
$h
->[1] }
or
die
"Unknown harmony '$h->[1]' for chord"
;
my
@scale
;
my
$cn
= Music::Chord::Note->new();
my
%chord
=
map
{
$base
+
$_
=> 1 }
$cn
->chord_num(
$chord_name
);
if
(
$sequencer
->[beat(
$tick
,
$chord_track
)]
or
$sequencer
->[beat(
$tick
,
$bass_track
)]
) {
@scale
=
map
{
$base
+
$_
}
$cn
->chord_num(
$chord_name
);
}
else
{
@scale
=
grep
{
$_
!=
$last_note
}
grep
{ 1
and !
exists
$chord
{
$_
+6 }
and !
exists
$chord
{
$_
-6 }
}
grep
{
abs
(
$_
-
$last_note
) < 7 }
get_scale_MIDI(
$base
, octave(
$base
),
$scale_name
, 0),
get_scale_MIDI(
$base
, octave(
$base
)-1,
$scale_name
, 0),
;
}
return
$scale
[
int
rand
@scale
];
}
sub
generate_melody(
$base
,
$harmonies
,
$sequencer
,
$track
,
$chord_track
,
$bass_track
) {
my
@melody
= (
split
//,
"o---o---"
);
my
$harmony
= -1;
my
$rhythm_ofs
= 0;
my
$last_note
=
$base
;
for
my
$beat
(0..
$#$harmonies
) {
$harmony
= (
$harmony
+1)%
@$harmonies
;
my
$next_harmony
= (
$harmony
+1)%
@$harmonies
;
for
my
$ofs
(0..
$#melody
) {
if
(
$melody
[
$rhythm_ofs
] ne
'-'
) {
my
$note
= melody_step(
$sequencer
,
$ofs
,
$harmonies
,
$harmony
,
$next_harmony
,
$last_note
,
$chord_track
,
$bass_track
);
$sequencer
->[beat(
$beat
*8+
$ofs
,
$track
)] = [
"/trigger/melody"
=>
'ii'
, (
$note
,1)
];
$last_note
=
$note
;
};
$rhythm_ofs
= ((
$rhythm_ofs
+1) %
scalar
@melody
)
}
}
}
sub
generate_intro(
$base
,
$harmonies
,
$sequencer
,
$track
) {
my
$harmony
= -1;
for
my
$ofs
(0..(
@$sequencer
/
$tracks
)) {
my
$l
= loc(
$ofs
,
$track
);
undef
$sequencer
->[loc(
$ofs
,
$track
)];
}
my
$rhythm_ofs
= 0;
my
$last_note
=
$base
;
for
my
$beat
(0..
$#$harmonies
) {
$harmony
= (
$harmony
+1)%
@$harmonies
;
my
$next_harmony
= (
$harmony
+1)%
@$harmonies
;
for
my
$ofs
(
int
rand
(
$beats
)) {
my
$note
=
int
rand
(8)+1;
$sequencer
->[loc(
$ofs
,
$track
)] = [
"/trigger/fx"
=>
'i'
, (
$note
)
];
}
}
}
sub
parse_drum_pattern(
$sequencer
,
$total_bars
,
$track
,
$pattern
,
$osc_message
,
$vol
=1,
$ticks_per_note
=
undef
) {
$pattern
=~ m!^\s*\w+\s*\|((?:[\w\-]{16})+)\|+!
or croak
"Invalid pattern '$pattern'"
;
$ticks_per_note
//=
length
($1) / 4;
my
$p
= $1;
my
$target_len
=
$total_bars
*$beats
*$ticks
*2 /
$ticks_per_note
;
while
(
length
$p
<
$target_len
) {
$p
.= $1;
}
my
@beats
=
split
//,
$p
;
my
$ofs
= 0;
while
(
$ofs
<
@beats
) {
if
(
$beats
[
$ofs
] ne
'-'
) {
$sequencer
->[loc(
$ofs
*$ticks_per_note
,
$track
)] =
$osc
->osc->message(
$osc_message
,
'f'
=>
$vol
);
}
else
{
$sequencer
->[loc(
$ofs
*$ticks_per_note
,
$track
)] =
undef
;
}
$ofs
++;
}
}
sub
generate_half_drop(
$sequencer
,
$total_bars
) {
parse_drum_pattern(
$sequencer
,
$total_bars
, 2,
'HH|x-x-x-x-x-x-x-x-||'
,
'/trigger/hh'
);
parse_drum_pattern(
$sequencer
,
$total_bars
, 3,
' S|--------o-------||'
,
'/trigger/sn'
);
parse_drum_pattern(
$sequencer
,
$total_bars
, 4,
' B|o-------o-------||'
,
'/trigger/bd'
);
}
sub
generate_one_drop(
$sequencer
,
$total_bars
) {
parse_drum_pattern(
$sequencer
,
$total_bars
, 2,
'HH|x-x-x-x-x-x-x-x-||'
,
'/trigger/hh'
,1,4);
parse_drum_pattern(
$sequencer
,
$total_bars
, 3,
' S|--------o-------||'
,
'/trigger/sn'
,1,4);
parse_drum_pattern(
$sequencer
,
$total_bars
, 4,
' B|--------o-------||'
,
'/trigger/bd'
,1,4);
}
sub
generate_reggaeton(
$sequencer
,
$total_bars
) {
parse_drum_pattern(
$sequencer
,
$total_bars
, 2,
'HH|x---x---x---x---x---x---x---x---||'
,
'/trigger/hh'
,0.25,2);
parse_drum_pattern(
$sequencer
,
$total_bars
, 3,
' B|o-------o-------o-------o-------||'
,
'/trigger/bd'
,1,2);
parse_drum_pattern(
$sequencer
,
$total_bars
, 4,
' S|----------------------o-----o---||'
,
'/trigger/sn'
,1,2);
}
sub
generate_lyrics(
$sequencer
,
$track
) {
my
$p
= beat(0,7);
while
(
$p
<
@$sequencer
) {
$sequencer
->[
$p
] = \
&sing
;
$p
+= beat(16,0);
}
}
sub
fresh_pattern(
$base
,
$harmonies
,
%options
) {
my
$sequencer
= [];
my
$harmonies
= get_harmonies();
$options
{ bassline } //=
"o-------o---------------o---o---"
;
generate_bassline(
$sequencer
,
$harmonies
,
$options
{bassline},
$chord_track
,
$info_track
);
generate_one_drop(
$sequencer
,
scalar
@$harmonies
);
generate_melody(
$base
,
$harmonies
,
$sequencer
, 6,
$chord_track
,5 );
if
(
$options
{ voice }) {
generate_lyrics(
$sequencer
, 7);
}
my
$last
= beat(16,0) -1;
$sequencer
->[
$last
]=
undef
;
my
$ticks_in_bar
=
@$sequencer
/
$tracks
;
while
(
int
(
$ticks_in_bar
) !=
$ticks_in_bar
) {
$ticks_in_bar
=
int
(
$ticks_in_bar
)+1;
while
(
$ticks_in_bar
% 16 != 0 ) {
$ticks_in_bar
+= (16 - (
$ticks_in_bar
% 16));
}
$sequencer
->[loc(
$ticks_in_bar
,0)-1] =
undef
;
}
my
$tick
= 0;
$ticks_in_bar
=
@$sequencer
/
$tracks
;
die
"data structure is not a complete bar ($ticks_in_bar)"
if
int
(
$ticks_in_bar
) !=
$ticks_in_bar
;
return
$sequencer
,
$ticks_in_bar
;
}
my
$sapi
;
if
( $^O eq
'MSWin32'
) {
$sapi
= Win32::OLE->CreateObject(
'SAPI.SpVoice'
);
};
''
,
''
,
''
,
''
,
''
,
''
,
''
,
''
,
"We're no strangers to love"
,
''
,
"You know the rules and so do I"
,
''
,
"A full commitment's what I'm thinking of"
,
"You wouldn't get this from any other guy"
,
"I just wanna tell you how I'm feeling"
,
"Gotta make you understand"
,
"Never gonna give you up"
,
"Never gonna let you down"
,
"Never gonna run around and desert you"
,
''
,
"Never gonna make you cry"
,
"Never gonna say goodbye"
,
"Never gonna tell a lie and hurt you"
,
''
,
"Thank you everybody"
,
''
,
"You are a wonderful audience"
,
''
,
"It's been a pleasure to sing for you today"
,
''
,
"Also, a round of applause for the band!"
,
''
,
"Never gonna give you up"
,
"Never gonna let you down"
,
"Never gonna run around and desert you"
,
''
,
"Never gonna make you cry"
,
"Never gonna say goodbye"
,
"Never gonna tell a lie and hurt you"
,
''
,
);
sub
sing(
$ofs
) {
state
$line
= 0;
if
(
$line
>=
@lyrics
) {
$line
= 0;
}
my
$l
=
$lyrics
[
$line
++];
$sapi
->Speak(
$l
, 1);
$l
=~ s!<.*?>!!g;
if
(
$l
) {
msg(
$l
);
}
return
();
}
$| = 1;
my
$output_state
=
''
;
my
@playing
= (
''
x (1+
$tracks
));
my
@mute
= (
''
x (1+
$tracks
));
for
my
$m
(
@do_mute
) {
my
$i
;
for
(0..
$#track_names
) {
if
(
$m
eq
$track_names
[
$_
] ) {
$i
=
$_
;
last
;
}
};
$mute
[
$i
] = 1;
}
sub
toggle_mute(
$track
,
$mute
=
undef
) {
my
$val
=
$mute
;
if
( !
defined
$val
) {
if
(
$mute
[
$track
] ) {
$val
=
''
;
}
else
{
$val
=
'mute'
;
}
}
$mute
[
$track
] =
$val
;
}
sub
handle_keyboard {
while
(
$input
and
$input
->GetEvents ) {
my
@ev
=
$input
->Input();
if
(
$ev
[0] == 1 and
$ev
[1] ) {
my
$key
=
chr
(
$ev
[5]);
if
(
$key
=~ /\d/ ) {
toggle_mute(
$key
);
}
elsif
(
$key
eq
'm'
) {
toggle_mute(
$_
,
'mute'
)
for
0..
$tracks
-1;
}
elsif
(
$key
eq
'u'
) {
toggle_mute(
$_
,
''
)
for
0..
$tracks
-1;
}
elsif
(
$key
eq
'r'
) {
return
undef
;
}
elsif
(
$key
eq
'x'
) {
dump_state();
$loop
->stop;
}
elsif
(
$key
eq
'q'
) {
$mute
[6] = 1;
if
( !
$dry_run
) {
$osc
->send_osc(
"/trigger/melody"
=>
'ii'
,
1,0);
}
$loop
->watch_time(
after
=> 1,
code
=>
sub
{
$loop
->stop;
});
}
else
{
msg(
"Keypress '$key' ($ev[5])"
)
if
$ev
[5];
}
}
}
return
1;
}
sub
generate_song {
my
@phrases
;
my
$harmonies
= get_harmonies();
my
$base
=
int
( 60+
rand
24 );
my
(
$seq
,
$ticks_in_bar
) = fresh_pattern(
$base
,
$harmonies
,
voice
=>
$voice
);
my
$verse
= {
sequencer
=>
$seq
,
ticks
=>
$ticks_in_bar
,
name
=>
'Verse'
,
};
my
(
$seq_intro
) = [
@$seq
];
my
@harmonies_i
= @{
$harmonies
}[0..1];
splice
@$seq_intro
,
$tracks
*$ticks_in_bar
/ 2;
generate_intro(
$base
, \
@harmonies_i
,
$seq_intro
, 6 );
my
$intro
= {
sequencer
=>
$seq_intro
,
ticks
=>
$ticks_in_bar
,
name
=>
'Intro'
,
};
(
$seq
,
$ticks_in_bar
) = fresh_pattern(
$base
,
$harmonies
,
voice
=>
$voice
);
my
$chorus
= {
sequencer
=>
$seq
,
ticks
=>
$ticks_in_bar
,
name
=>
'Chorus'
,
};
push
@phrases
,
$intro
,
$verse
,
$chorus
,
$verse
,
$chorus
,
$chorus
;
return
\
@phrases
}
sub
play_sounds {
state
$tick
;
state
$sequencer
;
state
$ticks_in_bar
;
state
$song
;
state
$song_pos
;
state
$playing
;
if
( !
$song
) {
$song
= generate_song();
$song_pos
= 0;
undef
$playing
;
};
if
( !
$playing
) {
$playing
=
$song
->[
$song_pos
];
(
$sequencer
,
$ticks_in_bar
) = (
$playing
->{sequencer},
$playing
->{ticks});
msg(
"Playing $playing->{name}"
);
}
my
$loc
= loc(
$tick
, 0) %
@$sequencer
;
if
( ! handle_keyboard()) {
undef
$song
;
goto
&play_sounds
;
}
if
(
$output_state
eq
'silent'
) {
}
else
{
for
my
$s
(
$loc
..
$loc
+
$tracks
-1) {
my
$track
=
$s
-
$loc
;
my
$n
=
$sequencer
->[
$s
];
if
(
$n
) {
$playing
[
$track
] =
$n
;
if
( !
$mute
[
$track
]) {
my
$r
=
ref
$n
;
if
(
$r
and not
$mute
[
$track
] ) {
my
@osc_msg
;
if
(
$r
eq
'CODE'
) {
@osc_msg
=
$n
->(
$tick
);
}
elsif
(
$r
eq
'ARRAY'
) {
@osc_msg
=
@$n
;
}
if
(
@osc_msg
and !
$dry_run
) {
$osc
->send_osc(
@osc_msg
);
}
}
elsif
(
$track
== 0 ) {
$playing
[0] =
$n
;
}
else
{
if
( !
$dry_run
) {
$osc
->send_osc_msg(
$n
);
}
}
}
}
else
{
$playing
[
$track
] =
''
;
}
}
my
@output
=
map
{
sprintf
"%d| %8s | % 12s | %s"
,
$_
,
$mute
[
$_
],
$track_names
[
$_
],
$playing
[
$_
];
} 0..
$tracks
-1;
$t
->output_list(
@output
);
}
$tick
= (
$tick
+1)
%$ticks_in_bar
;
if
(
$tick
== 0 ) {
$song_pos
= (
$song_pos
+1) %
@$song
;
undef
$playing
;
}
}
my
$timer
= IO::Async::Timer::Periodic->new(
reschedule
=>
'skip'
,
first_interval
=> 0,
interval
=> 60/
$bpm
/
$beats
/
$ticks
,
on_tick
=> \
&play_sounds
,
);
$timer
->start;
$loop
->add(
$timer
);
$loop
->run;