#!/usr/bin/perl -w

# Copyright (C) 2001  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 diagnostics;
use strict;

use File::Basename qw(basename fileparse);
use FileHandle;
use Getopt::Long;
use POSIX qw(:errno_h :signal_h :sys_wait_h floor ceil);
use Text::ParseWords qw(parse_line shellwords);
# 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);

my $progname = basename($0);
my $version = "0.7.0";

# File name extensions we know about.  The array is generally used by
# fileparse and so features periods, the scalar is used as a pattern
# in matches against things which do not necessarily include periods
# (often because they are suffixes produced by fileparse) and so does
# not feature periods.
my @known_extensions = ('.cdr', '.flac', '.ogg', '.raw', '.wav');
my $known_extensions_pattern = '(cdr)|(flac)|(ogg)|(raw)|(wav)';

# Default values for options.
my $ogg_kbitrate = 256;	        # Default 256 kb/s for ogg lossy encoding.
my $channels = 2;		# Channels of data in raw audio file.
my $audio_device = "/dev/dsp";
my $output_file_format = "cdr";	     # CD mastering format.
my $using_gnome = 0;		     # Use gnome GUI interface.
my $input_sample_format = "s16_le";  # Signed 16 bit little endian.
my $sampling_rate = 44100;	     # Sampling rate of raw data file.
# 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 an appropriately named variable.
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,
     "gnome" => \$using_gnome,
     "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-format|f=s", "gnome",
		    "input-sample-format|i=s", "sampling-rate|s=i",
		    "time-of-start|t=s", "verbose|v", "help|?", "version") ) {
    print STDERR "$progname: Option parse 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 =~ /^$known_extensions_pattern$/ ) {
    print STDERR "$progname: bad output file format string (-f or --output-file-format option argument) '$output_file_format', try '$progname --help'\n";
    exit(1);
}
if ( $output_file_format eq "flac" and !&have_flac ) {
    print STDERR "$progname: couldn't find 'flac' program required to perform exports in the default format requested with -f or --output-file-format option\n";
    exit(1);
}
if ( $output_file_format eq "ogg" and !&have_oggenc ) {
    print STDERR "$progname: couldn't find 'oggenc' program required to perform exports in the default format requested with -f or --output-file-format option\n";
    exit(1);
}

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

Copyright (C) 2001 Britton Leo Kerin (fsblk\@uaf.edu)
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(0);
}

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

  --gnome                use GNOME graphical user interface

  --version              print version information and exit

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

# The time of day that recording of the current volume 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 (it doesn't make sense to use day offset in the option argument)\n";
	exit(1);
    }
}

# The name of the volume being dissected.
my $volume;
# Later on we want to be able to verify that the volume hasn't changed
# since we the last time we changed it.
my $last_volume_time_check;

# After option processing is done, if there is an argument, it is the
# name of the volume to dissect.
if ( $#ARGV < 0 ) {
    if ( defined($time_of_start) ) {
	print STDERR "$progname: warning: a time-of-start option was specified but got ignored, since there was no volume argument given to associate the start time with\n";
    }
} elsif ( $#ARGV == 0 ) {
    # The name of the volume we are grabbing sound from.
    $volume = shift @ARGV;
    $last_volume_time_check = time;

    # Reasonable volume name?
    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);
    }

} elsif ( $#ARGV > 0 ) {
    print STDERR "$progname: too many arguments.  Try $progname --help.\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.  These
# functions return the numerical part of the version number if
# possible if the binary in question is found, or false if it isn't.
sub have_oggenc {
    if ( `which oggenc` ) {
	# oggenc stupidly writes to stderr when given --version option.
	if ( `oggenc --version 2>&1` =~ /(\d+\.\d+(\.\d+)?)/ ) {
	    return $1;
	} else {
	    return 1;
	}
    } else {
	return 0;
    }
}
sub have_flac {
    if ( `which flac` ) {
	return 1;
    } else {
	return 0;
    }
}

# 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];

# The size of the volume in bytes.
my $volume_size;
if ( defined($volume) ) {
    $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;
if ( defined($volume_size) ) {
    $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 default default argument for ff and rw commands.
my $default_ff_or_rw_arg = 100;
# The number of seconds the last ff or rw command moved the head by.
# (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;

# 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 = 20;
# 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 command's 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
# much of the actual execution of 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 ( $using_gnome ) {
		    &autostop_notify;
		}
	    }
	    # Browsemode requires some additional handling.
            if ( $browsemode ) {
                if ( $last_pos + $browse_play_time + $browse_skip_time
                               >= $volume_length ) {
                    $last_pos = $volume_length;
                    $browsemode = 0;
		    if ( $using_gnome ) {
			&autostop_notify;
		    }
                } else {
                    $last_pos += $browse_play_time + $browse_skip_time;
                    &browse_play;
		}
	    }
	}
    }
}

# References to IO procedures needed from both the command line and
# GUI interfaces.  These are filled in in the appropriate interface section,
# and called later by functions which are used by both interfaces.

# Take a prompt and a default for yes/no response, return true if yes.
my $prompt_yes_no_ref;
# Take a prompt string for a new name, return the new name entered.
my $prompt_new_name_ref;
# Print or log or otherwise deal with an error inside one of the com_
# functions.
my $com_error;
# Print or log or otherwise deal with an informative message inside
# one of the com_ functions.
my $com_message;

