initial commit

1 files changed, 475 insertions, 0 deletions

diff --git a/cjackbay b/cjackbay
new file mode 100755
index 0000000..7d68441
--- /dev/null
+++ b/cjackbay
@@ -0,0 +1,475 @@
+#!/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,$