#!/usr/bin/perl

# Copyright (C) 2000  Britton Leo Kerin (fsblk@aurora.alaska.edu)

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

use File::Basename;
use FileHandle;
use Getopt::Long;
use POSIX qw(:errno_h :signal_h :sys_wait_h floor ceil);
use Term::ReadLine;
# Replace the normal time function with one returning a high-res float.
# Don't ask exactly what the resolution is; this is chainsaw real time here.
use Time::HiRes qw ( time );

use strict;
use diagnostics;

my $version = "0.6.0";

my $progname = basename($0);

# Default values for options.
my $ogg_kbitrate = 256;		     # Default 256 kb/s for ogg lossy encoding.
my $channels = 2;
my $audio_device = "/dev/dsp";
my $output_file_format = "cdr";	     # CD mastering format.
my $input_sample_format = "s16_le";  # Signed 16 bit little endian.
my $sampling_rate = 44100;
# Time when recording of the volume was begun (undefined by default).
my $time_of_start;
my $verbose_flg = 0;
my $version_flg = 0;
my $help_flg = 0;

# Option values are stored in a variable of the same name as the long
# option they correspond to, with hyphens converted to underscores,
# and options without arguments set a variable with name of long
# option name with _flg appended.
my %optctl = 
    ("ogg-bitrate" => \$ogg_kbitrate,
     "b" => \$ogg_kbitrate,
     "channels" => \$channels,
     "c" => \$channels, 
     "audio-device" => \$audio_device,
     "d" => \$audio_device,
     "output-file-format" => \$output_file_format,
     "f" => \$output_file_format,
     "input-sample-format" => \$input_sample_format,
     "i" => \$input_sample_format,
     "sampling-rate" => \$sampling_rate,
     "s" => \$sampling_rate,
     "time-of-start" => \$time_of_start,
     "t" => \$time_of_start,
     "verbose" => \$verbose_flg,
     "v" => \$verbose_flg,
     "version" => \$version_flg,
     "help" => \$help_flg,
     "?" => \$help_flg);

unless ( GetOptions(\%optctl, "ogg-bitrate|b=i", "channels|c=i",
		    "audio-device|d=s", "output-file-formats|f=s",
		    "input-sample-formats|i=s", "sampling-rate|s=i",
		    "time-of-start|t=s", "verbose|v", "help|?", "version") ) {
    print STDERR "$progname: option parsing failed.  Try $progname --help\n";
    exit(1);
}

# Some sanity checks on options go here.
unless ( ($ogg_kbitrate > 0) ) {
    print STDERR "$progname: bad kilobit rate (-b or --ogg-bitrate option argument) '$ogg_kbitrate', value must be positive\n";
    exit(1);
}
unless ( ($input_sample_format eq "s16_le") 
               or ($input_sample_format eq "u8") ) {
    print STDERR "$progname: bad input sample format string (-i or --input-sample-format option argument) '$input_sample_format', try '$progname --help'.";
    exit(1);
}
unless ( ($output_file_format eq "cdr") 
               or ($output_file_format eq "flac")
	       or ($output_file_format eq "ogg")
	       or ($output_file_format eq "raw")
	       or ($output_file_format eq "wav") ) {
    print STDERR "$progname: bad output file format string (-f or --output-file-format option argument) '$output_file_format', try '$progname --help'.";
    exit(1);
}

if ( $version_flg ) {
    print <<END_VERSION_INFO;
soundgrab version $version

Copyright (C) 2001 Britton Leo Kerin
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
END_VERSION_INFO
    exit;
}

if ( $help_flg ) {
    print <<END_USAGE_HELP;
usage: $progname [option]... file
Interactively select and export portions of raw audio file to other files.

  -b N,                  use N kb/s when encoding ogg output.  The default
  --ogg-bitrate=N        is 256.

  -c N,                  file contains N-channel data
  --channels=N

  -d DEV,                use audio device DEV instead of default /dev/dsp
  --device=DEV

  -f FMT,                     set default output format to FMT instead of
  --output-file-format=FMT    default default format cdr

  -i FMT,                     input file contains samples with format FMT, 
  --input-file-format=FMT     instead of default format s16_le

  -s N,                  file contains data sampled at N Hz
  --sampling-rate=N

  -t TIME,               time volume recording was started.  See man page 
  --time-of-start=TIME   for the format of the TIME string.

  -v,                    verbose mode
  --verbose

  --version              print version information and exit

  --help                 print this help and exit
END_USAGE_HELP
    exit(0);
}

# The time of day the volume recording was begun, in seconds into the day.
my $volume_start_offset;

# Parse $time_of_start to $volume_start_offset.
if ( defined($time_of_start) ) {
    unless ( defined($volume_start_offset = time_to_offset($time_of_start)) ) {
	print STDERR "$progname: failed to parse option argument '$time_of_start'\n";
	exit(1);
    }
    if ( $volume_start_offset >= 86400 ) {
	print STDERR "$progname: option argument '$time_of_start' had illegal day offset\n";
	exit(1);
    }
}

# After option processing is done, there must be exactly one argument left.
if ( $#ARGV < 0 ) {
    print STDERR "$progname: too few arguments.  Try $progname --help.\n";
    exit(1);
} elsif ( $#ARGV > 0 ) {
    print STDERR "$progname: too many arguments.  Try $progname --help.\n";
    exit(1);
}

# The name of the volume we are grabbing sound from.
my $volume = shift @ARGV;
# Later on we want to be able to verify that the volume hasn't changed
# since we started.
my $last_volume_time_check = time;


if ( !(-e $volume) ) {
    print STDERR "$progname: '$volume' does not exist\n";
    exit(1);
}
if ( !(-r $volume) ) {
    print STDERR "$progname: '$volume' is not readable\n";
    exit(1);
}

# Verify that we have at least the basic required programs on the system.
unless ( `which rawplay` ) {
    print STDERR "$progname: could not find rawrec executable (is rawrec installed somewhere in your PATH?)\n";
    exit(1);
}
unless ( `which sox` ) {
    print STDERR "$progname: could not find sox executable (is sox installed somewhere in your PATH?)\n";
    exit(1);
}

# We can export in more formats if we have these things.
sub have_oggenc {
    if ( `which oggenc` ) {
	return 1;
    } else {
	return 0;
    }
}
sub have_flac {
    if ( `which flac` ) {
	return 1;
    } else {
	return 0;
    }
}

# File name extensions we know about.
my @known_extensions = ('.cdr', '.flac', '.ogg', '.raw', '.wav');
my $known_extensions_pattern = "(\.cdr)|(\.flac)|(\.ogg)|(\.raw)|(\.wav)";

# This is here so it can be documented automaticly, see the doc string
# for the ff or rw command in the commands hash below for an
# explanation of how this works.
my $default_ff_or_rw_arg = 10;