# Using the GNOME GUI.
if ( $using_gnome ) {

    # FIXME: Get it working and remove this.
    print STDERR "Sorry, the GNOME interface is not function yet.  Please Try back next version.\n";
    exit(1);


# Why do the GNOME functions defined here make such nasty use of
# command line functions, instead of having both GNOME and command
# line interfaces call some kernel functions?  Because I wrote the
# command line version first, I'll probably continue to use it more
# myself, and I would rather have the GNOME interface extremely crufty
# and leave the command line version fairly clean and simple than make
# both interfaces slighthly more crufty plus have to rewrite a bunch
# of stuff.

# The SIGCHLD handler runs this function, so be very very careful...
sub autostop_notify { 
    # FIXME: make this work.
    print STDERR "autostop_notify: I'm stubbed out, fix me\n";
}

require Gtk::GladeXML;
import Gtk::GladeXML;
require Gnome;
Gnome->import();

Gtk::GladeXML->init();

Gnome->init($progname, $version);

my $gui = Gtk::GladeXML->new("./glade_gui/soundgrab_interface.glade");

# Some widgets are needed frequently, have external memory, or for
# some other reason do best with permanent references rather than
# being loaded on the fly by functions that need them.

# Everybody uses the main application window.
my $main_window = $gui->get_widget('main_window');
# A lot of commands use the application bar.
my $appbar = $gui->get_widget('main_window_appbar');
# Entry widgets with memory.
my $jump_gnomeentry = $gui->get_widget('jump_gnomeentry');
my $name_gnomeentry = $gui->get_widget('name_gnomeentry');
# History memory for GnomeEntry widgets.
# FIXME: GNOME 2.0 deprecates the automatic history memory I think.
$jump_gnomeentry->set_history_id('jump_gnomeentry_history');
$name_gnomeentry->set_history_id('name_gnomeentry_history');
# History lists never gets longer than 10 items.
# FIX ME: this doesn't seem to do anything.
$jump_gnomeentry->set_max_saved(10);
$name_gnomeentry->set_max_saved(10);

# Offsets associated with slider end point positions for the current
# voluem and zoom level.
my $slider_start_offset = 0;
my $slider_end_offset;
if ( defined($volume_length) ) {
    $slider_end_offset = $volume_length;
}

# Placement coordinates in the main_window_fixed GtkFixed for the
# marker arrow eventbox widget which cause the GtkArrow is contains to
# point to the start and end positions of the slider.
my $mark_arrow_eventbox_y_coord = 76;
my %mark_arrow_eventbox_start_slider = 
    ( 'x_coord' => 44,
      'y_coord' => $mark_arrow_eventbox_y_coord );
my %mark_arrow_eventbox_end_slider = 
    ( 'x_coord' => 464,
      'y_coord' => $mark_arrow_eventbox_y_coord );

# Define a message buffer class.
{
    # Namespaces are global so we use an appropriately hierarchical
    # package name.
    package Soundgrab::GnomeGUI::MsgBuf;

    # Creata a new message buffer object.
    sub new {
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = {};
	bless $self, $class;
	$self->flush();
	return $self;
    }

    # Flush the buffer, returning its contents as a string.
    sub flush {
	my $self = shift;
	my $buf_val = $self->{'buf_string'};
	$self->{'buf_string'} = "";
	return $buf_val;
    }

    # Add an error to the buffer.
    sub add {
	#my $self = shift;
	shift->{'buf_string'} .= shift;
    }

    # Returns true if the buffer is empty.
    sub is_empty {
	return shift->{'buf_string'} ? 0 : 1;
    }
}

# Buffer for errors which occur during execution of com_ functions.
my $com_err_buf = Soundgrab::GnomeGUI::MsgBuf->new();
# Buffer for messages which occur during execution of com_ functions.
my $com_msg_buf = Soundgrab::GnomeGUI::MsgBuf->new();

# The GNOME incarnations of some IO functions used in the com_
# functions can now be filled in.
$com_error = sub {
    # Error message from com_ functions are buffered and dealt with
    # after the function that genated them returns.
    $com_err_buf->add(shift);
};
$com_message = sub {
    # Informative messages from com_ functions are handled using the
    # same method as errors, but with a different buffer.
    $com_msg_buf->add(shift);
};
$prompt_yes_no_ref = sub {
    my ($prompt, $default_response) = @_;

    my $mbox = Gnome::MessageBox->new($prompt, "question", "Yes", "No");

    # Look for a local variable specifying the parent window.  GUI
    # handlers may set this variable so this function can set its
    # parent window correctly.
    if ( defined($main::prompt_yes_no_ref_parent_window) ) {
	$mbox->set_parent($main::prompt_yes_no_ref_parent_window);
    }

    # Set default button number according to default response argument.
    if ( $default_response eq "y" ) {
	$mbox->set_default(0);
    } else {
	$mbox->set_default(1);
    }

    # Run the dialog and return the users response.
    my $user_action = $mbox->run_and_close();
    if ( $user_action == -1 ) {	# Window closed from window manager.
	return ( $default_response eq "y" ) ? 1 : 0;
    } else {
	# 'not' because Yes is button zero, No is button one.
	return not $user_action;
    } 
};

# Fill in the text of some labels and the appbar.
if ( defined($volume) ) {
    $appbar->push("soundgrab ready to dissect current volume.");
    $gui->get_widget('volume_name_label')->set($volume);
    $gui->get_widget('head_pos_label')->set(sprintf("0/%.2f",
						    $volume_length));
    $gui->get_widget('mark_pos_label')->set("Unplaced");
    $gui->get_widget('startscale_label')->set($slider_start_offset);
    $gui->get_widget('endscale_label')->set($slider_end_offset);
} else {
    $appbar->push("soundgrab started without a volume argument.");
    $gui->get_widget('volume_name_label')->set("No current volume");
    $gui->get_widget('head_pos_label')->set("NA");
    $gui->get_widget('mark_pos_label')->set("NA");
    $gui->get_widget('startscale_label')->set("");
    $gui->get_widget('endscale_label')->set("");
}

# Menu bar entries.

# Volume selection.
sub on_open_volume_activate {
    $gui->get_widget('volume_fileselection')->show();
    # FIXME: Do some filename tab completion with complete?
}
sub on_volume_fileselection_cancel_button_clicked {
    $gui->get_widget('volume_fileselection')->hide();
}
sub on_volume_fileselection_ok_button_clicked {
    my $volume_fileselection = $gui->get_widget('volume_fileselection');
    &com_volume($volume_fileselection->get_filename());
    unless ( $com_err_buf->is_empty() ) {
	&gnome_error($volume_fileselection, $com_err_buf->flush());
	$volume_fileselection->grab_focus();
    } else {
	$slider_start_offset = 0;
	if ( defined($volume_length) ) {
	    $slider_end_offset = $volume_length;
	}
	$gui->get_widget('volume_name_label')->set($volume);
	$gui->get_widget('head_pos_label')->set(sprintf("0/%.2f",
							$volume_length));
	$gui->get_widget('mark_pos_label')->set("Unplaced");
	$gui->get_widget('startscale_label')->set($slider_start_offset);
	$gui->get_widget('endscale_label')->set($slider_end_offset);
	$appbar->push("Volume loaded.");
	$volume_fileselection->hide();
    }
}

# Serious ugliness here.  This stuff will only make sense if you
# remember that this function essentially parses the output of
# com_export to a GUI form.
sub on_export_activate {
    # Convenience variables.
    my $appbar = $gui->get_widget('main_window_appbar');
    my $export_progress_window = $gui->get_widget('export_progress_window');

    my %chunk_sizes;	    # Sizes of chunks, in seconds.
    my $total_of_sizes = 0; # Total of all chunk sizes.
    foreach my $name ( keys %names ) {
	$chunk_sizes{$name} = $names{$name}[1] - $names{$name}[0];
	$total_of_sizes += $chunk_sizes{$name};
    }

    # These variables are state memory used by the polymorphed
    # com_message fctn (see below).
    my $exported_chunk_count = 0 ; # Number of chunks exported so far.
    my $fraction_done = 0;  # Fraction of exporting work done so far.
    my $crnt_name;	    # Name of chunk currently being worked on.

    # And now for a little temporary extra polymorphism of the I/O
    # functions used by com_export(), with a bit of intracall state
    # memory from the lexically scoped variables above.  God I love
    # perl.  Writing it that is, not reading it.
    my $base_com_message = $com_message; # Save base com_message definition.
    $com_message = sub { 	         # New temporary definition.
	my $arg = shift;

	# Handle some of the funny messages com_export can generate.
	if ( $arg =~ /(There are no unexported named chunks to export\.)/x ) {
	    &gnome_message($main_window, $1);
	    $appbar->push("Exported nothing.");
	    return(0);
	} 
	if ( $arg =~ /Stopping player while exporting/ ) {
	    $gui->get_widget('stop_radiobutton')->set_active();
	    $appbar->push("Player stopped while exporting...");
	    # Give user time to read message.  Emulate nanosleep,
	    # since apparently neither Time::HiRes nor POSIX modules
	    # provide it.
	    select(undef, undef, undef, 0.5);
	}
	if ( $arg =~ /Stopping browse while exporting/ ) {
	    $gui->get_widget('stop_radiobutton')->set_active();
	    $appbar->push("Browse stopped while exporting...");
	    # Give user time to read message.  Emulate nanosleep,
	    # since apparently neither Time::HiRes nor POSIX modules
	    # provide it.
	    select(undef, undef, undef, 0.5);
	}
	if ( $arg =~ / # Directory existence or permission problems.
	                (Directory\s.*\sdoes\snot\sexist.)
	               |(No\spermission\sto\screate\s.*\sin\s.*)
	     /x ) {
	    &gnome_error($main_window, $arg);
	    return(1);
	}

	my $export_label = $gui->get_widget('export_action_label');

	if ( $arg =~ /^((Encoding\sand\swriting|Writing)\s\"(.*)\"
			\.\.\.)\s$/x ) {
	    $export_label->set($1);
	    $crnt_name = $3;
	    # If this is the first exported chunk...
	    if ( $exported_chunk_count == 0 ) {
		# show the window for the first time (this export).
		$export_progress_window->show();
		return(0);
	    }
	}

	if ( $arg =~ /^done.\n$/ ) {
	    $appbar->set_progress($fraction_done 
				  += $chunk_sizes{$crnt_name}/$total_of_sizes);
	    $exported_chunk_count++;
	    # If we just finished exporting the last chunk...
	    if ( $exported_chunk_count == keys(%names) ) {
		# hide the window.
		$export_progress_window->hide();
	    }
	}
    };

    &block_sigchld;
    &com_export();
    &unblock_sigchld;

    # Return to base com_message behavior.
    $com_message = $base_com_message;
}

sub on_exit_activate {
    if ( %names ) {
	local $main::prompt_yes_no_ref_parent_window = $main_window;
        unless ( &$prompt_yes_no_ref("Named chunks of the current input volume have been defined which have 
not yet been exported with the export command.  Quit anyway (y/N)? ", "n") ) {
	    return(0);
	}
    }
    if ( $playing_flag or $browsemode ) {
        &stop_core;
    }
    Gtk->main_quit();
}

sub on_preferences_activate {
    print STDERR "on_references_activate: no preferences yet\n";
}

sub on_manual_activate {
    print STDERR "on_manual_activate: no manual yet\n";
}

sub on_about_activate {
    $gui->get_widget('about_soundgrab')->show();
}

sub on_frw_button_clicked {
    &gnome_rw($gui->get_widget('frw_spinbutton')->get_value_as_float());
}

sub on_rw_button_clicked {
    &gnome_rw($gui->get_widget('rw_spinbutton')->get_value_as_float());
}

sub on_f_button_clicked {
    &gnome_ff($gui->get_widget('f_spinbutton')->get_value_as_float());
}

sub on_ff_button_clicked {
    &gnome_ff($gui->get_widget('ff_spinbutton')->get_value_as_float());
}

sub on_zoom_button_clicked {
    print "zoom: so far unimplemented rescaling magic\n";
}

sub on_jump_button_clicked {
    my $jump_gtkentry = $jump_gnomeentry->gtk_entry();
    $jump_gtkentry->set_text("");
    $jump_gtkentry->grab_focus();
    my $jump_dialog = $gui->get_widget('jump_dialog');
    $jump_dialog->set_parent($gui->get_widget('main_window'));
    $jump_dialog->close_hides(1);
    # I think this depends on the jump_ok_button button having, in the
    # C language binding, GTK_WIDGET_HAS_DEFAULT(wid) true, in order
    # to make is so when the dialog first pops up the user can type
    # into the $jump_gtkentry, and then hit return to automaticly
    # activate the jump_ok_button.  Possibly gnome_dialog_set_default
    # should be used instead of setting the GTK_WIDGET_HAS_DEFAULT
    # property from glade, but gnome_dialog_set_default has a weird
    # integer macro argument and I can't figure out what the perl
    # binding wants for an argument.  (Sun, 11 Nov 2001)
    $jump_dialog->editable_enters($jump_gtkentry);
    $jump_dialog->show();

    # Note the dialog is not run, so the application is not blocked
    # and the user can do other things before filling in the jump
    # field and hitting ok/return to make the actual jump happen.
}

sub on_jump_ok_button_clicked {
    my $jump_error_flag = 0;	# True if jump failed somehow.
    my $jump_dialog = $gui->get_widget('jump_dialog');
    my $jump_gtkentry_val = $jump_gnomeentry->gtk_entry()->get_text();
    if ( $jump_gtkentry_val eq "" ) {
	$jump_error_flag = 1;
	&gnome_error($jump_dialog, "jump needs a non-null argument");
    } else {
	&block_sigchld;
	&com_jump($jump_gtkentry_val);
	&unblock_sigchld;
	unless ( $com_err_buf->is_empty ) {
	    $jump_error_flag = 1;
	    &gnome_error($jump_dialog, $com_err_buf->flush());
	}
	$jump_gnomeentry->append_history(0, $jump_gtkentry_val);
    }

    # If there was a problem, put the user back in the jump dialog.
    if ( $jump_error_flag ) {
	$jump_gnomeentry->gtk_entry()->grab_focus();
    } else { # Otherwise, close.
	$jump_dialog->close();
    }
}

sub on_jump_cancel_button_clicked {
    $gui->get_widget('jump_dialog')->close();
}

sub on_mark_button_clicked {
    &block_sigchld;
    &com_mark();
    &unblock_sigchld;
    unless ( $com_err_buf->is_empty() ) {
	&gnome_error($main_window, $com_err_buf->flush());
    } else {
	&position_mark_arrow;
    }
}

sub on_name_button_clicked {
    my $name_gtkentry = $name_gnomeentry->gtk_entry();
    $name_gtkentry->set_text("");
    $name_gtkentry->grab_focus();
    my $name_dialog = $gui->get_widget('name_dialog');
    $name_dialog->set_parent($gui->get_widget('main_window'));
    $name_dialog->close_hides(1);
    # I think this depends on the name_ok_button button having, in the
    # C language binding, GTK_WIDGET_HAS_DEFAULT(wid) true, in order
    # to make is so when the dialog first pops up the user can type
    # into the $name_gtkentry, and then hit return to automaticly
    # activate the name_ok_button.  Possibly gnome_dialog_set_default
    # should be used instead of setting the GTK_WIDGET_HAS_DEFAULT
    # property from glade, but gnome_dialog_set_default has a weird
    # integer macro argument and I can't figure out what the perl
    # binding wants for an argument.  (Sun, 11 Nov 2001)
    $name_dialog->editable_enters($name_gtkentry);
    $name_dialog->show();

    # Note the dialog is not run, so the application is not blocked
    # and the user can do other things before filling in the name
    # field and hitting ok/return to make the actual name happen.
}

sub on_name_ok_button_clicked {
    my $name_error_flag = 0;	# True if name failed somehow.
    my $name_dialog = $gui->get_widget('name_dialog');
    my $name_gtkentry_val = $name_gnomeentry->gtk_entry()->get_text();
    if ( $name_gtkentry_val eq "" ) {
	$name_error_flag = 1;
	&gnome_error($name_dialog, "name needs a non-null argument");
    } else {
	&block_sigchld;
	&com_name($name_gtkentry_val);
	&unblock_sigchld;
	unless ( $com_err_buf->is_empty() ) {
	    $name_error_flag = 1;
	    &gnome_error($name_dialog, $com_err_buf->flush());
	}
	unless ( $com_msg_buf->is_empty() ) {
	    &gnome_message($name_dialog, $com_msg_buf->flush());
	}
	$name_gnomeentry->append_history(0, $name_gtkentry_val);
    }

    # If there was a problem, put the user back in the name dialog.
    if ( $name_error_flag ) {
	$name_gnomeentry->gtk_entry()->grab_focus();
    } else { # Otherwise, close.
	$name_dialog->close();
    }
}

sub on_name_cancel_button_clicked {
    $gui->get_widget('name_dialog')->close();
}

sub gnome_rw {
    my $arg = shift;

    $com_msg_buf->flush();
    &block_sigchld;
    &com_rw($arg);
    &unblock_sigchld;
    my $msg = $com_msg_buf->flush();
    if ( $msg =~ /^(.*\.)?(Rewind stopped at beginning of volume\.)/ ) {
	$gui->get_widget('main_window_appbar')->push($2);
    }
}

sub gnome_ff {
    my $arg = shift;
    
    $com_msg_buf->flush();
    &block_sigchld;
    &com_ff($arg);
    &unblock_sigchld;
    my $msg = $com_msg_buf->flush();
    if ( $msg =~ /^(.*\.)?(Stopped at end of volume\.)/ ) {
	$gui->get_widget('main_window_appbar')->push($2);
	# Make sure the appropriate radiobutton is selected.
	$gui->get_widget('stop_radiobutton')->set_active();
    }
}

sub position_mark_arrow {
    my $main_window_fixed = $gui->get_widget('main_window_fixed');
    my $mark_arrow_eventbox = $gui->get_widget('mark_arrow_eventbox');
    my $mark_arrow = $gui->get_widget('mark_arrow');
    if ( ($mark_pos >= $slider_start_offset) 
	 and ($mark_pos <= $slider_end_offset) ) {
	$mark_arrow->set('down', 'etched-in');
	my $position_fraction = $mark_pos / $volume_length;
	my $x_span = $mark_arrow_eventbox_end_slider{'x_coord'}
	             - $mark_arrow_eventbox_start_slider{'x_coord'};
	# In this crazy not-yet-C99 world, sprintf is the best way to
	# round.
	my $new_x_coord = $mark_arrow_eventbox_start_slider{'x_coord'}
	                  + sprintf("%.0f", $position_fraction * $x_span);
	$main_window_fixed->move($mark_arrow_eventbox, $new_x_coord, 
				 $mark_arrow_eventbox_y_coord);
	# It seems its you don't have to show() the eventbox to see
	# either the arrow inside it or the eventbox's tooltip.
	# FIX ME: this (see above comment) seems wacky.
	# $mark_arrow_eventbox->show();
	$mark_arrow->show();
    } # Add here else part to display arrow when mark is off slider range.
}

# Display an error message, blocking the parent window until acknowledged.
sub gnome_error {
    my $parent = shift;
    unless ( defined($parent) and (ref($parent) =~ /^(Gnome::)|(Gtk::)/) ) {
	die "internal function gnome_error didn't get a Gnome or Gtk object for its first argument, looks like a bug";
    }
    my $error_string = shift;
    unless ( defined($error_string) ) {
	die "internal function gnome_error didn't get a second argument, looks like a bug";
    }

    my $mbox = Gnome::MessageBox->new($error_string, "error", "Ok");
    $mbox->set_parent($parent);
    $mbox->run_and_close();
}

# Display an informative message, blocking other windows until
# acknowledged.
sub gnome_message {
    my $parent = shift;
    unless ( defined($parent) and (ref($parent) =~ /^(Gnome::)|(Gtk::)/) ) {
	die "internal function gnome_message didn't get a Gnome or Gtk object for its first argument, looks like a bug";
    }
    my $message_string = shift;
    unless ( defined($message_string) ) {
	die "internal function gnome_message didn't get a second argument, looks like a bug";
    }

    my $mbox = Gnome::MessageBox->new($message_string, "info", "Ok");
    $mbox->set_parent($parent);
    $mbox->run_and_close();
}

$gui->signal_autoconnect_from_package('main');

$main_window->show();

Gtk->main();

} else { # Not using the GNOME GUI.

require Term::ReadLine;
import Term::ReadLine;

# Interactive command line 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 [TIME]
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.2m5.4' to fast forward 1
day, 2 hours, 3.2 minutes, and 5.4 seconds."
             },
     'rw' => { func => \&com_rw, doc => "usage: rw [TIME]
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.2m5.4' to rewind 1 day, 2
hours, 3.2 minutes, and 5.4 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 or optional argument to the 'volume'
command 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 $browse_play_time and $browse_skip_time.

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."
                 },
     'volume' => { func => \&com_volume, doc => "usage: volume NAME [TIME-OF-START]
Begin dissecting volume file NAME.  The head is positioned at the
start of the new volume and the mark is unplaced.  If TIME-OF-START is
specified, it must follow the format of the time-of-start command line
option argument, and has the same meaning.  The sample format and sampling
rate parameters must be the same for the new volume as those specified on 
the command line."
                 },
     '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."
             }
     );

