#!/usr/bin/perl

$VERSION="0.0.3";
$CONFIG_PATH="/etc/cjackbay.conf:~/.cjackbay/cjackbayrc";
$SAVEDIR="~/cjackbay/";

{
	no warnings; # recent perls throw lots of Curses::UI warnings.
	use Curses::UI;
}

use IO::Select;
use Getopt::Long;
use POSIX;

use warnings;

sub parse_jack_lsp {
	my (@inputs, @outputs);
	my $cmd = $config{jack_lsp_path};
	open my $lsp, "$cmd -s $jack_server_opt -cpt 2>&1|" or die $!;

	my $is_input = 0;
	my $port;
	my $name = "";
	my @conns = ();
	for(<$lsp>) {
		chomp;
		#warn "$_\n";
		if(/jack.*not.*running/i) {
			$cui->disable_timer("monitor-timer");
			my $ok = $cui->dialog(
					-title => "Error",
					-message => "JACK server '$jack_server_opt' not running",
					-buttons => [ "ok" ],
					);
			$cui->enable_timer("monitor-timer");
			return;
		} else {
			if(/^\s+(\d+\s+bit\s+.*)/) {
				$port->{type} = $1;
			} elsif(/^(\S.*)/) {
				my $newname = $1;
				undef $port;
				$port->{name} = $newname;
			} elsif(/^\tproperties:\s(.*+)/) {
				my $props = $1;
				$port->{is_input} = $props =~ /input/;
				$port->{props} = $props;
				if($port && $port->{is_input}) {
					push @inputs, $port;
				} elsif($port) {
					push @outputs, $port;
				}
			} elsif(/^\s\s+(\S.*)/) {
#warn "pushing $1";
				push @{$port->{conns}}, $1;
			}
		}
	}

	return (\@inputs, \@outputs);
}


sub update_listboxen {
	my ($inputs, $outputs) = parse_jack_lsp;
	my @leftvals;
	my %leftlabs;
	my @rightvals;
	my @rightlabs;

	for(@$outputs) {
		push @leftvals, $_;
		$leftlabs{$_} = $_->{name};
	}

	for(@$inputs) {
		push @rightvals, $_;
		$rightlabs{$_} = $_->{name};
	}

	#warn "rightvals is @rightvals";
	my $oldleft = $leftbox->get_active_id();
	#warn "oldleft==$oldleft";
	my $oldright = $rightbox->get_active_id();
	$leftbox->onSelectionChange(sub { 1; });
	$leftbox->set_selection($oldleft);
	$rightbox->onChange(sub { 1; });
	$leftbox->labels(\%leftlabs);
	$leftbox->values(\@leftvals);
	$rightbox->labels(\%rightlabs);
	$rightbox->values(\@rightvals);
	my @rports = @{$rightbox->{-values}};
#my @rports = @{$rightbox->values()};
	#warn "\@rports is @rports";

	$leftbox->set_selection($oldleft);
	$leftbox->{-ypos} = $oldleft;
	$rightbox->{-ypos} = $oldright;
	$leftbox->onSelectionChange(\&update_right_box);
	$leftbox->draw;
	&update_right_box;
}

sub update_right_box {
	my $lport = $leftbox->get_active_value();
	my $oldright = $rightbox->get_active_id();
	$leftbox->onSelectionChange(sub { 1; });
	$leftbox->set_selection($leftbox->get_active_id());
	$leftbox->onSelectionChange(\&update_right_box);
	#warn "lport->{name} is " . $lport->{name} . " conns is " . join(",", @{$lport->{conns}});
	my @rports = @{$rightbox->{-values}};
#my @rports = @{$rightbox->values()};
	#warn "\@rports is @rports";
	my @to_select = ();
	$rightbox->onChange(sub { 1; });
	$rightbox->clear_selection();
	for my $lconn (@{$lport->{conns}}) {
		for my $i (0..$#rports) {
			#warn "checking rport " . $rports[$i]->{name};
			if($lconn eq $rports[$i]->{name}) {
				push @to_select, $i;
			}
		}
	}
	$rightbox->set_selection(@to_select);
	$rightbox->{-ypos} = $oldright;
	$rightbox->onChange(\&update_connections);
	$rightbox->draw;
}

sub update_connections {
	my $lport = $leftbox->get_active_value();
	if(defined $lport) {
		my @selected = $rightbox->get();
		my $active = $rightbox->get_active_value();
		if(grep { $_ == $active } @selected) {
#$cmd = "jack_connect \"" . $lport->{name} . "\" \"" . $active->{name} . "\"";
			$cmd = $config{jack_connect_path} || "jack_connect";
		} else {
#$cmd = "jack_disconnect \"" . $lport->{name} . "\" \"" . $active->{name} . "\"";
			$cmd = $config{jack_disconnect_path} || "jack_disconnect";
		}
		open my $fh, "$cmd \"" . $lport->{name} . "\" \"" . $active->{name} . "\" 2>&1|" or die $!;
		my $output = "";
		while(<$fh>) { $output .= $_; }
		if(!close $fh) {
			if(!$output) {
				if($cmd eq 'jack_connect') {
					$output = "No reason given; maybe tried to connect\n" .
						"an audio port to a MIDI port or vice-versa?";
				} else {
					$output = "No reason given; maybe another app\n" .
						"already disconnected the ports?";
				}
			}
		}
		if($output) {
			$cui->disable_timer("monitor-timer");
			$cui->dialog(
					-title => "$cmd failed",
					-message => $output,
					-buttons => [ "ok" ],
					);
			$cui->enable_timer("monitor-timer");
		}
	}
#sleep 1;
	update_listboxen;
}