# Interactive commands.
my %commands =
    ('play' => { func => \&com_play, doc => "usage: play
Start playing at the current head position."
               },
     'stop' => { func => \&com_stop, doc => "usage: stop
Stop the head at the current position.  There may be a noticable delay
before playing stops, but the recorded head position should coincide
with the time when the stop command was issued.  Unless your system
was really loaded at the time, in which case it may not.  This is perl
real time we're talking about after all :)"
               },
     'mark' => { func => \&com_mark, doc => "usage: mark
Place the marker at the current head position."
               },
     'name' => { func => \&com_name, doc => "usage: name [NAME]
Name the data between the mark and the current position NAME, or with
a default base name followed by a timestamp corresponding to the start
time of this soundgrab session followed by a new chunk number if no
NAME argument was given.  If you specify a name with extension '.cdr',
'.flac, '.ogg', '.raw', or '.wav', that format will be used when the
chunk is exported (assuming the correct encoder binary is available on
the system), otherwise the output file format set from the command
line or the command line default will be used and the appropriate
extension added.  Existing named chunks of data can be viewed with the
list command."
               },
     'oggment' => { func => \&com_oggment, doc => "usage: oggment NAME [comment COM] [artist ART] [title TITLE] [album ALB]

Add in-file ogg tags to be stored in the file to which chunk name NAME
is to be exported.  These tags persist if the name of the chunk is
changed.  The COM, ART, TITLE or ALB strings should be double quoted.
For example:

oggment some_chunk.ogg comment \"example comment\" artist \"example artist\""
                  },
     'list' => { func => \&com_list, doc => "usage: list
List the names, start offsets, and end offsets of all named chunks.
Offsets are in seconds from the start of the volume being dissected."
               },
     'delete' => { func => \&com_delete, doc => "usage: delete NAME
Delete the chunk named NAME from the chunk list.  This command has no
effect on files, so it doesn't affect chunks which have already been
exported."
                 },
     'changename' => { func => \&com_changename, doc => "usage: changename OLDNAME NEWNAME
Change the name of the chunk named OLDNAME to NEWNAME."
                     },
     'export' => { func => \&com_export, doc => "usage: export
Export all the named chunks of data to files with the appropriate
names, and remove the names from the chunk list."
                 },
     'ff' => { func => \&com_ff, doc => "usage: ff [SECS]
Move the head forward SECS seconds, or the number of seconds moved by
the last ff or rw command if no SECS argument is given, or
$default_ff_or_rw_arg seconds if no SECS argument is given and this is
the first ff or rw command issued.

You can also use units like this: 'f 1d2h3.2m5s' to fast forward 1
day, 2 hours, 3.2 minutes, and five seconds."
             },
     'rw' => { func => \&com_rw, doc => "usage: rw [SECS]
Move the head back SECS seconds, or the number of seconds moved by the
last ff or rw command if no SECS argument is given, or
$default_ff_or_rw_arg seconds if no SECS argument is given and this is
the first ff or rw command issued.

You can also use units like this: 'r 1d2h3.2m5s' to rewind 1 day, 2
hours, 3.2 minutes, and five seconds.
"
             },
     'jump' => { func => \&com_jump, doc => "usage: jump POSITION
Jump head to position POSITION seconds into volume, or to the position
of the mark if the POSITION argument is a single 'm'.

Advanced usage: 

If the -t command line option was used to associate a time with the
start of the volume, jump can take a time for its POSITION argument.
Example position arguments: '15:00', '4:33:20.2p', '4:10' (means 4:10
AM), '12:10' (means 12:10 PM).  If you have a volume longer than 24
hours, you can append +Nd to the time string to refer to the time of
the day N days after the first: '1:35:23.55pm+2d'.

You can also say, for example 'j 1d2h3.2m5s' to jump to a point 1 day,
2 hours, 3.2 minutes, and five seconds into the volume."
               },
     'head' => { func => \&com_head, doc => "usage: head
Show the position and status of the head, as the offset from the
beginning of the volume."
               },
     'checkmark' => { func => \&com_checkmark, doc => "usage: checkmark
Show the position of the mark, as the offset from the beginning of the
volume out of the total volume length in seconds."
                    },
     'browse' => { func =>\&com_browse, doc => "usage: browse [PLAY SKIP]
Start browsing.  When browsing, the player head will repeatedly play
PLAY seconds worth of data, then skip SKIP seconds worth.  The head
always starts over by playing PLAY seconds worth after being moved or
stopped by a user command.  If no arguments are supplied browsemode
remembers the values of PLAY and SKIP it used last time and uses them
again, or if there isn't a last time, uses the values 10 and 100.

To stop browsing, just use the stop or play commands.

It can be hard to be sure when browsing exactly where the head was
when a given command (mark, stop, ff, etc.) took effect, so an
informative message is displayed if soundgrab notices that the head is
near the beginning or end of a PLAY section when such a command is
issued."
                 },
     'help' => { func => \&com_help, doc => "usage: help [COMMAND_NAME]
Display help on command COMMAND_NAME, or general help if no
COMMAND_NAME argument is given."
               },
     '?' => {func => \&com_help, doc => "Synonym for 'help'."
            },
     'quit' => { func => \&com_quit, doc => "Quit $progname."
             }
    );

# Default base name for export commands with arguments. 
my @session_time = localtime;
my $output_basename = "$progname"."_session_".($session_time[5]+1900)."-"
    .($session_time[4]+1)."-".$session_time[3]."-".$session_time[2]."-"
    .$session_time[1]."-".$session_time[0];

my $term = new Term::ReadLine::Gnu 'soundgrab';

# Tell the completer that we want to try completion ourselves first.
$term->Attribs->{attempted_completion_function} = \&soundgrab_completion;

# Turn off all internal fontification and such.
$term->Term::ReadLine::Gnu::ornaments(0);

# Disable implicit calls of add_history().
$term->MinLine(0);

my $prompt = $progname."> ";

# The size of the volume in bytes.
my $volume_size = (stat $volume)[7];

# Bits in a single one channel sample.
my $bps;
if ( $input_sample_format eq "s16_le" ) {
    $bps = 16;
} elsif ( $input_sample_format eq "u8" ) {
    $bps = 8;
} else {
    print STDERR "$progname: $input_sample_format: unknown input-sample-format\n";
    exit(1);
}

# The length of the volume in seconds.
my $volume_length = $volume_size * 8 / ( $bps * $sampling_rate * $channels);

# The position of the mark, in seconds from the beginning of the volume.
my $mark_pos;

# The next com_name will use extension "_chunk$chunknum" if no FILE is given.
my $chunknum = 1;

# The number of seconds the last ff or rw command moved by the head
# (if ff or rw have not yet been used, this initialization constitutes
# the default for the first use if no argument is given).
my $last_ff_or_rw_arg = $default_ff_or_rw_arg;

# This gets set when the user uses the quit command.
my $done = 0;

# The time as returned by the time function from Time::HiRes when
# rawplay was last invoked.  Used later with $last_pos and another
# time call to determine the position in the volume at any point in
# time.  start_time is undefined until a play command is issued.
my $start_time;

# The last known position of the player, in seconds into the
# volume. This is *not* continually updated, only when playing or
# browsing stops due to a user command or the natural completion of a
# rawplay process, so its wrong almost all the time.
my $last_pos = 0;

# True if the volume is currently being played, false otherwise.
my $playing_flag = 0;

# True if browse mode is activated.
my $browsemode = 0;
# Time to play in browse mode.
my $browse_play_time = 10;
# Time to skip between plays in browse mode.
my $browse_skip_time = 100;
# The user gets a status message indicating where the head was when some
# commands are executed when the head is close to the edge of a browse
# play section, this controls how close to the edge the user has to be
# to get the message.
my $browse_em;

# pid of the currently running rawplay process.
my $rawplay_pid;

# Name indexed hash of six-element arrays storing the starting and
# ending positions, and ogg comment fields, of chunks the user has
# named with the name command.  Because IDE disks at least arn't up to
# doing saves in the background while trying to play other parts of
# the volume, too much latency for timing to work right.
my %names;

# pid of the export commands current process.
my $export_pid;