# This gets set when the user uses the quit command.
my $done = 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);

# The command line incarnations of some IO functions used in the com_
# functions can now be filled in.
$prompt_yes_no_ref = sub { 
    unless ( $#_ == 1 ) {
        die "internal function prompt_yes_no_ref got wrong number of arguments, looks like a bug";
    }  

    my $response = $term->readline(shift);
    my $default = shift;

    if ( $default eq "y" ) {
	if ( $response =~ /^(\s*[nN]\s*)$/ ) {
	    return 0;
	} else {
	    return 1;
	}
    } elsif ( $default eq "n" ) {
	if ( $response =~ /^(\s*[yY]\s*)$/ ) {
	    return 1;
	} else {
	    return 0;
	}
    } else {
        die "internal function prompt_yes_no_ref got bad 2nd argument";
    }
};
$prompt_new_name_ref = sub {
    my $arg = shift;		# Prompt to use to ask for new name.

    my @words;
    unless ( @words = shellwords($term->readline($arg)) ) {
        @words = &$prompt_new_name_ref("Failed to parse new name.  Mismatched or mis-escaped single or double quote(s)?
Try again: ");
    }
    # parse_line, on which shellwords is based, puts a leading null in
    # the returned array if the string started with a seperator.
    if ( $words[0] eq "" ) {
        shift(@words);
    }
    # parse_line, on which shellwords is based, has an icky tendency
    # to extend arrays with undef (as of 1 Jan 2002).  Defend against
    # this.
    if ( ($#words == 1) and (!defined$words[$#words]) ) {
        pop(@words);
    }
    # Unless we now have the expected single defined word, try again.
    unless ( @words == 1 and defined $words[0] ) {
        @words = &$prompt_new_name_ref("Failed to parse new name.  More than one space delimited word on line?
Try again: ");
    }

    return $words[0];
};
$com_error = sub {
    print STDERR shift;;
};
$com_message = sub {
    print shift;
};

# Default prompt.
my $prompt = $progname."> ";

# Name of immediately preceeding automaticly repeatable command, or
# undef if there is no preceeding command or the preceeding command is
# not automaticly repeatable.
my $last_auto_repeatable_command;

# Main input loop.
{
    my $line;

    while ( $done == 0 ) {
	$line = $term->readline($prompt);
	last unless defined($line);
	# Autorepeat the last command if line was blank and we have
	# something to repeat.
	if ( $line =~ /^\s*$/ and 
	     defined($last_auto_repeatable_command) ) {
	    execute_command($last_auto_repeatable_command);
	} else { # otherwise, really parse the line for commands.
	    # Entire command line, may contain multiple semicolon
	    # seperated commands.
	    my @commands_on_line;
	    unless ( @commands_on_line = parse_line(';', 1, $line) ) {
		# If line was not empty (which also causes parse_line
		# to return empty list) ...
		if ( $line ) {
		    # then report the error.
		    print STDERR "Failed to parse command line, mismatched or mis-escaped single or 
double quote(s)?\n";
		}
		next;
	    }
	    # Defensive programming protects against current (30 Dec
	    # 2001) weird behavior of parse_line (it puts undef in
	    # returned array when it parses a line ending in the
	    # delimeter) but should work if/when parse_line gets fixed
	    # also.
	    unless ( defined($commands_on_line[$#commands_on_line]) ) { 
		$commands_on_line[$#commands_on_line] = "";
	    }
	    # Most recently processed individual non-empty command.
	    my $latest_command;
	    # Flag true if the last command completed successfully.
	    my $command_success_flag;
	    # Try to run the individual command(s) on the line.
	    foreach my $command ( @commands_on_line ) {
		# Unless the command was empty, execute it.
		unless ( $command =~ /^\s*$/ ) {
		    $latest_command = &stripwhite($command);
		    $command_success_flag = not &execute_command($latest_command);
		}
	    }
	    
	    # Handle remembering of commands that can be automaticly
	    # repeated by hitting enter on a blank line.
	    
	    # Assume we aren't looking at a repeatable command.
	    $last_auto_repeatable_command = undef;
	    
	    if ( (@commands_on_line == 1) and ($command_success_flag) ) {
		# The abbreviated command name as it was typed on the
		# command line.  We know it is parsable by shellwords,
		# completes and is unique because we have
		# $command_success_flag from the above if.
		my $abbrev = (shellwords($latest_command))[0];
		my $actual_name = (&soundgrab_completion($abbrev, $abbrev, 0, 
							 length($abbrev)))[0];
		if ( $actual_name =~ /^(ff)|(rw)|(browse)$/ ) {
		    $last_auto_repeatable_command = $latest_command;
		}
	    }
	}
    } continue {
	# Any nonempty command line typed by the user goes in the
	# history.  Normally this is done implicitly by readline.
	unless ( $term =~ /^\s*$/ ) {
	    $term->AddHistory($line);
	}
    }
}

exit(0);

# Execute a command.
sub execute_command {
    my $command_with_args = shift;
    my ($com_name, @com_args);
    unless ( ($com_name, @com_args) = shellwords($command_with_args) ) {
	printf STDERR "Failed to parse command, mismatched (double) quote(s)?\n";
	return(1);
    }
    my $command = find_command($com_name);

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

    # Issue dire warnings if the volume appears to have been screwed with.
    # FIXME: probably needs gnome mode I/O fixed.
    if ( defined($volume) ) {
	&volume_sanity_check($volume);
    }

    # Block delivery of SIGCHLD during user command execution.
    &block_sigchld;

    # 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.
    # FIXME: play with replacing outer {} with ()
    my $command_func_return_value = &{$command->{func}}(@com_args);
    
    # Unblock SIGCHLD.
    &unblock_sigchld;

    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};
    }
}

# 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.

    # Look for a command to complete whenever $text is the first space
    # delimited token on $line, otherwise look to complete a
    # chunkname, failing that default readline completion will take
    # over automaticly.
    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] =~ /^\Q$text\E/) {
		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] =~ /^\Q$text\E/) {
		return $name[$list_index - 1];
	    }
	}

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