sub make_listboxen {
	my $lb = $win->add(
			'listbox_left', 'Listbox',
			-x => 1,
			-y => 1,
			-border => 1,
			-fg => "white",
			-bg => "blue",
			-title => 'Outputs',
			-width => $width/2-2,
			-onselchange => \&update_right_box,
			-wraparound => 1,
			);

	$lb->set_binding(\&output_props_dialog, ("p", "P"));

	# GAAH! Before 1999 I never once saw "loose" as a misspelling of "lose",
	# now it's enshrined in an API specification...
	# Somehow the Internet is making us illiterate.
	$lb->set_binding('loose-focus', (Curses::KEY_ENTER(), Curses::KEY_RIGHT(), " "));

	my $rb = $win->add(
			'listbox_right', 'Listbox',
			-x => $width/2,
			-y => 1,
			-multi => 1,
			-border => 1,
			-fg => "yellow",
			-bg => "blue",
			-title => 'Inputs',
			-width => $width/2-2,
			-wraparound => 1,
			);

	$rb->set_binding('loose-focus', (Curses::KEY_RIGHT()));
	$rb->set_binding(\&input_props_dialog, ("p", "P"));

	return ($lb, $rb);
}

sub props_dialog {
	my $port = shift;
	my $content = "Name: " . $port->{name};
	$content .= " " x (($width - 16) - length $content);
	$content .= "\n";
	$content .= "Type: " . $port->{type} . "\n";

	for($port->{props}) {
		$content .= "Direction: ";
		if(/input/i) {
			$content .= "Input (writable)\n";
		} elsif(/output/i) {
			$content .= "Output (readable)\n";
		}

		$content .= "Physical: ";
		if(/physical/i) {
			$content .= "Yes\n";
		} else {
			$content .= "No\n";
		}

		$content .= "Terminal: ";
		if(/terminal/i) {
			$content .= "Yes\n";
		} else {
			$content .= "No\n";
		}

		$content .= "Can Monitor: ";
		if(/monitor/i) {
			$content .= "Yes\n";
		} else {
			$content .= "No\n";
		}

		if($port->{conns} && @{$port->{conns}}) {
			$content .= "Connected to:\n";
			for my $conn (@{$port->{conns}}) {
				$content .= "\t$conn\n";
			}
		} else {
			$content .= "Not Connected";
		}
	}
	$content =~ s/\n$//;

#$content .= "longline" x 20;
	$cut->disable_timer("monitor-timer");
	$cui->dialog(
			-title => "Port Properties",
			-message => $content,
			-buttons => [ "ok" ],
			);
	$cut->enable_timer("monitor-timer");
}

sub output_props_dialog {
	props_dialog($leftbox->get_active_value());
}

sub input_props_dialog {
	props_dialog($rightbox->get_active_value());
}

sub disconnect_all_dialog {
	$cut->disable_timer("monitor-timer");
	my $got = $cui->dialog(
			-title => "Warning",
			-tbg => 'black',
			-tfg => 'red',
			-bg => 'black',
			-fg => 'red',
			-message => "You are about to remove all JACK connections.\n" .
			            "There is NO undo option. Are you sure you want\n" .
							"to do this?",
			-buttons => [ "no", "yes" ],
			);
	$cut->enable_timer("monitor-timer");
	if($got == 1) {
		my ($inputs, $outputs) = parse_jack_lsp;
		for my $out (@$outputs) {
			next unless $out->{conns};
			for my $in (@{$out->{conns}}) {
				system("jack_disconnect \"" . $out->{name} . "\" \"" . $in . "\" 2>/dev/null");
			}
		}
	}
	update_listboxen;
}

# main():

$result = GetOptions(
		'server=s', \$jack_server_opt,
		'help', \$help_opt,
		'version', \$ver_opt,
		);

$jack_server_opt = $ENV{JACK_DEFAULT_SERVER} if !defined $jack_server_opt;
$jack_server_opt = $config{default_jack_server} if !defined $jack_server_opt;
$jack_server_opt = "default" if !defined $jack_server_opt;

($progname = $0) =~ s,.*/,,;
if($help_opt or !$result) {
	print <<EOF;
$progname - Perl Curses::UI based JACK patchbay

Usage: $progname [options]

Options:
	-s, --server <name>      Connect to JACK server named <name>
	-h, --help               Display this help message
	-v, --version            Show $progname version

See the manual ("man $progname") for more information.
EOF
	exit !$result;
}

if($ver_opt) {
	print "$progname $VERSION\n";
	exit 0;
}