# Watch for our rawplay child to die so we know for sure when we can
# safely start another rawplay.  Note that SIGCHLD is blocked during
# the actual execution of all the user commands, since they modify or
# test some of the variables used in this handler, and do forks and
# waitpids of their own.
my $sigset_sigchld = POSIX::SigSet->new(SIGCHLD);
my $old_sigset = POSIX::SigSet->new;
my $sigchld_action = POSIX::SigAction->new('main::REAPER', $sigset_sigchld);
sigaction(SIGCHLD, $sigchld_action);
sub REAPER {
    while ( (my $stiff = waitpid(-1, WNOHANG)) > 0 ) {
        if ( (defined($rawplay_pid)) and ($stiff == $rawplay_pid) ) {
            # Handle the case where rawplay exited normally by coming
            # to the end of the volume.  The user stop command sets
            # $playing_flag to 0, so if it is still set at this point
            # we know we are in this handler because we got to the end
            # of the volume.  Otherwise, $last_pos has already been
            # set before the kill $rawplay_pid to assure the head is
            # positioned as close to the point where the user
            # requested the stop as possible.
	    if ( $playing_flag ) {
	        $last_pos = $volume_length;
		$playing_flag = 0;
	    }
            if ( $browsemode ) {
                if ( $last_pos + $browse_play_time + $browse_skip_time
                               >= $volume_length ) {
                    $last_pos = $volume_length;
                    $browsemode = 0;
                } else {
                    $last_pos += $browse_play_time + $browse_skip_time;
                    &browse_play;
		}
	    }
	}
    }
}

# Main input loop.
while ( $done == 0 ) {
    my $line = $term->readline($prompt);
    last unless defined $line;
    my $unspaced_line = stripwhite($line);
    my @commands_on_line = split(/;/, $unspaced_line);
    foreach my $command ( @commands_on_line ) {
	my $unspaced_command = stripwhite($command);
	# Unless the command was empty, execute it.
	if ( $unspaced_command ) {
	    execute_command($unspaced_command);
	}
    }    
    # The whole potentially compound command goes in the history, if
    # we have made it this far.
    if ( $unspaced_line ) {
	# Normally this is done implicitly by readline.
	$term->AddHistory($unspaced_line);
    }
}

exit(0);

# Execute a command.
sub execute_command {
    my $line = shift;
    my ($word, @arg) = split(' ', $line);
    my $command = find_command($word);

    unless ( $command ) {
        print STDERR "$word: no such command or unambiguous command abreviation in soundgrab, try help.\n";
        return 0;
    }

    # Issue dire warnings if the volume appears to have been screwed with.
    &volume_sanity_check($volume);

    # Block delivery of SIGCHLD during user command execution.
    unless ( defined sigprocmask(SIG_BLOCK, $sigset_sigchld, $old_sigset) ) {
        die "$progname: could not block SIGCHLD\n";
    }

    # The value returned by the function corresponding to the command.
    # Commands use shell type return convention, i.e. they return
    # non-zero when there's a problem.
    my $command_func_return_value = &{$command->{func}}(@arg);
    # Unblock SIGCHLD.
    unless ( defined sigprocmask(SIG_UNBLOCK, $sigset_sigchld) ) {
        die "$progname: could not unblock SIGCHLD\n";
    }
    return $command_func_return_value;
}

# Look up command by NAME and return pointer to command, or null if
# NAME isn't a complete command name and we can't successfully and
# unambiguously complete it.
sub find_command {
    my $name = shift;
    unless ( defined($commands{$name}) ) {
	my @candidates = &soundgrab_completion($name, $name, 0, length($name));
        # if exactly one possible command completion
	if ( $#candidates == 0 ) {
	    return $commands{$candidates[0]}
	} else {
	    return undef;
	}
    } else {
	return $commands{$name};
    }
}

# Strip whitespace from the start and end of STRING.
sub stripwhite {
    my $string = shift;
    $string =~ s/^\s*//;
    $string =~ s/\s*$//;
    return $string;
}

# Attempt to complete the contents of TEXT.  START and END bound the
# region of rl_line_buffer that contains the word to complete.  TEST
# is the word to complete.  We can use the entire contents of
# rl_line_buffer in case we want to do some simple parsing.  Return
# the array of matches, or NULL if there aren't any.
sub soundgrab_completion {
    my ($text, $line, $start, $end) = @_;
    my @matches = ();

    # If this word is the first non-whitespace on the line, then it is
    # a command to complete.  Next we try to complete the name of a
    # currently defined chunk.  If that fails, and if I'm understandig
    # things correctly, readlines implicit complete takes over from
    # soundgrab_completion and we may end up completing the name of a
    # file in the current directory.

    # I didn't like this example
#   @matches = $term->completion_matches ($text, \&command_generator)
#       if ($start == 0);
    # since it behaves differently with a single leading white space
    # on the command line.  So I changed it so it looks for a command
    # to complete whenever $text is the first space delimited token on
    # $line.
    if ( substr($line, 0, $start) =~ /^\s*$/ ) {
	@matches = $term->completion_matches($text, \&command_generator);
    } else {
        @matches = $term->completion_matches($text, \&chunkname_generator);  
    }

    return @matches;
}


# Generator functions for command completion.  STATE lets us know
# whether to start from scratch; without any state (i.e. STATE == 0),
# then we start at the top of the list.

# Term::ReadLine::Gnu has a list_completion_function similar to this
# function.
{
    my $list_index;
    my @name;

    sub command_generator {
	my ($text, $state) = @_;

	# If this is a new word to complete, initialize now.  This
        # includes saving the length of TEXT for efficiency, and
        # initializing the index variable to 0.
	unless ( $state ) {
	    $list_index = 0;
	    @name = keys(%commands);
	}

	# Return the next name which partially matches from the command list.
        while ( $list_index <= $#name ) {
	    $list_index++;
	    if ($name[$list_index - 1] =~ /^$text/) {
		return $name[$list_index - 1];
	    }
	}

	# If no names matched, then return NULL.
	return undef;
    }
}

# Generator function for chunkname completion.
{
    my $list_index;
    my @name;

    sub chunkname_generator {
	my ($text, $state) = @_;
	# If this is a new word to complete, initialize now.  This
        # includes saving the length of TEXT for efficiency, and
        # initializing the index variable to 0.
	unless ( $state ) {
	    $list_index = 0;
	    @name = keys(%names);
	}

	# Return the next name which partially matches from the command list.
        while ( $list_index <= $#name ) {
	    $list_index++;
	    if ($name[$list_index - 1] =~ /^$text/) {
		return $name[$list_index - 1];
	    }
	}

	# If no names matched, then return NULL.
	return undef;
    }
}

# Start play mode from stopped mode or browse mode.
sub com_play {
    # Argument processing.
    if ( @_ ) {
        print STDERR "play: play does not take any arguments\n";
	return(1);
    }

    if ( $playing_flag ) {
        print STDERR "play: the volume is already being played\n";
    } else {
        if ( $browsemode ) {
	    my $stop_pos = $last_pos + &tdelta;
            if ( $stop_pos - $last_pos < $browse_em ) {
                print "Entering play mode from near the beginning of a played browse section.\n";
            } elsif ( $stop_pos - $last_pos > $browse_play_time
                                              - $browse_em ) {
                print "Entering play mode from near the end of a browse section.\n";
	    }
            &stop_core;
        }
	undef $rawplay_pid;
	$rawplay_pid = fork;
	unless ( defined($rawplay_pid) ) {
	    die "$progname: couldn't fork: $!\n";
	} elsif ( $rawplay_pid == 0 ) {	# child
	    exec "rawplay -B 262144 -c $channels -d $audio_device -f $input_sample_format -s $sampling_rate -j $last_pos $volume" or die "$progname: couldn't exec: $!\n";
	} else { # parent
	    $start_time = time;
	    $playing_flag = 1;
	}
    }

    return(0);
}