# Display commane line help.
sub com_help {
    my $arg = shift;
    unless ( defined($arg) ) {
	my $help_text  = <<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.
Hitting return on a blank line will repeat any successful ff, rw, or
browse command that appeared by itself (i.e. without any unquoted
semicolons) on the immediately preceeding 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, volume, help, quit.
END_INTERACTIVE_HELP

        # If we have a decent terminal and a pager, use them,
        if ( (($ENV{'TERM'} eq "linux") or ($ENV{'TERM'} eq "xterm")) 
	     and ($ENV{'PAGER'}) ) {
	    if ( system("echo '$help_text' | $ENV{'PAGER'}") ) {
		die "'system(\"echo '$help_text' | $ENV{'PAGER'}\")' failed";
	    }
	} else { # if no decent pager, just dump help text.
	    print $help_text;
	}
    } elsif ( $commands{$arg} ) {
	# Funny print because I can't bring myself to trust the first
	# argument to interpolate properly into a string, though it
	# seems to work.
	print(($commands{$arg}->{doc}), "\n");
    } 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 ) {
        unless ( &$prompt_yes_no_ref("Named chunks of the current input volume have been defined which have not 
yet been exported with the export command.  Quit anyway (y/N)? ", "n") ) {
	    return(0);
	}
    }
    if ( $playing_flag or $browsemode ) {
        &stop_core;
    }
    $done = 1;

    return(0);
}

} # End of command line interface part.

