#! /usr/bin/perl
#########################################################################
# This Perl script is Copyright (c) 2011, Peter J Billam #
# c/o P J B Computing, GPO Box 669, Hobart TAS 7001, Australia #
# #
# This script is free software; you can redistribute it and/or #
# modify it under the same terms as Perl itself. #
#########################################################################
# Simulates a metronome, on real-time MIDI, as an ALSA client
use Term::ReadKey;
use Time::HiRes;
use bytes;
my $Version = '1.4'; # use the new MIDI-ALSA 1.11 to handle portnames
my $VersionDate = '03nov2011';
my $Tempo = 120; # beats per minute
my $BarLength = 0; # beats per bar
my $Volume = 100; # MIDI velocity 0..127
my $Debug = 0;
my $Quiet = 0; # no display; for use in background, and in scripts
my $Paused = 0;
my $OutputPort = q{};
# vt100 globals
my $CursorRow = 5;
my $Irow = 1;
my $Icol = 1;
my $MidCol = 32;
eval 'require MIDI::ALSA'; if ($@) {
die "you'll need to install the MIDI-ALSA module from www.cpan.org\n";
}
# check format of options args...
while ($ARGV[$[] =~ /^-(\w)/) {
if ($1 eq 'V') { shift;
my $n = $0; $n =~ s{^.*/([^/]+)$}{$1};
print "$n version $Version $VersionDate\n";
exit 0;
} elsif ($1 eq 't') { shift;
my $a = shift; if ($a !~ /^\d[\d.]*$/) { die "bad -t arg: $a\n"; }
$Tempo = 0 + $a;
} elsif ($1 eq 'b') { shift;
my $a = shift; if ($a !~ /^\d+$/) { die "bad -b arg: $a\n"; }
$BarLength = 0 + $a;
} elsif ($1 eq 'v') { shift;
my $a = shift; if ($a !~ /^\d+$/) { die "bad -v arg: $a\n"; }
$Volume = 0 + $a;
if ($Volume < 1) { $Volume = 1;
} elsif ($Volume > 127) { $Volume = 127;
}
} elsif ($1 eq 'o') { shift; $OutputPort = shift;
} elsif ($1 eq 'p') { shift; $Paused = 1;
} elsif ($1 eq 'Q') { shift; $Quiet = 1;
} elsif ($1 eq 'D') { shift; $Debug = 1;
} else {
my $n = $0; $n =~ s#^.*/([^/]+)$#$1#;
print "usage:\n";
my $synopsis = 0;
while (<DATA>) {
if (/^=head1 SYNOPSIS/) { push @Synopsis,$_; $synopsis=1; next; }
if ($synopsis && /^=head1/) { last; }
if ($synopsis) { print $_; next; }
}
exit 1;
}
}
if ($Quiet) { $Paused = 0; }
my $RealTimeMode = 1; # an anacronism from midiecho; we're always RealTime.
if ($RealTimeMode) {
eval 'require MIDI::ALSA'; if ($@) {
die "you need to install the MIDI::ALSA module from www.cpan.org\n";
}
#if ($OutputPort =~ /^$|^\d+(:\d)?(,\d+(:\d)?)*$/) {
#} else { die "bad -o arg: $OutputPort\n";
#}
if (! MIDI::ALSA::client( "midiclick pid=$$", 0, 1, 1 )) {
die "can't create the MIDI::ALSA::client\n";
}
if (!$OutputPort) { $OutputPort = $ENV{'ALSA_OUTPUT_PORTS'}; }
if (!$OutputPort) {
warn "OutputPort not specified and ALSA_OUTPUT_PORTS not set\n";
}
foreach my $cl_po (split /,/, $OutputPort) { # 3.6
#$cl_po =~ /^(\d+):?(\d*)$/;
#my $cl = $1; my $po = $2 or 0;
#if ($cl == MIDI::ALSA::id()) {
# die "can't connect to $cl_po, which is myself\n";
#}
if (! MIDI::ALSA::connectto( 1, $cl_po )) { # 1.4
die "can't connect to ALSA client $cl_po\n";
}
}
if (! MIDI::ALSA::start()) {
die "can't start the queue of the ALSA client\n";
}
# system "aconnect -oil";
display_alsa(); display_keystrokes(); display_tempo();
display_paused(); display_volume();
# The child responds to keystrokes and the parent emits the alsaevents
if (! $Quiet) { # 3.1
my $parent_pid = $$;
my $child_pid = open(CHILD_STDOUT, "-|");
sub handle_child_output {
my $cmd = <CHILD_STDOUT>;
eval $cmd; if ($@) { warn "can't eval $cmd $@\n"; }
}
if (! $child_pid) { # The child does all the UI
while (1) {
ReadMode(4, STDIN);
my $c = ReadKey(0, STDIN);
if ($c =~ /^\e$/) { # reduce an escape sequence to just 1 char
$c = ReadKey(0, STDIN);
if ($c eq '[') {
$c = ReadKey(0, STDIN);
if ($c =~ /^\d$/) { # e.g. Delete; throw away the ~
my $tilde = ReadKey(0, STDIN);
}
}
}
if ($c =~ /^q$/i) {
gotoxy(1, $CursorRow); display_keystrokes('quit');
ReadMode(0, STDIN);
print STDOUT "wait; exit;\n"; kill 'HUP', $parent_pid;
exit;
}
if ($c eq 't') {
my $ch = get_int('tempo (beats per minute) ?');
if (defined $ch) {
$Tempo = $ch;
print STDOUT "\$Tempo = $ch;\n";
kill 'HUP', $parent_pid;
}
display_tempo(); display_keystrokes();
} elsif ($c eq 'b') {
my $d = get_int('bar length (in beats) ?');
if (defined $d) {
$BarLength = $d;
print STDOUT "\$BarLength = $d;\n";
kill 'HUP', $parent_pid;
}
display_tempo(); display_keystrokes();
} elsif ($c eq 'v') {
my $d = get_int('volume ?');
if (defined $d) {
$Volume = $d;
print STDOUT "\$Volume = $d;\n";
kill 'HUP', $parent_pid;
}
display_volume(); display_keystrokes();
} elsif ($c eq ' ') {
if ($Paused) { $Paused=0; } else { $Paused = 1; }
print STDOUT "\$Paused = $Paused;\n";
kill 'HUP', $parent_pid;
display_paused(); display_keystrokes();
}
# every second or so, the child should display_alsa()
# print STDOUT "$cmd\n"; kill 'HUP', $parent_pid;
}
}
$SIG{'HUP'} = \&handle_child_output;
close STDIN; # end of child
} # end of if(!$Quiet)
my $beat = 0; # 0 .. ($BarLength-1)
my $next_click = 0;
while (1) { # the parent...
# on my system, sleep is interrupted by HUP...
if ($Paused) { $beat = 0; Time::HiRes::sleep(10.0); next; }
MIDI::ALSA::syncoutput();
my ($is_running,$now,$nevents) = MIDI::ALSA::status();
my $pitch = 33;
if ($beat == 0 and $BarLength > 0) { $pitch = 34; }
$next_click += 60/$Tempo;
my @alsaevent=MIDI::ALSA::noteevent(9,$pitch,$Volume,$next_click,0.3);
my $rc = MIDI::ALSA::output(@alsaevent);
# HUP aborts this sleep, therefore must syncoutput as well;
Time::HiRes::sleep(60/$Tempo);
# but on its own, syncoutput lurches on BarLength change, not sure why
$beat += 1;
if ($beat >= $BarLength) { $beat = 0; }
}
exit 0; # end of RealTime mode
}
#--------- RealTime UI and infrastructure, recycled from midikbd ---------
sub display_alsa {
return if $Quiet;
@ConnectedTo = ();
my $id = MIDI::ALSA::id();
foreach (MIDI::ALSA::listconnectedto()) {
my @cl = @$_;
push @ConnectedTo, "$cl[1]:$cl[2]"
}
@ConnectedFrom = ();
foreach (MIDI::ALSA::listconnectedfrom()) {
my @cl = @$_;
push @ConnectedFrom, "$cl[1]:$cl[2]"
}
gotoxy(1,1); puts_30c("ALSA client $id");
gotoxy($MidCol,1); puts_clr("midiclick pid=$$");
gotoxy(1,2); puts_clr($s);
my $s = "Ouput port $id:0 is ";
if (@ConnectedTo) { $s .= "connected to ".join(',',@ConnectedTo);
} else { $s .= "not connected to anything";
}
gotoxy(1,2); puts_clr($s);
gotoxy(1,$CursorRow);
}
sub display_tempo {
return if $Quiet;
gotoxy(1,3); puts_30c("Tempo $Tempo beats/min");
gotoxy($MidCol,3); puts_clr("BarLength $BarLength beats");
gotoxy(1,$CursorRow);
}
sub display_paused {
return if $Quiet;
gotoxy(1,4);
if ($Paused) {
puts_30c("PAUSED");
} else {
puts_30c("Playing");
}
gotoxy(1,$CursorRow);
}
sub display_volume {
return if $Quiet;
gotoxy($MidCol,4); puts_clr("Volume $Volume");
gotoxy(1,$CursorRow);
}
sub display_keystrokes { my $arg = $_[$[];
if ($Quiet) { return; }
my $s = " t=Tempo b=Barlength <spacebar>=";
if ($Paused) { $s .= "Play"; } else { $s .= "Pause"; }
$s .= " v=Volume q=Quit" ;
if ($arg eq 'quit') { $s = ''; gotoxy(1,4); puts_30c("Quit"); }
gotoxy(1, $CursorRow+1); puts_clr($s); gotoxy(1,$CursorRow);
}
sub get_int { my $s = $_[$[]; # this runs in the child
my $min_int = 0;
my $max_int = 127;
if ($s =~ /bar/i) { $max_int = 50;
} elsif ($s =~ /tempo/i) { $min_int = 30; $max_int = 300;
} elsif ($s =~ /output/i) { $min_int = 10; $max_int = 200;
}
ReadMode(0, STDIN);
my $int;
while (1) {
puts_clr("$s ($min_int..$max_int) ? ");
$int = <STDIN>;
print STDERR "\e[A"; $Icol = 1;
if ($int =~ /^-?[0-9]+$/ and $int >= $min_int and $int <= $max_int) {
ReadMode(4, STDIN);
puts_clr('');
return 0+$int;
}
if ($int =~ /^\s*$/) {
ReadMode(4, STDIN);
puts_clr('');
return undef;
}
}
}
# --------------- vt100 stuff, evolved from Term::Clui ---------------
sub puts { my $s = join q{}, @_;
$Irow += ($s =~ tr/\n/\n/);
if ($s =~ /\r\n?$/) { $Icol = 0;
} else { $Icol += length($s); # BUG, wrong on multiline strings!
}
# print STDERR "$s\e[K"; # and clear-to-eol
# should be caller's responsibility ? or an option ? a different sub ?
print STDERR $s;
}
sub puts_30c { my $s = $_[$[]; # assumes no newlines
my $rest = 30-length($s);
print STDERR $s, " "x$rest, "\e[D"x$rest;
$Icol += length($s);
}
sub puts_clr { my $s = $_[$[]; # assumes no newlines
my $rest = 30-length($s);
print STDERR "$s\e[K";
$Icol += length($s);
}
sub clrtoeol {
print STDERR "\e[K";
}
sub up {
# if ($_[$[] < 0) { down(0 - $_[$[]); return; }
print STDERR "\e[A" x $_[$[]; $Irow -= $_[$[];
}
sub down {
# if ($_[$[] < 0) { up(0 - $_[$[]); return; }
print STDERR "\n" x $_[$[]; $Irow += $_[$[];
}
sub right {
# if ($_[$[] < 0) { left(0 - $_[$[]); return; }
print STDERR "\e[C" x $_[$[]; $Icol += $_[$[];
}
sub left {
# if ($_[$[] < 0) { right(0 - $_[$[]); return; }
print STDERR "\e[D" x $_[$[]; $Icol -= $_[$[];
}
sub gotoxy { my $newcol = shift; my $newrow = shift;
if ($newcol == 0) { print STDERR "\r" ; $Icol = 0;
} elsif ($newcol > $Icol) { right($newcol-$Icol);
} elsif ($newcol < $Icol) { left($Icol-$newcol);
}
if ($newrow > $Irow) { down($newrow-$Irow);
} elsif ($newrow < $Irow) { up($Irow-$newrow);
}
}
#sub usecs {
# my ($secs, $usecs) = Time::HiRes::gettimeofday();
# return 1000000*$secs + $usecs;
#}
__END__
=pod
=head1 NAME
midiclick - generates a metronome click-track on MIDI channel 9
=head1 SYNOPSIS
midiclick -t 108 # tempo is (starts at) 108 beats/min
midiclick -t 108 -b 4 # Four beats in a bar
midiclick -Q -t 108 -b 4 # Quiet mode; no User-Interface
midiclick -o 14:1 -t 108 # Output to ALSA-port 14:1
midiclick -p # starts up in Paused mode
xterm -geometry 80x7-1+1 -exec 'midiclick -t 165 -b 5' &
~> midiclick -o TiMidity -t 144 -b 5 -p
ALSA client 129 midiclick pid=2157
Output port 129:1 is connected to 128:0
Tempo 144 beats/min BarLength 5 beats
PAUSED Volume 100
_
t=Tempo b=Barlength <spacebar>=Play v=Volume q=Quit
http://www.pjb.com.au/midi/midiclick.html
=head1 DESCRIPTION
The MIDI::ALSA module is used to create an ALSA client.
The keyboard interface,
allows real-time adjustment of the delay parameters.
If you don't want the interface (e.g. in a Makefile),
the -Q option sets Quiet-mode.
=head1 OPTIONS
=over 3
=item I<-t 72>
The Tempo will be set; to 72 beats per minute in this example.
The default is 120.
=item I<-b 3>
The Bar length will be set;
the bell will sound every 3 beats in this example
The default is 0, which means every beat clicks and there are no bells.
=item I<-v 80>
This option sets the Volume (or Velocity) of the midi output.
The default is 100.
=item I<-p>
This option starts I<midiclick> in Paused state;
you can then start it Playing with spacebar.
This option is ignored in -Q Quiet mode.
=item I<-o 128:0> or I<-o TiMidity>
This option sets the ouput-port to which the midi output will be sent.
You can check out the available ports with the command
I<aplaymidi -l> or I<aconnect -ol>.
The default ouput-port
is the environment variable $ALSA_OUTPUT_PORTS
=item I<-Q>
This option runs I<midiclick> in Quiet mode;
there is no user-interface, and the metronome just runs
with its Tempo and BarLength as given on the command-line,
until it is interrupted. It can be useful in scripts.
=item I<-V>
This option displays the Version number.
=back
=head1 AUTHOR
Peter J Billam http://www.pjb.com.au/comp/contact.html
=head1 CREDITS
Based on the MIDI::Perl CPAN module in midi-file mode,
and the MIDI::ALSA CPAN module in real-time mode.
=head1 SEE ALSO
http://search.cpan.org/perldoc?MIDI
http://search.cpan.org/perldoc?MIDI::ALSA
http://www.pjb.com.au/muscript
http://www.pjb.com.au/midi
=cut