sub com_stop {
    # Argument processing.
    if ( @_ ) {
        print STDERR "stop: stop does not take any arguments\n";
	return(1);
    } 

    if ( !($playing_flag) and !($browsemode) ) {
	print STDERR "stop: already stopped $last_pos seconds into volume\n";
    } else {
        if ( $browsemode ) {
	    my $stop_pos = $last_pos + &tdelta;
            # Note with these messages we are lying to the user a bit, since 
            # we haven't yet done the actual stop, but the message is much 
            # more intelligable this way.
            if ( $stop_pos - $last_pos < $browse_em ) {
                print "Player stopped near the beginning of a played browse section.\n";
            } elsif ( $stop_pos - $last_pos > $browse_play_time
                                              - $browse_em ) {
                print "Player stopped near the end of a played browse section.\n";
	    }
	}
        &stop_core;
    }

    return(0);
}

# The core stop function.  Many other commands used to call com_stop,
# but that now does a little more checking than we want the commands
# which need to stop the player to use.
sub stop_core {
    $last_pos = $last_pos + &tdelta;
    $playing_flag = 0;
    $browsemode = 0;
    # rawplay might exit between the check on playing flag and this 
    # point, so we check to be sure we have successfully signaled 
    # before doing blocking waitpid.  I think this is not required 
    # since SIGCHLD is blocked during user command execution and 
    # there is therefore no chance of the handler reaping the child, 
    # but it doesn't hurt to be paranoid.
    if ( kill 'TERM', $rawplay_pid ) {
        waitpid $rawplay_pid, 0;
    }
}

# Place the mark at the current position of the head in volume.  The
# mark works as in emacs, i.e. there can be only one mark at a time,
# and the export command works between the mark and the current
# position.
sub com_mark {
    # Argument processing.
    if ( @_ ) {
        print STDERR "mark: mark does not take any arguments\n";
	return(1);
    } 

    if ( $playing_flag or $browsemode ) {
        $mark_pos = $last_pos + &tdelta;
    } else {
        $mark_pos = $last_pos;
    }
    if ( $browsemode ) {
        if ( $mark_pos - $last_pos < $browse_em ) {
            print "Mark placed near the beginning of a played section.\n";
        } elsif ( $mark_pos - $last_pos > $browse_play_time - $browse_em ) {
            print "Mark placed near the end of a played section.\n";
        }
    }

    return(0);
}

# Name the data between the mark and the current position of the head.
sub com_name {
    my $out_name = shift;
    if ( defined($out_name) and defined(shift) ) {
        print STDERR "name: too many arguments\n";
        return(1);
    }
    my $pos_now;		# up to date position of head
    if ( $playing_flag or $browsemode ) {
        $pos_now = $last_pos + &tdelta;
    } else {
	$pos_now = $last_pos;
    }

    # We must have an appropriate mark on the volume.
    unless ( defined($mark_pos) ) {
	print STDERR "name: the mark has not yet been placed on the volume\n";
	return(1);
    } 
    unless ( abs($pos_now - $mark_pos) >= 0.05 ) {
	print STDERR "name: current head position is less than 1/20 second away from mark position, this is less than the operating resolution of $progname\n";
	return(1);
    }

    # Unless the name command was given an argument, choose default name.
    unless ( defined $out_name ) {
	$out_name = $output_basename."_chunk".$chunknum++;
    }

    # Other commands (as of Mon Apr 23 2001, changename) name chunks.
    $out_name = &name_chunk_core($out_name);

    # If browsing, make sure user know where the head was when name went off.
    if ( $browsemode ) {
        if ( $pos_now - $last_pos < $browse_em ) {
            print "Chunk being named has endpoint near the beginning of a played section.\n";
        } elsif ( $pos_now - $last_pos > $browse_play_time - $browse_em ) {
            print "Chunk being named has endpoint near the end of a played section.\n";
        }
    }  

    # We don't want to change the current position or the mark
    # position, but if the head is actually before the mark, we
    # need to define the starting and ending points of the chunk
    # we are about to export differently.
    my $chunk_start;
    my $chunk_end;
    if ( $mark_pos < $pos_now ) {
	$chunk_start = $mark_pos;
	$chunk_end = $pos_now;
    } else {
	$chunk_start = $pos_now;
	$chunk_end = $mark_pos;
    }

    # Last four elements are ogg comments, they are filled by another
    # command.
    $names{$out_name} = [$chunk_start, $chunk_end, "", "", "", ""];

    return(0);
}