%config = (
		default_jack_server => 'default',
		jack_lsp_path => 'jack_lsp',
		jack_connect_path => 'jack_connect',
		jack_disconnect_path => 'jack_disconnect',
		jack_evmon_path => 'jack_evmon',
		jack_wait_path => 'jack_wait',
		monitoring => 0,
		border_bg_color => '',
		border_fg_color => '',
		banner_bg_color => '',
		banner_fg_color => 'magenta',
		tab_fg_color => '',
		tab_bg_color => '',
		output_bg_color => 'blue',
		output_fg_color => 'white',
		input_bg_color => 'blue',
		input_fg_color => 'yellow',
		);

@config_errs = ();
for my $file (split /:/, $CONFIG_PATH) {
	my $origfile = $file;
	$file =~ s/^~/$ENV{HOME}/;
	if(open my $conf, "<$file") {
		my $line = 0;
		while(<$conf>) {
			$line++;
			s/\r//g; # in case the file's a DOS \r\n "text" file
			chomp;
			s/#.*//; # remove comments
			s/^\s*//; # remove leading spaces
			s/\s*$//; # remove trailing spaces
			next if /^$/; # skip this line if nothing is left
			if(!/=/) {
				push @config_errs, "$origfile:$line: syntax error: missing = sign";
				next;
			}
			my($k, $v) = split /\s*=\s*/, $_, 2;
			if(!exists $config{$k}) {
				push @config_errs, "$origfile:$line: ignoring invalid key '$k'";
				next;
			} else {
				$config{$k} = $v;
			}
		}
	}
}

$cui = Curses::UI->new(-color_support => 1);
$win = $cui->add('win', 'Window', -border => 0);
$banner = $win->add('title', 'Label', -text => "cjackbay v$VERSION - [P]roperties [R]efresh [S]ave [L]oad [D]isconAll [Q]uit");

$width = $ENV{COLS} || 80;

($leftbox, $rightbox) = make_listboxen;

$banner->set_color_fg($config{banner_fg_color}) if $config{banner_fg_color};
$banner->set_color_bg($config{banner_bg_color}) if $config{banner_bg_color};

$leftbox->set_color_bg($config{output_bg_color}) if $config{output_bg_color};
$leftbox->set_color_fg($config{output_fg_color}) if $config{output_fg_color};

$rightbox->set_color_bg($config{input_bg_color}) if $config{input_bg_color};
$rightbox->set_color_fg($config{input_fg_color}) if $config{input_fg_color};

$leftbox->set_color_tfg($config{tab_fg_color}) if $config{tab_fg_color};
$rightbox->set_color_tfg($config{tab_fg_color}) if $config{tab_fg_color};

$leftbox->set_color_tbg($config{tab_bg_color}) if $config{tab_bg_color};
$rightbox->set_color_tbg($config{tab_bg_color}) if $config{tab_bg_color};

$leftbox->set_color_bfg($config{border_fg_color}) if $config{border_fg_color};
$rightbox->set_color_bfg($config{border_fg_color}) if $config{border_fg_color};

$leftbox->set_color_bbg($config{border_bg_color}) if $config{border_bg_color};
$rightbox->set_color_bbg($config{border_bg_color}) if $config{border_bg_color};

update_listboxen;

$leftbox->focus();

if(@config_errs) {
	my $numerrs = scalar @config_errs;
	my $showing = ':';
	my $s = @config_errs == 1 ? "" : "s";
	if($numerrs > 10) {
		$#config_errs = 9;
		$showing = ", showing first 10:";
	}
	$cui->dialog(
			-title => "Config File Error$s",
			-message => "Found $numerrs error$s parsing config$showing\n" .
			            join("\n", @config_errs),
			-buttons => [ "ok" ],
			);
}

# Global key bindings
$cui->set_binding(sub { exit 0; }, ("q", "Q", Curses::UI::Common::CUI_ESCAPE()));
$cui->set_binding(\&update_listboxen, "r", "R", "\cL", Curses::UI::Common::KEY_F(5));
$cui->set_binding(\&disconnect_all_dialog, "d", "D");

# Fire up the JACK monitoring "thread" (not really a thread!)
if($config{monitoring}) {
	$cui->set_timer("monitor-timer", \&update_listboxen, 1);
}

$cui->mainloop();

__END__
$ jack_lsp -cp | cat -A
system:capture_1$
^Iproperties: output,physical,terminal,$
system:capture_2$
^Iproperties: output,physical,terminal,$
system:playback_1$
   bristol:out_left$
^Iproperties: input,physical,terminal,$
system:playback_2$
   bristol:out_right$
^Iproperties: input,physical,terminal,$
alsa_pcm:Midi-Through/midi_capture_1$
^Iproperties: output,physical,terminal,$
alsa_pcm:Midi-Through/midi_playback_1$
^Iproperties: input,physical,terminal,$
bristol:out_left$
   system:playback_1$
^Iproperties: output,$
bristol:out_right$
   system:playback_2$
^Iproperties: output,$
bristol:in_left$
^Iproperties: input,$
bristol:in_right$
^Iproperties: input,$
bristol:midi_in$
^Iproperties: input,$