comment on

O Monks,

I have a simple perl script I've written that acts as an accelerating musical metronome. The idea is that if I need to practice, say, a few bars out of a piece of music to be able to play it faster, the metronome clicks at faster and faster tempos, while I'm sitting away from the computer.

Currently I'm using code like this:

select undef,undef,undef,$t;
[download]

to wait the appropriate amount of time between clicks. (The sleep function didn't have high enough resolution.) Also, there's a little bit of processing time required in order to play the sound, which I estimate on the fly using calls to `date +%s` and `date +%N`. In fact, this processing time is normally very small on my system (less than a millisecond).

OK, so my software is working great, but there's one problem: when xscreensaver comes on, it starts gobbling up cpu like crazy. My on-the-fly correction detects this, and tries to compensate for it, but it only succeeds on the average, so the clicks become very uneven. The silly part of all this is that there's really no need for my script and xscreensaver to be competing like crazy for cpu, because my script is using less than 1% of the time-averaged cpu.

All I really want is to be able to make sure that a shell command ("play foo.wav") happens at some well-defined time in the future, even if a cpu-hog process starts butting in. Is there any way to do this? (I also need to get the return value back from the shell command, because when the user hits control-C during the execution of that child process, the signal goes to the child, not the parent.)

This is all on Linux, and I'm not particularly concerned about portability to non-Unix systems, although I'd like it to avoid gratuitous Linuxisms. (I'm also wondering if there's some more portable way to do the equivalent of `date +%s`, which is a GNU extension to the date command.)

Of course I can temporarily kill the xscreensaver daemon, but that's a hassle, and I'll forget to do it. Likewise I could log in as root and run my script as nice --18, but that's obviously a kludge.

TIA!

Since people have requested it, here's my code:

#!/usr/bin/perl

# dependencies:
#   sox ("play" command)
#   festival (text to speech)

use strict;
use POSIX;
use Time::HiRes;

our $ogg_file = "/usr/share/apps/accelerando/sounds/metronome_click.og
+g";
our $click_length = .0507; # seconds, the length of the ogg file
our $decompressed_sound_file = POSIX::tmpnam().'.wav';
         # ...temporary decompressed copy of the ogg file, for efficie
+ncy; 
         # cleaned up in the END block

my $cmd = "sox $ogg_file $decompressed_sound_file";
system($cmd)==0 or die "Error executing this command: $cmd";

# The following only really works if a child process isn't running. If
+ it is, the child gets the signal,
# and we just have to test the return value.
$SIG{INT} = sub{ clean_up()};
$SIG{QUIT} = sub{ clean_up()};

my $player_delay = 0;
  # estimated time to play the wave file, in seconds; this will be upd
+ated later, based on real-time
  # data about how fast we're actually going; on a modern system, putt
+ing this at zero seems to
  # have no observable effect on the tempo

my $initial = ask("Initial tempo",60);
my $timesig = ask("Number of beats per bar",4);
my $bars = ask("Number of bars before increasing the tempo",999999);
my $add = ask("Amount to add to the tempo after the first time",0);
my $between = ask("Beats between changes of tempo",1);

if (1) {
  time_delay(7); # time for the musician to get ready, in seconds
  text_to_speech("ready")==0 or clean_up();
  time_delay(1);
  text_to_speech("go")==0 or clean_up();
  time_delay(1);
}

my $frac = 1+$add/$initial;
print "The tempo will be increased by a factor of $frac each time.\n";
for (my $tempo=$initial; $tempo<500; $tempo*=$frac) {
  print int($tempo)." beats per minute\n";
  text_to_speech(int($tempo))==0 or clean_up();
  my $dt = 60/$tempo;
  my ($t,$last_t);
  for (my $bar=1; $bar<=$bars; $bar++) {
    for (my $beat=1; $beat<=$timesig; $beat++) {
      click()==0 or clean_up();
      my $delay = $dt - $click_length - $player_delay; # seconds
      time_delay($delay); # because sleep() doesn't work for short tim
+es
      $t = clock();
      if (defined $last_t) {
        my $real_dt = $t-$last_t; # amount of time that actually elaps
+ed
        #print "real_dt=$real_dt\n";
        my $correction = $real_dt-$dt; # positive if we fell behind
        if ($correction>.05) {$correction=.05} # don't let it go crazy
+ if the cpu just got busy for a second
        $correction *= .5; # avoid undamped oscillations, etc.
        $player_delay += $correction;
        if ($player_delay<0) {$player_delay=0}
        #print "real_dt=$real_dt, player_delay=$player_delay, corr=$co
+rrection, player_delay=$player_delay\n";
      }
      $last_t = $t;
      }
  }
  time_delay($dt*$between); # seconds
}

exit; # automatically does a clean_up(), in END{} block

#---------------------------------------------------------------------
+-------------

sub time_delay {
  my $t = shift; # seconds
  #select undef,undef,undef,$t; # because sleep() doesn't work for sho
+rt times
  Time::HiRes::usleep($t*1_000_000);
}

sub ask {
  my $prompt = shift;
  my $default = '';
  my $show_default = '';
  if (@_) {$default=shift; $show_default=" ($default)"}
  print "$prompt${show_default}?\n";
  my $answer = <STDIN>;
  chomp $answer;
  if ($answer eq '') {$answer=$default}
  return $answer;
}

sub click {
  my $cmd = "play --silent $decompressed_sound_file"; # --silent means
+ not to print anything to stdout
  my $r= system($cmd);
  if ($r!=0) {print "Return code $r from $cmd\n"}
  return $r;
}


BEGIN {
  my $startup_time = seconds_since_epoch();
  sub clock {
    my $s = seconds_since_epoch();
    return sprintf "%d.%09d",($s-$startup_time),time_nanoseconds();
  }

  sub seconds_since_epoch {
    # return `date +%s`; # GNU only
    my ($s,$usec) = Time::HiRes::gettimeofday();
    return $s;
  }

  sub time_nanoseconds { # the nanoseconds part of the time since the 
+epoch
    # return `date +%N`;
    my ($s,$usec) = Time::HiRes::gettimeofday();
    return $usec*1000;
  }
}

sub text_to_speech {
  my $text = shift;
  my $cmd = "echo '$text' |  festival --tts";
  my $r= system($cmd);
  if ($r!=0) {print "Return code $r from $cmd\n"}
  return $r;
}

sub clean_up {
  unlink $decompressed_sound_file;
  exit;
}

END {
  clean_up();
}

1;
[download]

In reply to making something happen in real time by bcrowell2

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


good chemistry is complicated, and a little bit messy -LW
	PerlMonks