#!/usr/bin/perl -W
#
# slsh- A sooperlooper shell
# Copyright 2005 Martin Habets
#
# For help run 'slsh -h'

=head1 NAME

slsh - A sooperlooper shell

=head1 SYNOPSIS

slsh [-hV] [-H <host> [-P <num>] [-c <num>] [-t <numsecs>] [file]

=head1 DESCRIPTION

slsh provides a command line interface for sooperlooper.
It can run interactively or as an interpreter of batch scripts.

The scripts are usefull to store a sooperlooper setup or
configuration. Interactive is usefull for experimenting and provides
an alternative to slconsole and slgui.

=cut

#use strict;
use threads;
use threads::shared;
use Socket;
use Audio::OSC::Client;
use Audio::OSC::Server;
use Data::Dumper qw(Dumper);
use Getopt::Std;

my $Pgm = "slsh";
my $OSCPgm = "/".$Pgm;
my $Version = "1.0.0";

# Command line parameters
my $osc_host = "localhost";
my $osc_port = 9951;
my $channels = 2;
my $loop_length = 0;	# 0 means: use engine default

# Shared data between client&server
my $serv_port = 0;	# My server port
my $uri = "";		# URI of server port
my $ack = 0;		# acknowledgements received
my $sloopers = -1;	# Number of sooperloopers engines running
my $batch_mode = 0;	# 0=interactive, 1=batch
$batch_mode = 1 unless (-t);
share($uri);
share($ack);
share($sloopers);
share($batch_mode);

# Client data
my $cur_slooper = 0;
my $input = "ARGV";	# input selection.

# These names indicate global settings. Anything else is loop specific.
my @global_params = ( "tempo", "eight_per_cycle",
		      "sync_source", "tap_tempo",
		      "save_loop",
);

# debug function
sub strdump {
	foreach $fld (@_) {
		print $fld,':';
	}
	print "\n";
}

# print if on a terminal
sub verbose {
	print @_ if ($batch_mode == 0);
}

#

=head1 OPTIONS

 -H <host>	hostname of the OSC server (default is localhost)
 -P <num>	udp port number for OSC server (default is 9951)
 -c <num>	channel count for each looper (default is 2)
 -t <numsecs>	number of seconds of loop memory per channel (default
		is determined by sooperlooper)
 -h		help message
 -V		show version number

=cut

sub parse_cmdline {
	my %opts;
	getopts('hVH:P:c:t:', \%opts);

	$osc_port = $opts{'P'} if (exists $opts{'P'});
	$osc_host = $opts{'H'} if (exists $opts{'H'});
	$channels = $opts{'c'} if (exists $opts{'c'});
	$loop_length = $opts{'t'} if (exists $opts{'t'});
	if (exists $opts{'h'}) {
		print "\n";
		system("pod2text $0 | \${PAGER:-pg}");
		exit;
	}
	if (exists $opts{'V'}) {
		exit;
	}

	# TODO: Check args
	$batch_mode = 1 if ($ARGV[0]);
}


# Counterpart to send_ack
# Parameter is the $ack value taken before a possible ack.
# Returns true if no ack was received.
sub wait4ack {
	my $prev_ack = $_[0];

	{ lock($ack);

	  # wait for ack.
	  my $abs = time()+5;
	  until ($ack > $prev_ack) {
		$serv_thr->yield();
		last if !cond_timedwait($ack, $abs);
	  }
	}
	#if ($ack == $prev_ack) {
	#	verbose "No acknowledgement.\n";
	#}
	return($ack <= $prev_ack);
}

# These are all the commands, i.e the first word in a line.
my %commands = (
	'quit'		=> \&do_quit,
	'ping'		=> \&do_ping,
	'load'		=> \&do_load,
	'load_loop'	=> \&do_load,
#	'save'		=> \&do_save,	TODO
	'down'		=> \&do_down,
	'up'		=> \&do_up,
	'forceup'      	=> \&do_forceup,
	'hit'		=> \&do_hit,
	'mute'		=> \&do_mute,
	'loop'		=> \&do_engine,	# term 'loop' can be confusing
	'loop_add'	=> \&do_engine_add,
	'loop_del'	=> \&do_engine_del,
	'get'		=> \&do_get,
	'set'		=> \&do_set,
	'slgui'		=> \&do_slgui,
	'slsh'		=> \&do_slsh,
	'slconsole'	=> \&do_slconsole,
	'version'	=> \&do_version,
	'help'		=> \&do_help,
);

=head1 EXAMPLES

=over 8

=item slsh -p 1234

This starts an interactive shell and tries to connect to a sooperlooper
on UDP port 1234.

=item slsh < mysong.sl

This starts a batch interpreter taking input from file C<mysong>.
slsh exits after all commands have been executed, leaving the
sooperlooper egines running (unless C<mysong> contains the C<exit>
command). C<mysong> could look like this:

 # This is my song
 loop add
 mute
 load drum1.wav
 loop add
 mute
 load guitar.wav

 # Set some parameters for all loops
 -1
 set sync
 set playback_sync
 set quantize 3

 # Everything is set up, now continue using the gui
 slgui

=item ./mysong2.sl

You can execute your script directly if you adhere to the following:

 - the script must be executable
 - it must start with a line like this:
   #!/usr/bin/perl /usr/local/bin/slsh
   Adjust the paths to perl and slsh if needed.

=back

Some tips for writing scripts:

 - As the last command in a script, start your favorite user interface:
   slgui, slconsole or slsh.
 - Mute an engine before loading a file.
 - Do not use abolute engine numbers (see "Engine Selection" below).
   Rather, use relative positioning. This way you can add multiple
   scripts together.

=head1 COMMANDS

Most commands are the same as the OSC protocol path without the leading
slash and without the leading nodes. e.g. C</sl/0/up> becomes C<up>.

There are a few extra commands that are not part of the sooperlooper OSC
interface. These are: B<slgui>, B<slsh>, B<slconsole>, B<version>, B<help>,
and some of the B<engine selection> commands.
Any line starting with a C<#> is ignored, allowing for comment lines.

Use C<Control-D> to exit the interactive interpreter and keep the sooperlooper
engines running. Use C<quit> to exit the interpreter and remove the
sooperlooper engines.

=head2 Commands Supported

=over 8

=item quit

This signals the sooperlooper engine to shutdown. slsh is also
terminated.

=cut

sub do_quit {
	$client->send([ '/quit', NULL]);
}

=item ping

Check if an engine is there. If so, it will respond with it's
version number and the number of loopers present.

=cut

sub do_ping {
	my $prev_ack = $ack;

	$client->send([ '/ping', 's', $uri, 's', '/pingack']);

	if (wait4ack($prev_ack)) {
		print "Ping not acknowledged.\n";
	}
}

=item load <filename>

Load an audio file into current engine. The current directory is
used if no path is given.

=cut

sub do_load {
	my $fname = $_[1];
	#verbose "load: ",$fname,"\n";
	return unless ($fname);

	# Prepend path if not absolute/relative already.
	if ($fname !~ "^[/.].*") {
		$fname = $ENV{PWD}.'/'.$fname;
	}

	$client->send([ '/sl/'.$cur_slooper.'/load_loop',
		's', $fname,
		's', $uri, 's', '/blah']);
}

=item down <sl_command>

Do a command press.

=cut

sub do_down {
	if (!$_[1]) {
		verbose "down needs argument.\n";
		return;
	}
	$client->send([ '/sl/'.$cur_slooper.'/down', 's', $_[1] ]);
}

=item up <sl_command>

Do a command release

=cut

sub do_up {
	if (!$_[1]) {
		verbose "up needs argument.\n";
		return;
	}
	$client->send([ '/sl/'.$cur_slooper.'/up', 's', $_[1] ]);
}

=item forceup <sl_command>

Do a forced release to do SUS-like actions.

=cut

sub do_forceup {
	if (!$_[1]) {
		verbose "forceup needs argument.\n";
		return;
	}
	$client->send([ '/sl/'.$cur_slooper.'/forceup', 's', $_[1] ]);
}

=item hit <sl_command>

Do a single hit only, no press-release action.

C<sl_command> can be: record, overdub, multiply, insert, replace,
reverse, mute, undo, redo, oneshot, trigger, substitute.

=cut

sub do_hit {
	if (!$_[1]) {
		verbose "hit needs argument.\n";
		return;
	}
	$client->send([ '/sl/'.$cur_slooper.'/hit', 's', $_[1] ]);
}

=item mute

This is a shortcut for C<down mute>.

=cut

sub do_mute {
	do_down('down', 'mute');
}

# Create a new sooperlooper
sub init_slooper {
	system "sooperlooper &";
	sleep 1;
	verbose "Created new sooperlooper server\n";
}

=item loop_add

=item loop add

These commands are identical. They add a looper engine and then select it.
If no sooplooper is running one will be created.

=cut

sub do_engine_add {
	# If we have never done a ping we dont know how many engines
	# there are. So do a ping to find that out.
	if ($sloopers == -1) {
		do_ping;
	}

	if ($sloopers == -1) {
		init_slooper;
		$sloopers = 0;
	} else {
		$client->send([ '/loop_add', 'i', $channels,
				'f', $loop_length ]);
	}
	$sloopers++;
	$cur_slooper = $sloopers-1;	# Is the new loop always at last?

	# sooperlooper needs some time to cleanup its memory, or we get
	# this strange errors when loading a loop:
	# file is too long for available space: file: 256994  free: 0
	sleep 1;
}

=item loop_del

=item loop del

These commands are identical. They delete the looper engine that is
currently selected.

=cut

sub do_engine_del {
	if ($cur_slooper == -1) {
		verbose "No engine selected.\n";
		return;
	}
	$client->send([ '/loop_del', 'i', $cur_slooper ]);
	$sloopers--;
	# Range check
	if ($cur_slooper >= $sloopers) {
		$cur_slooper = $sloopers-1;
	}
}

=item loop first

This selects looper 0.

=item loop last

This selects the last looper.

=item loop next

This selects the next looper.

=item loop prev

This selects the previous looper.

=cut

sub do_engine {
	@_ = split;
	if ($_[1] eq "add") {
		do_engine_add;
	} elsif ($_[1] eq "del") {
		do_engine_del;
	} elsif ($_[1] eq "first") {
		$cur_slooper = 0;
	} elsif ($_[1] eq "last") {
		$cur_slooper = $sloopers-1;
	} elsif ($_[1] eq "next") {
		$cur_slooper++ if ($cur_slooper < $sloopers-1);
	} elsif ($_[1] =~ "prev.*") {
		$cur_slooper-- if ($cur_slooper > -1);
	} else {
		warn "loop: Unknown parameter ",$_[1],"\n";
	}
}

=item get <param>

Gets the value of parameter C<param>. The parameter name is used
to determine if it is global or specific for a loop.

The Global parameter names are documented in the C<set> command
below. Loop specific parameters are also documented there, but
some additional ones can be used:
control, loop_len, loop_pos, cyce_len, free_time, total_time,
rate_output.

=cut

sub do_get {
	@_ = split;

	if (!$_[1]) {
		verbose "get needs argument.\n";
		return;
	}
	if (grep $_[1] eq $_, @global_params) {
		$client->send([ '/get', 's', $_[1],
				's', $uri, 's', '/set']);
	} else {
		$client->send([ '/sl/'.$cur_slooper.'/get', 's', $_[1],
				's', $uri, 's', '/set']);
	}
}

=item set <param>

Sets the value of parameter C<param>. The parameter name is used
to determine if it is global or specific for a loop.

Global parameters are: tempo, eight_per_cycle, sync_source,
tap_tempo, save_loop.

Loop specific parameters are: rec_thresh, feedback, dry, wet, rate,
scratch_pos, delay_trigger, quantize, round, redo_is_tap, sync,
playback_sync, use_rate, fade_samples, use_feedback_play.

=cut

sub do_set {
	@_ = split;

	if (!$_[1]) {
		verbose "set needs argument.\n";
		return;
	}
	$value = $_[2];
	$value = 1 if (!$_[2]);

	if (grep $_[1] eq $_, @global_params) {
		$client->send([ '/set', 's', $_[1],
				'f', $value]);
	} else {
		$client->send([ '/sl/'.$cur_slooper.'/set', 's', $_[1],
				'f', $value]);
	}
}

=item slgui

This spawns the slgui program.

=cut

sub do_slgui {
	# TODO: parameters -H -p
	system "slgui &";
}

=item slsh

Switch to an interactive interpreter. This abandons further processing
of input files.

=cut

sub do_slsh {
	$batch_mode = 0;
	$input = "STDIN";
}

=item slconsole

This spawns the slconsole program.

=cut

sub do_slconsole {
	# TODO: parameters -H -p
	system "slconsole &";
}

=item version

This prints the version of slsh.

=cut

sub do_version {
	print "$Pgm version $Version Copyright 2005 Martin Habets\n"
}

=item help

This gives information on all available commands.

=cut

sub do_help {
	system "podselect -s \"COMMANDS|SEE ALSO\" $0 | pod2text | \${PAGER:-pg}";
}

=pod

=back

=head2 Engine Selection

Some commands apply only to one specific looper engine.
For this purpose, B<slsh> maintains the number of the current engine.
It defaults to 0, which is the first engine.

There are 3 ways to select an engine:

=over

=item 1.

Use the engine number. e.g. entering C<1<return>> will select the
second engine to be the current one.
slsh checks if the engine number is valid.

Engine number C<-1> is special: it causes commands to be applied to
all engines.

=item 2.

Use the C<loop first|last|next|prev> commands. The last two options
allow for relative positioning.

=item 3.

Some commands can change the current engine number. Usually this happens
when the current engine has become invalid, e.g. as a result of C<loop_del>.
C<loop_add> will set the current engine to the new one that was created.

=back

=cut

#
#	OSC Server
#
sub send_ack {
	lock($ack);
	$ack++;
	cond_signal($ack);
}

# Main server loop
sub Server_loop {
	# Start OSC server
	my $server = Audio::OSC::Server->new(Name  => $OSCPgm,
					Handler => \&Server_cmd)
		or die "Could not start server: $@\n";

	# Set our server uri (hostname + port)
	$serv_port = $server->port;
	{ lock($uri);
	  $uri = "osc.udp://".$server->name.":".$server->port."/";
	}
	verbose "OSC Client URI is: ",$uri,"\n";

	# This loop returns when 'exit' is received in a message.
	$server->readloop();

	exit;
}

# All responses the server serves.
my %responses = (
	'/pingack'	=> \&serv_pingack,
	'/set'		=> \&serv_set,
	'exit'		=> \&serv_exit,	# This is the shutdown request
);

sub serv_pingack {
	my @fields = @{$_[0]};

	$sloopers = $fields[6];
	verbose "pingack: Server version=",$fields[4],
		"\tloopcount=",$sloopers,"\n";
	send_ack;
}

sub serv_set {
	my @fields = @{$_[0]};

	verbose "$fields[4] = $fields[6]\n";
}

sub serv_exit {
	send_ack;
}

sub Server_cmd {
	my ($sender, $message) = @_;

	if ($responses{$$message[0]}) {
		$responses{$$message[0]}->($message);
	} else {
		warn "Unexpected command received from [$sender]: ",
			Dumper $message;
	}
}


#
#	Main code
#

do_version;
parse_cmdline;

# Start OSC client
our $client = Audio::OSC::Client->new(Host => $osc_host,
		Port => $osc_port, Name => $OSCPgm)
	or die "Could not start client: $@\n";

# Start server thread
our $serv_thr = threads->create("Server_loop");
$serv_thr->detach();
$serv_thr->yield() until ($uri);

#do_ping if (-t);

#
verbose $cur_slooper,": ";
while(<$input>) {
	chomp;
	my @fields = split;
	next if ($#fields < 0);

	# Ignore comment lines
	next if ($fields[0] =~ "^#");

	# Accept engine number
	if ($fields[0] =~ /[0-9]+/) {
		if ($fields[0] >= $sloopers) {
			verbose "Engine number out of range, max is ",
				$sloopers-1,". Command ignored.\n";
			next;
		}
		$cur_slooper = $fields[0];
		shift @fields;
	}
	#print "After shift: $#fields fields: ";
	#strdump(@fields);
	next if ($#fields < 0);

	my $cmd = $fields[0];
	if ($commands{$cmd}) {
		$commands{$cmd}->(@fields);
	} else {
		$client->send([@fields]);
	}
	last if ($cmd eq 'quit');
} continue {
	$serv_thr->yield();
	verbose $cur_slooper,": ";
}

verbose "\n";

# Kill the server thread
my $toserv = Audio::OSC::Client->new(Port => $serv_port,Name => $OSCPgm)
	or die "Could not start server thread conection: $@\n";
my $prev_ack = $ack;
$toserv->send(['exit']);
wait4ack($prev_ack);


=head1 SEE ALSO

 sooperlooper -h, slconsole -h, slgui -h,
 http://essejnet/sooperlooper/

=cut