# Common code currently (Mon Apr 23 2001) shared between com_name and
# com_changename.  Barely worth having common, weird looks for ogg
# comments which are the last args to both commands.
sub name_chunk_core {
    # First argument is the name we hope to use.
    my $out_name = shift;

    # fileparse from File::Basename to check for legit path and known
    # extension.
    my ($fname, $path, $suffix) = fileparse($out_name, @known_extensions);

    # path portion of file name must already exist and be executable
    # to us, so we can create files there later.
    while ( !(-e $path) or !(-w $path and -x $path) ) {
	my $gripe_string;
	if ( !(-e $path) ) {
	    $gripe_string = "Path
$path
does not exist.  Try another name: ";
	} else { # must be here because !(-w $path and -x $path)
	    $gripe_string = "No permission to create files in
$path
Try another name: ";
	}
	$out_name = stripwhite($term->readline($gripe_string));
	# look for a legit path.
	($fname, $path, $suffix) = fileparse($out_name, @known_extensions)
    }

    # unless we have a known extension, use the output format from
    # the command line or the command line default
    unless ( $suffix =~ /$known_extensions_pattern/ ) {
	$out_name .= ".".$output_file_format;
    }

    # If we can't deal with files of the type corresponding to the
    # suffix we see, warn user and add default extension.
    if ( ($suffix =~ /\.ogg/) and (!&have_oggenc) ) {
	print STDERR "$progname: warning: oggenc executable not found, adding extension for default output file type to chunk name\n";
	$out_name .= ".".$output_file_format;
    }
    if ( ($suffix =~ /\.flac/) and (!&have_flac) ) {
	print STDERR "$progname: warning: flac executable not found, adding extension for default output file type to chunk name\n";
	$out_name .= ".".$output_file_format;
    }

    # If a chunk with the name we are trying to give the current chunk
    # already exists, or if a file with a name the same as the chunk
    # name we are trying to create already exists, see if the user
    # wants to pick another name.
    while ( (-e $out_name) or (defined($names{$out_name})) ) {
	my $pick_new = 0;	# True if we decide we want to pick a new name
	# Should we change the definition of a name that already exists?
	if ( defined($names{$out_name}) ) {
	    my $own = $term->readline("Another chunk has already been named
$out_name
Pick a different name (Y/n)? ");
	    unless ( $own =~ /^(\s*[nN]\s*)$/ ) {
		$pick_new = 1;
	    }
	} else {
	    # Should we pick a name that threatens to overwrite an
	    # existing file when the export command is run?
	    my $ow = $term->readline("A file with name
$out_name
already exists.  Pick a different name (Y/n)? ");
	    unless ( $ow =~ /^(\s*[nN]\s*)$/ ) {
		$pick_new = 1;
	    }
	}
	if ( $pick_new ) {
	    $out_name = stripwhite($term->readline("New name: "));
	    # unless we have a known extension, use the output format from
	    # the command line or the command line default
	    unless ( $out_name =~ /($known_extensions_pattern)$/ ) {
		$out_name .= ".".$output_file_format;
	    }
	} else {
	    last;
	}
    }

    return $out_name;
}

# Set ogg in-file comment fields for a named chunk.
sub com_oggment {
    # First argument is chunk name we are adding comments to.
    my $arg = shift;
    unless ( defined($names{$arg}) ) {
        print STDERR "oggment: no chunk named
$arg
is currently defined\n";
        return(1);
    }
    unless ( $arg =~ /\.ogg$/ ) {
        print STDERR "oggment: the chunk name
$arg
will not be exported in ogg format (wrong extension)\n";
	return(1);
    }

    # Parse remaining comment arguments.
    while ( defined(my $com_option = shift) ) {
        unless ( $com_option =~ /(comment)|(artist)|(title)|(album)/ ) {
            print STDERR "oggment: $com_option: unrecognized argument\n";
            return(1);
        }
	my $com_arg = shift;
        unless ( defined($com_arg) ) {
            print STDERR "oggment: argument $com_option needs an argument of its own\n";
            return(1);
	}
        # If we have an opening quote, but not a closing one, get the
        # rest of the quoted string.
        if ( $com_arg =~ /^\".*[^\"]$/ ) {
            until ( $com_arg =~ /^\".*\"$/ ) {
                my $com_appendage = shift;
                # If we run out of command without getting the closing quote...
                unless ( defined($com_appendage) ) {
                    print STDERR "oggment: mismatched double quotes\n";
                    return(1);
                }
		$com_arg .= " ".$com_appendage;
            }
	}

        # If the string was unquoted, quote it.
        if ( $com_arg !~ /^\".*\"$/ ) {
            $com_arg = "\"".$com_arg."\"";
        }

        # If we have a quote inside our quoted string, puke.
        if ( $com_arg =~ /^\".*\".*\"$/ ) {
            print STDERR "oggment: confused by double quoting and spaces, please try 'help oggment'\n";
            return(1);
	}

        # Spaces in comment strings are defensive programming.
        if ( $com_option =~ /comment/ ) {
            $names{$arg}[2] = " --comment=$com_arg ";
	} elsif ( $com_option =~ /artist/ ) {
            $names{$arg}[3] = " --artist=$com_arg ";
        } elsif ( $com_option =~ /title/ ) {
            $names{$arg}[4] = " --title=$com_arg ";
        } elsif ( $com_option =~ /album/ ) {
            $names{$arg}[5] = " --album=$com_arg ";
        }
    }

    return(0);
}

# List all the currently defined chunks.
sub com_list {
    # Argument processing.
    if ( @_ ) {
        print STDERR "list: list does not take any arguments\n";
	return(1);
    }

    if ( !%names ) {
	print "No unexported named chunks are currently defined. \n";
	return(0);
    }

    my $chunkname;
    my $chunkstart;
    my $chunkend;

format LIST_TOP =
Chunk Name                                            Start           End
--------------------------------------------       --------      --------
.

format LIST =
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       @####.##      @####.##
$chunkname, $chunkstart, $chunkend
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
$chunkname
.

    STDOUT->format_name("LIST");
    STDOUT->format_top_name("LIST_TOP");
    # We are using this interactively, no formfeeds wanted.
    $^L = "";

    foreach my $name ( sort keys %names ) {
	$chunkname = $name;
	$chunkstart = $names{$name}[0];
	$chunkend = $names{$name}[1];
	write;
    }

    # Force a new form to be started by the next write.
    $- = 0;

    STDOUT->format_name("STDOUT");
    STDOUT->format_top_name("STDOUT_TOP");

    return(0);
}

# Delete a chunk from the list of named chunks.
sub com_delete {
    my $arg = shift;
    unless ( defined($arg) ) {
	print STDERR "delete: at least one argument required\n";
	return(1);
    }

    my @delete_list;		# Chunks to be deleted.

    # Verify arguments and build deletion list.
    while ( defined($arg) ) {
	unless ( defined($names{$arg}) ) {
	    print STDERR "delete: no chunk named
$arg
is currently defined, not deleting anything\n";
	    return(1);
	}
        push(@delete_list, $arg);
	$arg = shift;
    }

    # Delete chunks.
    while ( defined(my $crnt_name = pop(@delete_list)) ) {
	delete $names{$crnt_name};
    }

    return(0);
}

# Change the name of an existing chunk.
sub com_changename {
    # Process the first two command arguments.
    my $arg1 = shift;
    my $arg2 = shift;
    unless ( defined($arg1) ) {
        print STDERR "changename: two arguments required\n";
        return(1);
    }
    unless ( defined($names{$arg1}) ) {
        print STDERR "changename: no chunk named
$arg1
is currently defined\n";
        return(1);
    }
    unless ( defined($arg2) ) {
        print STDERR "changename: two arguments required\n";
        return(1);
    }
    if ( defined(shift) ) {
        print STDERR "changename: too many agruments\n";
	return(1);
    }

    # New name to use.
    my $new_name = &name_chunk_core($arg2);

    # In with the new name, out with the old.
    $names{$new_name} = $names{$arg1};
    delete $names{$arg1};

    return(0);
}

# Export all the named chunks to files.
sub com_export {
    # Argument processing.
    if ( @_ ) {
        print STDERR "export: export does not take any arguments\n";
	return(1);
    }

    # If playing or browsing, stop doing so, to give the drive a break.
    my $were_playing = 0;
    if ( $playing_flag ) {
	$were_playing = 1;
	print "Stopping player while exporting (give your drive a break).\n";
	&stop_core;
    }
    my $were_browsing = 0;
    if ( $browsemode ) {
        $were_browsing = 1;
        print "Stopping browse while exporting (give your drive a break).\n";
        &stop_core;
    }

    # In a token effort at efficiency, we use bs of about 50 for dd,
    # on the assumption that 1/100 of a second more or less isn't
    # likely to matter.  It is critical that the blocksize actually
    # used in the dd command be aligned with respect to the size of
    # the raw samples, i.e. wrt (($bps / 8) * $channels).
    my $blocksize = 50;
    $blocksize += (($bps / 8) * $channels)
                  - $blocksize % (($bps / 8) * $channels);

    # For each named chunk...
    foreach my $name ( sort keys %names ) {

	# Get the components of the name we are exporting to.
	my ($fname, $path, $suffix) = fileparse($name, @known_extensions);

	# Guard agains some fs changes.
	if ( !(-e $path) ) {
	    print "Directory
$path
does not exist.  Skipping this named chunk.\n";
            next;
	}
	if ( !(-w $path and -x $path) ) {
	    print "No permission to create
$fname$suffix
in
$path
Permissions must have changed since you named this chunk, skipping it.\n";
	    next;
	}

	# For convenience and clarity, unpack values from array.
	my $chunk_start = $names{$name}[0];
	my $chunk_end = $names{$name}[1];
	# blocks to skip at beginning of volume.
	my $skip = floor($chunk_start * $sampling_rate * $bps * $channels
			 / (8 * $blocksize));
	# blocks to copy to argument of export command.
	my $count = ceil((($chunk_end - $chunk_start) * $sampling_rate * $bps
			   * $channels ) / ( 8 * $blocksize));

	# Try to detect and behave sensibly if the user doesn't have
	# the disk space to export the current file at the moment:
	my $space_needed;
	my $space_margin;
	if ( $suffix =~ /(\.cdr)/ ) {
	    $space_needed = ($chunk_end - $chunk_start) * 44100 * (16 / 8)
                            * 2 / 1024;
	    $space_margin = (2 * $blocksize + 100000) / 1024;
	} elsif ( $suffix =~ /(\.flac)/ ) {
	    # Flac always seems to achieve at least 0.55 compression factor.
	    $space_needed = 0.55 * ($chunk_end - $chunk_start) * 44100 
		            * (16 / 8) * $channels / 1024;
            $space_margin = $space_needed * (0.2); # compression factor varies
	} elsif ( $suffix =~ /(\.ogg)/ ) {
            # Here I assume kbit in ogg refers to 1024 bits, not 1000.
            # Close enough.  Also, this assumes encoding uses the
            # specified kbit rate regardless of number of channels.
	    $space_needed = ($chunk_end - $chunk_start) * ($ogg_kbitrate * 1024 / 8);
	    $space_margin = $space_needed * (0.2); # compression factor varies
	} elsif ( $suffix =~ /(\.raw)/ ) {
	    $space_needed = ($chunk_end - $chunk_start) * $sampling_rate
		            * ($bps / 8) * $channels / 1024;
	    $space_margin = (2 * $blocksize) / 1024;
	} elsif ( $suffix =~ /(\.wav)/ ) {
	    # Like for raw, above, but more paranoid because I don't know much
            # about wavs.
	    $space_needed = ($chunk_end - $chunk_start) * $sampling_rate
		            * ($bps / 8) * $channels / 1024;
	    $space_margin = (2 * $blocksize + 100000) / 1024;
	}

	if ( $space_needed >= (split(/\s+/, `df --portability $path`))[10] 
	                      - $space_margin ) {
	    chop(my $crnt_date = `date`);
	    my $continue_low_space = $term->readline("You probably don't have enough disk space for:
$name
at the moment ($crnt_date).  Try to export it anyway (y/N)? ");
	    unless ( $continue_low_space =~ /^(\s*[yY]\s*)$/ ) {
		next;
	    }
	}

	# Now we construct the command string which will do the work
        # exporting this chunk.  The standard error of dd gets thrown
        # away because it writes status information we don't want to see
        # there.
	my $system_arg = "dd if=$volume bs=$blocksize skip=$skip count=$count  2>/dev/null | ";
	my $sox_args;
	if ( $input_sample_format eq "s16_le" ) {
	    $sox_args = "-t sw ";
	} elsif ($input_sample_format eq "u8" ) {
	    $sox_args = "-t ub ";
	}
	$sox_args .= "-r $sampling_rate -c $channels - ";

	# Currently, we let sox use the extension of the $output_file
	# to determine the format to convert to, unless the output
	# format is to be raw data, in which case we use the format
	# used for the argument file, or ogg or flac encoded data, in
	# which case we convert to a reasonable format with sox and
	# let the appropriate encoder take it from there.
	if ( $name =~ /(\.raw)$/ ) {
	    # Actually, there is no good reason to use sox at all here, we
            # are just piping the data throuh unchanged.
	    if ( $input_sample_format eq "s16_le" ) {
		$sox_args .= "-t sw ";
	    } elsif ($input_sample_format eq "u8" ) {
		$sox_args .= "-t ub ";
	    }
	}

	# Both oggenc and flac can now accept things in various raw
	# forms, stop depending on sox to (possibly) resample?  At the
	# moment, I think I trust sox most to do this reasonably well.
	if ( $name =~ /(\.flac)|(\.ogg)$/ ) {
	    $sox_args .= "-r 44100 -c $channels -t sw - | ";
	} else {
	    $sox_args .= "$name ";
	}
	$system_arg .= "sox $sox_args ";

	if ( $name =~ /(\.flac)$/ ) {
	    $system_arg .= "flac -s -V -fl -fc $channels -fp 16 -fs 44100 -o $name -";
	}

        if ( $name =~ /(\.ogg)$/ ) {
	    $system_arg .= "oggenc --raw --raw-chan=$channels --bitrate=$ogg_kbitrate --quiet --output=$name $names{$name}[2] $names{$name}[3] $names{$name}[4] $names{$name}[5] -";
	}

        if ( $name =~ /(\.flac)|(\.ogg)$/ ) {
	    print "Encoding and writing \"$name\"... ";
	} else {
	    print "Writing \"$name\"... ";
	}
	$export_pid = fork;
	unless ( defined($export_pid) ) {
	    die "$progname: couldn't fork: $!\n";
	} elsif ( $export_pid == 0 ) { # child
	    # Make this intense stuff as nice as possible.
	    setpriority 0, 0, 20;
	    # Note that this doesn't really trap many of the many many
            # things that could be wrong with this exec.
	    exec "$system_arg" or die "export: exec($system_arg) failed\n";
	} else {		       # parent
	    waitpid $export_pid, 0;
	    print "done.\n";
	    delete $names{$name};
	}
    }

    # Resume playing or browsing if we were before the export command.
    if ( $were_playing ) {
	print "Player restarted.\n";
	&com_play;
    }
    if ( $were_browsing ) {
        print "Browse restarted.\n";
        &com_browse;
    }

    return(0);
}

# Immediately move the head forward $arg seconds, or the number of
# seconds given as the argument to the last ff or rw command if no
# argument was included for this command, or the default initialized
# value of $last_ff_or_rw_arg seconds if this is the first use of ff
# or rw and no argument is given.
sub com_ff {
    my $arg = shift;
    unless ( defined $arg ) {
	$arg = $last_ff_or_rw_arg;
    }

    my $ff_secs;		# Argument cooked to time in seconds.
    unless ( defined($ff_secs = &quantity_time_to_seconds($arg)) ) {
	print STDERR "ff: don't know how to handle argument: $arg\n";
	return(1);
    }

    if ( defined(shift) ) {
        print STDERR "ff: too many arguments\n";
        return(1);
    }

    $last_ff_or_rw_arg = $ff_secs;
    if ( $playing_flag ) {
	# Recall that stop_core updates $last_pos to $last_pos + &tdelta
	&stop_core;
	if ( $last_pos + $ff_secs >= $volume_length ) {
	    $last_pos = $volume_length;
	    print "Stopped at end of volume.\n";
	} else {
	    $last_pos += $ff_secs;
	    &com_play;
	}
    } elsif ( $browsemode ) {
        my $ff_start_point = $last_pos + &tdelta;
        if ( $ff_start_point - $last_pos < $browse_em ) {
            print "Fast forward begun from near the beginning of a played section.\n";
        } elsif ( $ff_start_point - $last_pos > $browse_play_time
                                                - $browse_em ) {
            print "Fast forward begun from near the end of a played section.\n";
        }
        &stop_core;
        if ( $last_pos + $ff_secs >= $volume_length ) {
            $last_pos = $volume_length;
            print "Stopped at end of volume.\n";
        } else {
            $last_pos += $ff_secs;
            &com_browse;
        }
    } else {
	if ( ($last_pos += $ff_secs) > $volume_length ) {
	    $last_pos = $volume_length;
	    print "Stopped at end of volume.\n";
	}
    }

    return(0);
}

# Immediately move the head backward $arg seconds, or the number of
# seconds moved by the last ff or rw command, or the default
# initialized value of $last_ff_or_rw_arg seconds if this is the first
# use of ff or rw.
sub com_rw {
    my $arg = shift;
    unless ( defined $arg ) {
	$arg = $last_ff_or_rw_arg;
    }

    my $rw_secs;		# Argument cooked to time in seconds.
    unless ( defined($rw_secs = &quantity_time_to_seconds($arg)) ) {
	print STDERR "rw: don't know how to handle argument: $arg\n";
	return(1);
    }

    if ( defined(shift) ) {
        print STDERR "rw: too many arguments\n";
        return(1);
    }

    # Well this shows bogosity of having ff or rw remember the last
    # arg.  If user request rw 100 from pos 10, then should next ff be
    # 10 or 100?  No good answer.
    $last_ff_or_rw_arg = $rw_secs;
    if ( $playing_flag ) {
	&stop_core;
	if ( ($last_pos -= $rw_secs) < 0 ) {
            $last_pos = 0;
	    print "Rewind stopped at beginning of volume.\n";
        } 
	&com_play;
    } elsif ( $browsemode ) {
        my $rw_start_point = $last_pos + &tdelta;
        if ( $rw_start_point - $last_pos < $browse_em ) {
            print "Rewind begun from near the beginning of a played section.\n";
        } elsif ( $rw_start_point - $last_pos > $browse_play_time
                                                - $browse_em ) {
            print "Rewind begun from near the end of a played section.\n";
        }
        &stop_core;
        if ( ($last_pos -= $rw_secs) < 0 ) {
	    $last_pos = 0;
            print "Rewind stopped at beginning of volume.\n";
        }
	&com_browse;
    } else {
	if ( ($last_pos -= $rw_secs) < 0 ) {
            $last_pos = 0;
	    print "Rewind stopped at beginning of volume.\n";
        }
    }

    return(0);
}

# Jump the head to the position given as an argument.
sub com_jump {
    my $arg = shift;
    unless ( defined($arg) ) {
	print STDERR "jump: argument required\n";
	return(1);
    }
    if ( defined(shift) ) {
        print STDERR "jump: too many arguments\n";
        return(1);
    }

    # The value of the argument as an offset.
    my $offset;

    # Turn the argument into an offset.

    if ( $arg eq "m") {
	# Translate 'm' to the mark position if possible.
        if ( defined($mark_pos) ) {
          $offset = $mark_pos;
        } else {
          print STDERR "jump: 'm' given as argument but the mark has not been placed yet\n";
          return(1);
        }
    } elsif ( $arg =~ /:/ ) {
	# Translate a time argument to an offset if possible.
	my $day_offset;		# value of arg in seconds from start of day.
	unless ( defined($time_of_start) ) {
	    print STDERR "jump: '$arg' looks like a time string, but the start time of the volume was not set with the -t command line option\n";
	    return(1);
	}
	unless ( defined(my $day_offset = &time_to_offset($arg)) ) {
	    print STDERR "jump: failed to convert argument which looked like a TIME string (it contained a colon) to an offset\n";
	    return(1);
	} else {
	    $offset = $day_offset - $volume_start_offset;
	    if ( ($offset < 0) or ($offset > $volume_length) ) {
		print STDERR "jump: TIME argument '$arg' is not in this volume, given command line option argument '$time_of_start'\n";
		return(1);
	    }
	}
    } else {
	# Tranlate a quantitfy of time with units to an offset if possible.
	unless ( defined($offset = &quantity_time_to_seconds($arg)) ) {
	    print STDERR "jump: don't know how to handle argument: $arg\n";
	    return(1);
	} 
    }

    if ( ($offset < 0) or ($offset > $volume_length) ) {
	print STDERR "jump: $arg: not a valid offset from the beginning of the volume\n";
	return(1);
    }

    if ( $playing_flag ) {
	&stop_core;
	$last_pos = $offset;
	&com_play;
    } elsif ( $browsemode ) {
        &stop_core;
        $last_pos = $offset;
        &com_browse;
    } else {
	$last_pos = $offset;
    }

    return(0);
}

# Report on the position and status of the player head.
sub com_head {
    # Argument processing.
    if ( @_ ) {
        print STDERR "head: head does not take any arguments\n";
	return(1);
    }

    if ( $playing_flag ) {
        printf "%.2f/%.2f  playing.\n", $last_pos + &tdelta, $volume_length;
    } elsif ( $browsemode ) {
	# We may need to cook the result of &tdelta a bit, so local version.
	my $l_tdelta = &tdelta;
	# This can happen because we block signals during user functions.
	if ( $l_tdelta > $browse_play_time ) {
	    $l_tdelta = $browse_play_time;
	}
        printf "%.2f/%.2f  browsing (%.2f/%.2f seconds into current section).\n", $last_pos + $l_tdelta, $volume_length, $l_tdelta, $browse_play_time;
    } else {
	printf "%.2f/%.2f  stopped.\n", $last_pos, $volume_length;
    }

    return(0);
}

# Report on the position of the mark.
sub com_checkmark {
    # Argument processing.
    if ( @_ ) {
        print STDERR "checkmark: checkmark does not take any arguments\n";
	return(1);
    }

    unless ( defined($mark_pos) ) {
	print "The mark has not yet been placed on the volume.\n";
    } else {
	printf "%.2f/%.2f\n", $mark_pos, $volume_length;
    }

    return(0);
}

# Start browsing the volume at the current head position.
sub com_browse {
    # Command argument processing.
    my $arg1 = shift;
    my $arg2 = shift;
    if ( defined($arg1) xor defined($arg2) ) {
        print STDERR "browse: if one argument is supplied, both must be\n";
        return(1);
    }
    unless ( defined($arg1) ) {
        $arg1 = $browse_play_time;
    }
    unless ( defined($arg1 = &quantity_time_to_seconds($arg1)) ) {
	print STDERR "browse: don't know how to handle argument: $arg1\n";
	return(1);
    }
    unless ( defined($arg2) ) {
        $arg2 = $browse_skip_time;
    }
    unless ( defined($arg2 = &quantity_time_to_seconds($arg2)) ) {
	print STDERR "browse: don't know how to handle argument: $arg2\n";
	return(1);
    }
    if ( defined(shift) ) {
        print STDERR "browse: too many arguments\n";
        return(1);
    }

    # Set command memory.
    $browse_play_time = $arg1;
    $browse_skip_time = $arg2;

    # Now that we think we have valid options, we stop the player if needed.
    if ( $playing_flag or $browsemode ) {
        &stop_core;
    }

    # Set the edge margin for the new play time.
    $browse_em = 1;
    if ( $browse_play_time < 2 ) {
        $browse_em = $browse_play_time / 2;
    }

    # Kick off browse mode.
    &browse_play;
    $browsemode = 1;

    return(0);
}

# This is not an interactive command, it is called to get browsemode
# started and then from the SIGCHLD handler to keep browse mode going.
sub browse_play {
    undef $rawplay_pid;
    $rawplay_pid = fork;
    unless ( defined($rawplay_pid) ) {
        die "$progname: couldn't fork $!\n";
    } elsif ( $rawplay_pid == 0 ) { # child

        # We don't want to try to play more than there is in the
        # volume when using the -t argument to rawplay.
        my $rawplay_play_time;
        if ( $volume_length - $last_pos < $browse_play_time + 0.01 ) {
            $rawplay_play_time = $volume_length - $last_pos - 0.01;
        } else { 
            $rawplay_play_time = $browse_play_time;
        }

        exec "rawplay -B 262144 -c $channels -d $audio_device -f $input_sample_format -s $sampling_rate -j $last_pos -t $rawplay_play_time $volume" or die "$progname: couldn't exec: $!\n";
    } else { # parent
        $start_time = time;
    }

    return(0);
}

# Display help.
sub com_help {
    my $arg = shift;
    unless ( defined($arg) ) {
    print <<END_INTERACTIVE_HELP;
soundgrab exists to make it easy to interactively save your favorite bits of a
long volume of raw audio (the name of which you gave as an argument when you
invoked soundgrab).

Terms: 'head'  refers to the player head.  Think in terms of a cassette
               player.  The head has a position in the volume, and may
               be stopped or playing (or browsing).  Playing stops 
               automaticly when the head reaches the end of the volume.

       'mark'  refers to a marker which you can place on the volume using
               the 'mark' command.  The mark is placed at the position of
               the head at the instant you issue the 'mark' command.  Only
               one mark can exist on the volume at a time.

Once you have a mark on the volume, you use the 'name' command to give
the audio data between the mark and the head position a name.  The
head can be before the mark if that is convenient.  When you have
named all the sections you are interested in saving to files, you use
the 'export' command to do the actual saving.

The browse command lets you automaticly skip through the contents of
the volume (great for channel flippers :).

All commands can be used at any time, whether the volume is being
played or browsed, or is stopped.  Commands may be abbreviated to
uniqueness.  Multiple commands seperated by semicolons may be placed
on the same command line.

For help on individual commands use help <command_name>.  Available commands:
play, stop, mark, name, list, delete, changename, export, ff, rw, jump, head,
checkmark, browse, help, quit.
END_INTERACTIVE_HELP
    } elsif ( $commands{$arg} ) {
	printf ("%s\n", $commands{$arg}->{doc});
    } else {
	print STDERR "help: $arg: no help on that topic.  Try just 'help'.\n";
    }

    return(0);
}

# The user wishes to quit this program.  If unexported named chunks
# exist make sure the user knows.  Clean up and set DONE
# appropriately.
sub com_quit {
    # Argument processing.
    if ( @_ ) {
        print STDERR "quit: quit does not take any arguments\n";
	return(1);
    }

    if ( %names ) {
        my $qa = $term->readline("Named chunks of the input volume have been defined which have not yet been
expoted with the export command.  Quit anyway (y/N)? ");
	if ( !($qa =~ /^(\s*[yY]\s*)$/) ) {
	  return(0);
	}
    }
    if ( $playing_flag or $browsemode ) {
        &stop_core;
    }
    $done = 1;

    return(0);
}

# Utility functions.

# We frequently need to no the elapsed time since the last time we
# invoked the player.  To find out where we are now.
sub tdelta {
    return time - $start_time;
}

# Check the validity of a numerical argument.
sub is_signless_decimal_num {
    # Argument procsesing.
    unless ( $#_ == 0 ) {
	die "internal function is_signless_deciman_num got wrong number of arguments, looks like a bug\n";
    }
    my $arg = shift;

    if ( $arg =~ /^\s*\d*[.]?\d*\s*$/ ) {
	return 1;
    } else {
	return 0;
    }
}

# Check the validity of a whole number argument.
sub is_whole_num {
    # Argument processing.
    unless ( $#_ == 0 ) {
	die "internal function is_whole_num got wrong number of arguments, looks like a bug\n";
    }
    my $arg = shift;

    if ( $arg =~ /^\s*\d*\s*$/ ) {
	return 1;
    } else {
	return 0;
    }
}

# Convert a positive quantity of time possibly containing minute,
# hour, or day units in addition to seconds to seconds.  Return undef
# on error.
sub quantity_time_to_seconds {
    # Argument processing.
    unless ( $#_ == 0 ) {
	die "internal function quantity_time_to_seconds got wrong number of arguments, looks like a bug\n";
    }
    my $arg = shift;

    # Match subexpression in time quantity.
    unless ( $arg =~ /
	             ^\s* # Whitespace at the start of the argument.
	             (?:(\d*[.]?\d*)d)?	 # Optional days part
                     (?:(\d*[.]?\d*)h)?  # Optional hours part
                     (?:(\d*[.]?\d*)m)?  # Optional minutes part
	             (?:(\d*[.]?\d*)s?)? # Optional seconds part
                     \s*$ # Whitespace at the start of the argument.
	             /x ) {
	return undef;
    } else {
	my ($days, $hours, $minutes, $seconds) = ($1, $2, $3, $4);

	# Fill in parts which didn't occur in pattern with defaults.
	unless ( defined($days) ) {
	    $days = 0;
	}
	unless ( defined($hours) ) {
	    $hours = 0;
	}
	unless ( defined($minutes) ) {
	    $minutes = 0;
	}
	# Careful, pattern which becomes $seconds matches the empty string.
	unless ( (defined($seconds)) and ($seconds ne "" ) ) {
	    $seconds = 0;
	}
	# Return quantity of time in seconds.
	return $days * 86400 + $hours * 3600 + $minutes * 60 + $seconds;
    }
}
	

# Convert my own kind of time string to seconds into day.  Return
# undef on error.
sub time_to_offset {
    # Argument processing.
    unless ( $#_ == 0 ) {
	die "internal function time_to_offset got wrong number of arguments, looks like a bug\n";	
    }    
    my $arg = shift;
 
    # Break off day offset part, if present.
    my ($time, $day_offset) = split(/\+/, $arg);
    if ( defined($day_offset) ) {
	$day_offset =~ s/^(\d+)(d|da|day|days)?$/$1/;
    }

    # Deal with am/pm.
    my $am_flag = 0;
    my $pm_flag = 0;    
    if ( $time =~ /(.*)pm?$/ ) { 
	$time = $1;
	$pm_flag = 1;
    }
    if ( $time =~ /(.*)am?$/ ) {
	$time = $1;
        $am_flag = 1;
    }

    # Break into time units.
    my ($hours, $mins, $secs) = split(/:/, $time);

    # Hours and minutes must be given.
    unless ( defined($hours) and defined($mins) ) {
	return undef;
    }

    # Get to 24 hour form.
    if ( $am_flag or $pm_flag ) {
	unless ( ($hours >= 1) and ($hours <= 12) ) {
	    return undef;
	} 
	if ( ($pm_flag) and ($hours != 12) ) {
	    $hours += 12;
	}
	if ( ($am_flag) and ($hours == 12) ) {
	    $hours -= 12;
	}
    }

    # If seconds or day offset fields weren't given, they are zero.
    unless ( defined($secs) ) {
	$secs = 0;
    }
    unless ( defined($day_offset) ) {
	$day_offset = 0;
    }

    # Check fields for sanity, if sane, compute and return.
    unless ( &is_whole_num($hours) and
	     (($hours >= 0) and ($hours <= 23)) and
	     &is_whole_num($mins) and
	     (($mins >= 0) and ($mins <= 59)) and
	     &is_signless_decimal_num($secs) and
	     (($secs >= 0) and ($secs < 60)) and
	     &is_whole_num($day_offset) and
	     ($day_offset >= 0) ) {
	return undef;
    } else {
	return $day_offset * 86400 + $hours * 3600 + $mins * 60 + $secs;
    }
}

# The volume might have been accidently diddled with on disk, which of
# course can cause just about anything to happen.  This checks for
# changes and reports them.
sub volume_sanity_check {
    # Argument processing.
    unless ( $#_ == 0 ) {
	die "internal function volume_sanity_check got wrong number of arguments, looks like a bug\n";	
    }    
    my $arg = shift;
    
    if ( !(-e $volume) ) {
	print STDERR "$progname: '$volume' file no longer exists, this means trouble...\n";
	return 0;
    }
    if ( !(-r $volume) ) {
	print STDERR "$progname: '$volume' is no longer readable, this means trouble...\n";
	return 0;
    }
    if ( (stat($volume))[9] > $last_volume_time_check ) {
	print STDERR "$progname: '$volume' appears to have changed recently, this could mean trouble...\n";
	$last_volume_time_check = time;
	return 0;
    }
    
    # Made it through the checks, so return true.
    return 1;
}