# Both interfaces use many of these functions.

# 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);
    }

    &check_volume_loaded("play") or 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 ) {
                &$com_message("Entering play mode from near the beginning of a played browse section.\n");
            } elsif ( $stop_pos - $last_pos > $browse_play_time
		                              - $browse_em ) {
                &$com_message("Entering play mode from near the end of a browse section.\n");
	    }
            &stop_core;
        }
	if ( $last_pos >= $volume_length ) {
	    # Note the rawplay gets executed in spite of this message.
	    # It looks like its always been that way and I don't want
	    # to screw it up.
	    print STDERR "play: head is already at end of volume\n";
	}
	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);
    } 

    &check_volume_loaded("stop") or 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 ) {
                &$com_message("Player stopped near the beginning of a played browse section.\n");
            } elsif ( $stop_pos - $last_pos > $browse_play_time
                                              - $browse_em ) {
                &$com_message("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);
    } 

    &check_volume_loaded("mark") or 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 ) {
            &$com_message("Mark placed near the beginning of a played section.\n");
        } elsif ( $mark_pos - $last_pos > $browse_play_time - $browse_em ) {
            &$com_message("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) ) {
        &$com_error("name: too many arguments\n");
        return(1);
    }

    &check_volume_loaded("name") or 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) ) {
	&$com_error("name: the mark has not yet been placed on the volume\n");
	return(1);
    } 
    unless ( abs($pos_now - $mark_pos) >= 0.05 ) {
	&$com_error("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, "name");

    # If browsing, make sure user knows where the head was when name went off.
    if ( $browsemode ) {
        if ( $pos_now - $last_pos < $browse_em ) {
            &$com_message("Chunk named has endpoint near the beginning of a played section.\n");
        } elsif ( $pos_now - $last_pos > $browse_play_time - $browse_em ) {
            &$com_message("Chunk 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;
    # Second argument is the name of the command that called this
    # function, for error reporting.
    my $calling_com_name = shift;

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

    # Get a tilde expanded form of the path part.
    my $x_path = &tilde_expand_path($path);

    # path portion of file name must already exist and be executable
    # to us, so we can create files there later.
    while ( !(-e $x_path) or !(-w $x_path and -x $x_path) ) {
	my $gripe_string;
	if ( !(-e $x_path) ) {
	    $gripe_string = "Path 
   $path
does not exist.  Try another name: ";
	} else { # must be here because !(-w $x_path and -x $x_path)
	    $gripe_string = "No permission to create files in
   $path
Try another name: ";
	}
	$out_name = &$prompt_new_name_ref($gripe_string);

	# Parse new name and expand path for next interation of while.
	($fname, $path, $suffix) = fileparse($out_name, @known_extensions);
	my $x_path = &tilde_expand_path($path);
    }

    # If the extension doesn't correspond to something we can handle,
    # show a warning and change it to a new extension that does.
    $out_name = &ensure_known_extension($out_name, $calling_com_name);

    # 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 tilde
    # expanded version of the chunk name we are trying to create
    # already exists, see if the user wants to pick another name.
    my $x_out_name = &tilde_expand_path($out_name);
    # Flag true with meaningful value iff we are given a directory
    # name which tilde-expands to the tilde expansion of an existing
    # chunk name.
    my $new_exp_match_exist = 0;
    foreach my $unexpanded_name (keys %names) {
	if (       &tilde_expand_path($out_name) 
	        eq &tilde_expand_path($unexpanded_name) ) {
	    $new_exp_match_exist = $unexpanded_name;
	}
    }
    while ( (-e $x_out_name) or (defined($names{$out_name})) or
	    (defined($names{$x_out_name})) or ($new_exp_match_exist)) {
	my $pick_new = 0;	# True if we decide we want to pick a new name.
	if ( -e $x_out_name ) {
	    # New name will clobber an existing file.
	    if ( &$prompt_yes_no_ref("A file with name
   $x_out_name
already exists.  Pick a different name (Y/n)? ", "y") ) {
		$pick_new = 1;
	    }
	} elsif ( defined($names{$out_name}) ) {
	    # New name will redefine an existing chunk.
	    if ( &$prompt_yes_no_ref("Another chunk with name 
   $out_name
has already been defined.  Pick a different name (Y/n)? ", "y") ) {
		$pick_new = 1;
	    }
	} elsif ( defined($names{$x_out_name}) ) {
	    # New name will result in an extra definition referring to
	    # same file.
	    if ( &$prompt_yes_no_ref("A tilde-equivalent chunk with name
   $x_out_name
has already been defined.  Pick a different name (Y/n)? ", "y") ) {
		$pick_new = 1;
	    } else {
		# Ditch existing tilde-equivalent chunk.
		delete($names{$x_out_name});
	    }
	} elsif ( $new_exp_match_exist ) {
	    # New name will result in an extra definition referring to
	    # same file.
	    if ( &$prompt_yes_no_ref("A tilde-equivalent chunk with name
   $new_exp_match_exist
has already been defined.  Pick a different name (Y/n)? ", "y") ) {
		$pick_new = 1;
	    } else {
		# Ditch existing tilde-equivalent chunk.
		delete($names{$new_exp_match_exist});
	    }
	}

	# Redo the check for the complicated condition in while loop.
	my $new_exp_match_exist = 0;
	foreach my $unexpanded_name (keys %names) {
	    if (       &tilde_expand_path($out_name) 
		    eq &tilde_expand_path($unexpanded_name) ) {
		$new_exp_match_exist = $unexpanded_name;
	    }
	}

	if ( $pick_new ) {
	    # Get new name, deal with extension, and perform tilde
	    # expansion as before, then try again.
	    $out_name = &$prompt_new_name_ref("New name: ");
	    $out_name = &ensure_known_extension($out_name, $calling_com_name);
	    $x_out_name = &tilde_expand_path($out_name);
	} 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($arg) ) {
	print STDERR "oggment: at least one argument required\n";
	return(1);
    }

    &check_volume_loaded("oggment") or return(1);

    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);
	}

        # 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);
    }

    &check_volume_loaded("list") or 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);
    }

    &check_volume_loaded("list") or 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 {
    # There must be two arguments.
    unless ( $#_ == 1 ) {
	print STDERR "changename: wrong number of arguments, exactly two arguments required\n";
    }

    &check_volume_loaded("changename") or return(1);

    # Process the first two command arguments.
    my $arg1 = shift;
    my $arg2 = shift;
    unless ( defined($names{$arg1}) ) {
        print STDERR "changename: no chunk named
$arg1
is currently defined\n";
        return(1);
    }

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

    # 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);
    }

    &check_volume_loaded("export") or return(1);

    unless ( keys %names ) {
	&$com_message("There are no unexported named chunks to export.\n");
    }

    # If playing or browsing, stop doing so, to give the drive a break.
    my $were_playing = 0;
    if ( $playing_flag ) {
	$were_playing = 1;
	&$com_message("Stopping player while exporting (give your drive a break).\n");
	&stop_core;
    }
    my $were_browsing = 0;
    if ( $browsemode ) {
        $were_browsing = 1;
        &$com_message("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 against some fs changes.
	my $x_path = &tilde_expand_path($path);
	unless ( -e $x_path ) {
	    &$com_message("Directory
   $path
does not exist.  Something must have changed since you named this chunk.  
Skipping named chunk
   $name\n");
            next;
	}
	unless ( -w $x_path and -x $x_path ) {
	    &$com_message("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)/ ) {
	    # Assume flac can achieve at least 0.7 compression factor.
	    $space_needed = 0.7 * ($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`);
	    unless ( &$prompt_yes_no_ref("You probably don't have enough disk space for:
$name
at the moment ($crnt_date).  Try to export it anyway (y/N)? ", "n") ) {
		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 through unchanged.
	    if ( $input_sample_format eq "s16_le" ) {
		$sox_args .= "-t sw ";
	    } elsif ($input_sample_format eq "u8" ) {
		$sox_args .= "-t ub ";
	    }
	}

        # Quoted, tilde-expanded name safe for passing to shell.  To
        # allow most arbitrary stupid file names.
	my $qx_name = &quoteify(&tilde_expand_path($name));

	# 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 .= "$qx_name ";
	}
	$system_arg .= "sox $sox_args ";

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

        if ( $name =~ /(\.ogg)$/ ) {
	    # Ogg comment, artist, etc. fields probably contain weird
	    # chars so they get quoted.  Oddly, the command line
	    # options for the comment fields are stored in %names,
	    # this is to make the data in that array somewhat
	    # self-describing.
	    my $q_ogg_comment = $names{$name}[2] ? quoteify($names{$name}[2]) 
		                                 : "";
	    my $q_ogg_artist = $names{$name}[3] ? quoteify($names{$name}[3])
                                                : "";
	    my $q_ogg_title = $names{$name}[4] ? quoteify($names{$name}[4])
                                               : "";
	    my $q_ogg_album = $names{$name}[5] ? quoteify($names{$name}[5])
                                               : "";
	    $system_arg .= "oggenc --raw --raw-chan=$channels --bitrate=$ogg_kbitrate --quiet --output=$qx_name $q_ogg_comment $q_ogg_artist $q_ogg_title $q_ogg_album -";
	}

        if ( $name =~ /(\.flac)|(\.ogg)$/ ) {
	    &$com_message("Encoding and writing \"$name\"... ");
	} else {
	    &$com_message("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;
	    &$com_message("done.\n");
	    delete $names{$name};
	}
    }

    # Resume playing or browsing if we were before the export command.
    if ( $were_playing ) {
	&$com_message("Player restarted.\n");
	&com_play();
    }
    if ( $were_browsing ) {
        &$com_message("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;
    }

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

    &check_volume_loaded("ff") or return(1);

    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);
    }

    $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;
	    &$com_message("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 ) {
            &$com_message("Fast forward executed from near the beginning of a played section.\n");
        } elsif ( $ff_start_point - $last_pos > $browse_play_time
                                                - $browse_em ) {
            &$com_message("Fast forward executed from near the end of a played section.\n");
        }
        &stop_core;
        if ( $last_pos + $ff_secs >= $volume_length ) {
            $last_pos = $volume_length;
            &$com_message("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;
	    &$com_message("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;
    }

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

    &check_volume_loaded("rw") or return(1);

    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);
    }

    # 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;
	    &$com_message("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 ) {
            &$com_message("Rewind executed from near the beginning of a played section.\n");
        } elsif ( $rw_start_point - $last_pos > $browse_play_time
                                                - $browse_em ) {
            &$com_message("Rewind executed from near the end of a played section.\n");
        }
        &stop_core;
        if ( ($last_pos -= $rw_secs) < 0 ) {
	    $last_pos = 0;
            &$com_message("Rewind stopped at beginning of volume.\n");
        }
	&com_browse();
    } else {
	if ( ($last_pos -= $rw_secs) < 0 ) {
            $last_pos = 0;
	    &$com_message("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) ) {
	&$com_error("jump: argument required\n");
	return(1);
    }
    if ( defined(shift) ) {
        &$com_error("jump: too many arguments\n");
        return(1);
    }

    &check_volume_loaded("jump") or 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 {
          &$com_error("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) ) {
	    &$com_error("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)) ) {
	    &$com_error("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) ) {
		my $err_string = "jump: TIME argument '$arg' ";
		unless ( $arg =~ /[aApP][mM]?$/ ) {
		    $err_string .= "(understood to be in 24 hour format) ";
		}
		$err_string .= "is not in this volume, given command line option argument '$time_of_start'";
		unless ( $time_of_start =~ /[aApP][mM]?$/ ) {
		    $err_string .= " (understood to be in 24 hour format)";
		}
		&$com_error("$err_string\n"); 
		return(1);
	    }
	}
    } else {
	# Translate a quantitfy of time with units to an offset if possible.
	unless ( defined($offset = &quantity_time_to_seconds($arg)) ) {
	    &$com_error("jump: don't know how to handle argument: $arg\n");
	    return(1);
	} 
    }

    if ( ($offset < 0) or ($offset > $volume_length) ) {
	&$com_error("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);
    }

    &check_volume_loaded("head") or 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);
    }

    &check_volume_loaded("checkmark") or 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);
    }

    &check_volume_loaded("browse") or 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);
}

# Set or reset the volume being dissected, and possibly the associated
# TIME-OF-START.
sub com_volume 
{
    if ( $#_ > 1 ) {
	print STDERR "volume: too many arguments\n";
    }

    # Do we have a reasonable looking new volume name to go to?
    my $new_volume = shift;
    unless ( defined($new_volume) ) {
	print STDERR "volume: argument required\n";
	return(1);
    }

    if ( !(-e $new_volume) ) {
	&$com_error("volume: '$new_volume' does not exist\n");
	return(1);
    } elsif ( !(-r $new_volume) ) {
	&$com_error("volume: '$new_volume is not readable\n");
	return(1);
    }

    # In case the user doesn't want to pitch currently defined chunks.
    if ( %names ) {
	unless ( &$prompt_yes_no_ref("Named chunks of the current input volume have been defined which have not yet been
exported with the export command.  Load new volume anyway (y/N)? ", "n") ) {
	    return(0);
	}
    }

    # Do we have a reasonable new time_of_start? 
    my $new_time_of_start = shift;
    my $new_volume_start_offset;
    if ( defined($new_time_of_start) ) {
	unless ( defined($new_volume_start_offset 
			 = time_to_offset($new_time_of_start)) ) {
	    print STDERR "volume: failed to parse argument '$new_time_of_start'\n";
	    return(1);
	}
	if ( $volume_start_offset >= 86400 ) {
	    print STDERR "volume: argument '$new_time_of_start' had illegal day offset\n";
	    return(1);
	}    
    }
	
    # New volume name and time_of_start look reasonable, reset globals.
    if ( $playing_flag or $browsemode) {
	&stop_core;
    }

    $volume = $new_volume;
    $volume_size = (stat $volume)[7];
    $volume_length = $volume_size * 8 / ( $bps * $sampling_rate * $channels);
    $last_volume_time_check = time;

    undef $start_time;
    $last_pos = 0;

    # The start offset may or may not have been reset.
    if ( defined($new_time_of_start) ) {
	$volume_start_offset = $new_volume_start_offset;
    } else {
	undef $volume_start_offset;
    }
    
    undef $mark_pos;
    undef %names;
} 

# Functions that report errors.  These also use different output
# facilities depending on which interface is in use.

# Verify that there is a volume loaded or complain and return failure.
sub check_volume_loaded {
    # Argument is the name of the command doing the checking.
    my $com_name = shift;

    if ( defined($volume) ) {
	return 1;
    } else {
	&$com_error("$com_name: there is no volume loaded currently (try 'help volume')\n"); 
	return 0;
    }
}

# 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) ) {
	&$com_error("$progname: '$volume' file no longer exists, this means trouble...\n");
	return 0;
    }
    if ( !(-r $volume) ) {
	&$com_error("$progname: '$volume' is no longer readable, this means trouble...\n");
	return 0;
    }
    if ( (stat($volume))[9] > $last_volume_time_check ) {
	&$com_error("$progname: '$volume' appears to have changed since it was loaded, this could mean trouble...\n");
	$last_volume_time_check = time;
	return 0;
    }
    
    # Made it through the checks, so return true.
    return 1;
}

# 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;
}

# If we can't deal with files of the type corresponding to the suffix
# we see on the argument, warn user and change to the default
# extension (the default extension is tested to be ok at startup).  If
# we don't see a suffix we recognize, silently add the default
# extension.
sub ensure_known_extension {
    my $name = shift;
    my $calling_com_name = shift;

    if ( ($name =~ /\.ogg$/) and (!&have_oggenc) ) {
	print STDERR "$calling_com_name: warning: oggenc executable not found, changing extension for this chunk to default output file type extension '.$output_file_format'\n";
	$name =~ s/\.ogg$/\.$output_file_format/;
    }
    if ( ($name =~ /\.flac$/) and (!&have_flac) ) {
	print STDERR "$calling_com_name: warning: flac executable not found, changing extension for this chunk to default output file type extension '.$output_file_format'\n";
	$name =~ s/\.flac$/\.$output_file_format/;
    }

    unless ( $name =~ /\.$known_extensions_pattern$/ ) {
	$name .= '.'.$output_file_format;
    }

    return $name;
}

# Strip whitespace from the start and end of string, returned stripped
# string.  Note that trailing newlines get removed.
sub stripwhite {
    my $string = shift;
    $string =~ s/^\s*//;
    $string =~ s/\s*$//;
    return $string;
}

# Perform tilde expansion on a path argument.  Works like the
# shell: if expansion fails, you get the argument back unmodified.
# The returned path features a trailing backslash iff the argument
# featured one.
sub tilde_expand_path {
    my $path = shift;

    # Won't expand usernames with spaces.  With only a leading tilde
    # followed by word characters this shouldn't be a dangerous thing
    # to pass on to test -d and ls -d commands.
    if ( $path =~ /^(~\w*)(\/.*)?$/ and !system("test -d $1") ) {
	chomp($path = `ls -d $1`);
	$path .= $2;
    }

    return $path;
}

# Quotify a string for subsequent passage to the shell.  This kind of
# mucking around is *dangerous*, you must know exactly what you are
# doing and think extremely carefully and you can still get burned.
sub quoteify {
    my $arg = shift; 		# Get argument.
    
    $arg =~ s/\'/\'\"\'\"\'/g;	# Quoteify arg assuming surrounding quotes.
    
    return "'".$arg."'";	# Surround with quotes and return.
}

# Check the validity of a signless decimal number argument, return
# true or false.
sub is_signless_decimal_num {
    my $arg = shift;

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

# Check the validity of a whole number argument, return true of false.
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;
    if ( $arg eq "" ) {
	die "internal function quantity_time_to_seconds got null string for an argument, looks like a bug\n";
    }

    # Match subexpression in time quantity.
    unless ( $arg =~ /
	             ^\s* # Whitespace at the start of the argument.
	             (?:(?=\d)(\d*[.]?\d*)d)?	 # Optional days part
                     (?:(?=\d)(\d*[.]?\d*)h)?  # Optional hours part
                     (?:(?=\d)(\d*[.]?\d*)m)?  # Optional minutes part
	             (?:(?=\d)(\d*[.]?\d*)s?)? # Optional seconds part
                     \s*$ # Whitespace at the end 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) ) {
	unless ( &is_signless_decimal_num($day_offset 
					  =~ s/^(\d+)(d|da|day|days)?$/$1/) ) {
	    return undef;
	}
    }

    # Deal with am/pm.
    my $am_flag = 0;
    my $pm_flag = 0;    
    if ( $time =~ /(.*)[pP][mM]?$/ ) {
	$time = $1;
	$pm_flag = 1;
    }
    if ( $time =~ /(.*)[aA][mM]?$/ ) {
	$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;
    }
}

# Notational shorthand for blocking of SIGCHLD.
sub block_sigchld {
    unless ( defined sigprocmask(SIG_BLOCK, $sigset_sigchld, $old_sigset) ) {
        die "$progname: could not block SIGCHLD\n";
    }
}

# Notational shorthand for unblocking of SIGCHLD.
sub unblock_sigchld {
    unless ( defined sigprocmask(SIG_UNBLOCK, $sigset_sigchld) ) {
        die "$progname: could not unblock SIGCHLD\n";
    }
}
