#! /usr/bin/env perl
use strict;
use warnings;
use AnyEvent;
use AnyEvent::Socket qw(tcp_server);
use AnyEvent::WebSocket::Server;
use Twiggy::Server;
use JSON::MaybeXS;
use Log::Any '$log';
use Log::Any::Adapter 'Daemontools', -init => { env => 1 };
my $jcodec= JSON::MaybeXS->new->canonical->ascii;
my $browser_x= 0; #1366;
my $browser_y= 0;

my $server = AnyEvent::WebSocket::Server->new();
my $extern_pid; 
my @all_conn;
my %conn_name;
tcp_server undef, 5000, sub {
	my ($fh) = @_;
	$server->establish($fh)->cb(sub {
		my ($conn) = eval { shift->recv };
		if ($@) {
			warn "Rejected connection: $@\n";
			close($fh);
			return;
		}
		push @all_conn, $conn;
		$conn_name{$conn}= 'client'.@all_conn;
		$conn->on(each_message => sub { my @args= @_; eval { handle_message(@args); 1 } || $log->error($@) });
		$conn->on(finish => sub { @all_conn= grep { $_ ne $conn } @all_conn; undef $conn });
	});
};
my $httpd= Twiggy::Server->new(port => 5001);
use Plack::Builder;
use Plack::App::File;
my $app= Plack::Builder->new;
my $cur_extern= '';
$app->mount('/' => Plack::App::File->new(root => 'htdocs'));
$httpd->register_service($app->to_app);

sub handle_message {
	my ($conn, $msg)= @_;
	if ($msg->is_text) {
		$msg= $jcodec->decode($msg->decoded_body);
		$log->debugf("msg=%s", $msg) if $log->is_debug;
		$log->info(
			$conn_name{$conn}.' : '
			.($msg->{slide_num}//'-').'.'.($msg->{step_num}//'-')
			.' extern='.($msg->{extern}//'-')
		);
		if ($msg->{extern} && $cur_extern ne $msg->{extern}) {
			if ($extern_pid) {
				kill TERM => $extern_pid;
				undef $extern_pid;
			}
			$log->info("Launch $msg->{extern}");
			run_extern($msg->{extern}, $msg->{elem_rect});
			$cur_extern= $msg->{extern};
		}
		if ($msg->{slide_num} || $msg->{step_num}) {
			$_ ne $conn && $_->send($jcodec->encode({ slide_num => $msg->{slide_num}, step_num => $msg->{step_num} }))
				for @all_conn;
		}
		if ($msg->{notes}) {
			print "\n$msg->{notes}\n\n";
		}
	}
}

sub run_extern {
	my ($extern_name, $rect)= @_;
	my ($l, $r, $t, $b)= map int($_), @{ $rect }{'left','right','top','bottom'};
	$_ += $browser_x for $l, $r;
	$_ += $browser_y for $t, $b;
	my $w= $r-$l;
	my $h= $b-$t - 24; # subtract window title height
	my $sq_w= int($h*4/3);
	my $geom_wide= "${w}x${h}+$l+$t";
	my $geom_sq=   "${sq_w}x${h}+".int($l+($w-$sq_w)/2)."+$t";
	$ENV{OPENGL_SANDBOX_GEOMETRY}= $geom_sq;
	my $argv= {
		seascape     => [ "./app-shadertoy/scripts/shadertoy.pl", "--geometry=$geom_wide", "./app-shadertoy/shaders/seascape.frag" ],
		awesomestar  => [ "./app-shadertoy/scripts/shadertoy.pl", "--geometry=$geom_wide", "./app-shadertoy/shaders/awesome-star.frag" ],
		glow2        => [ "./app-shadertoy/scripts/shadertoy.pl", "--geometry=$geom_wide", "./app-shadertoy/shaders/glow2.frag" ],
		kaliset      => [ "./app-shadertoy/scripts/shadertoy.pl", "--geometry=$geom_wide", "./app-shadertoy/shaders/kaliset.frag" ],
		glxgears     => [ 'glxgears', '-geometry', $geom_sq ],
		robot        => [ '/usr/local/share/CmdlineGL/examples/Robot.sh', '--geometry', $geom_wide ],
		flightsim    => [ '/usr/local/share/CmdlineGL/examples/FlightSim.sh', '--geometry', $geom_wide ],
		dashboard    => [ 'sh', '-c', 'cd ../../gui && ./von-gui.pl --demo --video=off' ],
		triangle     => [ './triangle1.pl', $geom_sq ],
		font_testcase=> [ 'prove', '-v', '../../../perl-OpenGL-Sandbox/OpenGL-Sandbox-V1-FTGLFont/t/90-visual-inspection.t' ],
	}->{$extern_name}
		or die "Unknown extern $extern_name";
	$log->debugf("argv=%s", $argv) if $log->is_debug;
	my $pid= $extern_pid= fork() // die "Can't fork";
	exec @$argv or die $!
		unless $extern_pid;
	my $extern_cv;
	$extern_cv= AE::child $extern_pid, sub {
		$log->debugf('Reaped pid=%s', $pid) if $log->is_debug;
		undef $extern_cv;
		$_->send($jcodec->encode({ extern_ended => $extern_name })) for @all_conn;
	};
}

my $term= AE::cv;
AE::signal TERM => sub { $term->send };
$term->recv;

1;