#!/usr/bin/perl
use strict;
$| = 1;

if(! @ARGV) {
    print <<ENDSTR;
xenarecv-mkwrap send_uni <stream_id_base> <tile> <init_mode> <remote0> <remote1>
xenarecv-mkwrap send_multi <stream_id_base> <tile> <init_mode>
xenarecv-mkwrap send_pr <stream_id_base> <tile> <init_mode>
xenarecv-mkwrap recv_full_uni <stream_id_base>
xenarecv-mkwrap recv_full_multi <stream_id_base>
xenarecv-mkwrap recv_subs_uni <stream_id_base> <tile>
xenarecv-mkwrap recv_subs_multi <stream_id_base> <tile>
xenarecv-mkwrap recv_subrem_uni <stream_id_base> <tile>
xenarecv-mkwrap recv_subrem_multi <stream_id_base> <tile>
ENDSTR
;
    exit(0);
}

my $path = "./xenarecv";
my $multi_vf0 = "233.0.73.31";
my $multi_vf1 = "233.0.73.32";
my $multi_vs0 = "233.0.73.31";
my $multi_vs1 = "233.0.73.32";
my $multi_vr0 = "233.0.73.33";
my $multi_vr1 = "233.0.73.34";
my $multi_vso0 = "233.0.73.35";
my $multi_vso1 = "233.0.73.36";
my $multi_a0 = "233.0.73.37";
my $multi_a1 = "233.0.73.38";

my $pr_vf0 = "198.48.79.12:3001";
my $pr_vf1 = "198.48.79.41:3002";
my $pr_vs0 = "198.48.79.12:3001";
my $pr_vs1 = "198.48.79.41:3002";
my $pr_vr0 = "198.48.79.14:3003";
my $pr_vr1 = "198.48.79.43:3004";
my $pr_vso0 = "198.48.79.12:3005";
my $pr_vso1 = "198.48.79.41:3006";
my $pr_a0 = "198.48.79.14:3007";
my $pr_a1 = "198.48.79.43:3008";

my $fake;
my $refsource;
my $sendjoin;
my $field_mode;
for(;;) {
    if($ARGV[0] eq '-fake') {
	shift(@ARGV);
	$fake = 1;
    } elsif($ARGV[0] eq '-refext') {
	shift(@ARGV);
	$refsource = "xac.refsource=EXTERNAL";
    } elsif($ARGV[0] eq '-sendjoin') {
	shift(@ARGV);
	$sendjoin = 1;
    } elsif($ARGV[0] =~ m/^-field_mode/s) {
	$field_mode = substr(shift(@ARGV), 1);
    } else { last; }
}

my @ifaces = sort { $a->[0] cmp $b->[0] } get_ifaces();
(@ifaces == 2) || die "number of ethernet interfaces != 2";
my @ips = map { $_->[1] } @ifaces;

my $arg;
if($ARGV[0] eq 'send_uni') {
    (@ARGV == 6) || die "wrong num args";
    my (undef, $id_base, $tile, $init, $remote0, $remote1) = @ARGV;
    my ($id_vf, $id_vs, $id_vr, $id_a) = ($id_base + 0, $id_base + 1, $id_base + 2, $id_base + 3);
    
    $arg = "(wkr_create ctrlaccept ctrl b=:4000)\n";
    $arg .= udpout_list($sendjoin,
			'o0', $ips[0], undef,
			'o1', $ips[1], undef,
			'o2', $ips[0], undef,
			'o3', $ips[1], undef,
			'o4', $ips[0], undef,
			'o5', $ips[1], undef);
    $arg .= "
    	(wkr_create dl_in i)
    	(wkr i cfg_create none $field_mode )
    	(wkr i cfg_create full $field_mode
    	    dest_vf0=$id_vf,$remote0:3000,o0
    	    dest_vf1=$id_vf,$remote1:3000,o1
    	    dest_a0=$id_a,$remote0:3000,o4
    	    dest_a1=$id_a,$remote1:3000,o5)
        (wkr i cfg_create sub $field_mode scale=$tile
            dest_vs0=$id_vs,$remote0:3000,o0
            dest_vs1=$id_vs,$remote1:3000,o1
            dest_a0=$id_a,$remote0:3000,o4
            dest_a1=$id_a,$remote1:3000,o5)
        (wkr i cfg_create subrem $field_mode scale=$tile
            dest_vs0=$id_vs,$remote0:3000,o0
            dest_vs1=$id_vs,$remote1:3000,o1
            dest_vr0=$id_vr,$remote0:3000,o2
            dest_vr1=$id_vr,$remote1:3000,o3
            dest_a0=$id_a,$remote0:3000,o4
            dest_a1=$id_a,$remote1:3000,o5)
        (wkr i cfg $init)
";
    
} elsif($ARGV[0] eq 'send_multi') {
    (@ARGV == 4) || die "wrong num args";
    my (undef, $id_base, $tile, $init) = @ARGV;
    my ($id_vf, $id_vs, $id_vr, $id_a) = ($id_base + 0, $id_base + 1, $id_base + 2, $id_base + 3);

    $arg = "(wkr_create ctrlaccept ctrl b=:4000)\n";
    $arg .= udpout_list($sendjoin,
			'o0', $ips[0], $multi_vs0,
			'o1', $ips[1], $multi_vs1,
			'o2', $ips[0], $multi_vr0,
			'o3', $ips[1], $multi_vr1,
			'o4', $ips[0], $multi_a0,
			'o5', $ips[1], $multi_a1);
    $arg .= "
    	(wkr_create dl_in i)
    	(wkr i cfg_create none $field_mode)
    	(wkr i cfg_create full $field_mode
    	    dest_vf0=$id_vf,$multi_vf0:3000,o0
    	    dest_vf1=$id_vf,$multi_vf1:3000,o1
    	    dest_a0=$id_a,$multi_a0:3000,o4
    	    dest_a1=$id_a,$multi_a1:3000,o5)
        (wkr i cfg_create sub $field_mode scale=$tile
            dest_vs0=$id_vs,$multi_vso0:3000,o0
            dest_vs1=$id_vs,$multi_vso1:3000,o1
            dest_a0=$id_a,$multi_a0:3000,o4
            dest_a1=$id_a,$multi_a1:3000,o5)
        (wkr i cfg_create subrem $field_mode scale=$tile
            dest_vs0=$id_vs,$multi_vs0:3000,o0
            dest_vs1=$id_vs,$multi_vs1:3000,o1
            dest_vr0=$id_vr,$multi_vr0:3000,o2
            dest_vr1=$id_vr,$multi_vr1:3000,o3
            dest_a0=$id_a,$multi_a0:3000,o4
            dest_a1=$id_a,$multi_a1:3000,o5)
        (wkr i cfg $init)
";

} elsif($ARGV[0] eq 'send_pr') {
    (@ARGV == 6) || die "wrong num args";
    my (undef, $id_base, $tile, $init, $remote0, $remote1) = @ARGV;
    my ($id_vf, $id_vs, $id_vr, $id_a) = ($id_base + 0, $id_base + 1, $id_base + 2, $id_base + 3);
    
    $arg = "(wkr_create ctrlaccept ctrl b=:4000)\n";
    $arg .= udpout_list($sendjoin,
			'o0', $ips[0], undef,
			'o1', $ips[1], undef,
			'o2', $ips[0], undef,
			'o3', $ips[1], undef,
			'o4', $ips[0], undef,
			'o5', $ips[1], undef);
    $arg .= "
    	(wkr_create dl_in i)
    	(wkr i cfg_create none $field_mode)
    	(wkr i cfg_create full $field_mode
    	    dest_vf0=$id_vf,$pr_vf0,o0
    	    dest_vf1=$id_vf,$pr_vf1,o1
    	    dest_a0=$id_a,$pr_a0,o4
    	    dest_a1=$id_a,$pr_a1,o5)
        (wkr i cfg_create sub $field_mode scale=$tile
            dest_vs0=$id_vs,$pr_vso0,o0
            dest_vs1=$id_vs,$pr_vso1,o1
            dest_a0=$id_a,$pr_a0,o4
            dest_a1=$id_a,$pr_a1,o5)
        (wkr i cfg_create subrem $field_mode scale=$tile
            dest_vs0=$id_vs,$pr_vs0,o0
            dest_vs1=$id_vs,$pr_vs1,o1
            dest_vr0=$id_vr,$pr_vr0,o2
            dest_vr1=$id_vr,$pr_vr1,o3
            dest_a0=$id_a,$pr_a0,o4
            dest_a1=$id_a,$pr_a1,o5)
        (wkr i cfg $init)
";
    
} elsif($ARGV[0] eq 'recv_full_uni') {
    (@ARGV == 2) || die "wrong num args";
    my (undef, $id_base) = @ARGV;
    my ($id_vf, $id_vs, $id_vr, $id_a) = ($id_base + 0, $id_base + 1, $id_base + 2, $id_base + 3);

    $arg = "
        (wkr_create ctrlaccept ctrl b=:4000)
        (wkr_create xenaout o $refsource
            (qr $id_vf $id_base) (qr $id_a $id_base)
            (mix (vf $id_vf) (a $id_a))
        )
        (wkr_create udpin i0 out=o b=$ips[0]:3000 post.c=$ips[0]:3000)
        (wkr_create udpin i1 out=o b=$ips[1]:3000 post.c=$ips[1]:3000)
";

} elsif($ARGV[0] eq 'recv_full_multi') {
    (@ARGV == 2) || die "wrong num args";
    my (undef, $id_base) = @ARGV;
    my ($id_vf, $id_vs, $id_vr, $id_a) = ($id_base + 0, $id_base + 1, $id_base + 2, $id_base + 3);

    $arg = "
        (wkr_create ctrlaccept ctrl b=:4000)
        (wkr_create xenaout o $refsource
            (qr $id_vf $id_base) (qr $id_a $id_base)
            (mix (vf $id_vf) (a $id_a))
        )
        (wkr_create udpin i0 out=o b=:3000 post.c=$multi_vf0:3000)
            mjoin=$multi_vf0,$ips[0]
            mjoin=$multi_a0,$ips[0])
        (wkr_create udpin i1 out=o b=:3000 post.c=$multi_vf1:3000)
            mjoin=$multi_vf1,$ips[1]
            mjoin=$multi_a1,$ips[1])
";

} elsif($ARGV[0] eq 'recv_subs_uni') {
    (@ARGV == 3) || die "wrong num args";
    my (undef, $id_base, $tile) = @ARGV;

    $arg = "(wkr_create ctrlaccept ctrl b=:4000)\n";
    $arg .= "(wkr_create xenaout o $refsource\n";
    $arg .= tile_vs_qr_mix($tile, $id_base + 3);
    $arg .= ")\n";
    $arg .= "(wkr_create udpin i0 out=o b=$ips[0]:3000 post.c=$ips[0]:3000)\n";
    $arg .= "(wkr_create udpin i1 out=o b=$ips[1]:3000 post.c=$ips[1]:3000)\n";

} elsif($ARGV[0] eq 'recv_subs_multi') {
    (@ARGV == 3) || die "wrong num args";
    my (undef, $id_base, $tile) = @ARGV;

    $arg = "(wkr_create ctrlaccept ctrl b=:4000)\n";
    $arg .= "(wkr_create xenaout o $refsource\n";
    $arg .= tile_vs_qr_mix($tile, $id_base + 3);
    $arg .= ")\n";
    $arg .= "
        (wkr_create udpin i0 out=o b=:3000 post.c=$multi_vs0:3000
            mjoin=$multi_vs0,$ips[0]
            mjoin=$multi_vso0,$ips[0]
            mjoin=$multi_a0,$ips[0])
        (wkr_create udpin i1 out=o b=:3000 post.c=$multi_vs1:3000
            mjoin=$multi_vs1,$ips[1]
            mjoin=$multi_vso1,$ips[1]
            mjoin=$multi_a1,$ips[1])
";

} elsif($ARGV[0] eq 'recv_subrem_uni') {
    (@ARGV == 3) || die "wrong num args";
    my (undef, $id_base, $tile) = @ARGV;

    $arg = "(wkr_create ctrlaccept ctrl b=:4000)\n";
    $arg .= "(wkr_create xenaout o $refsource\n";
    $arg .= tile_vsr_qr_mix($tile, $id_base + 3);
    $arg .= ")\n";
    $arg .= "(wkr_create udpin i0 out=o b=$ips[0]:3000 post.c=$ips[0]:3000)\n";
    $arg .= "(wkr_create udpin i1 out=o b=$ips[1]:3000 post.c=$ips[1]:3000)\n";

} elsif($ARGV[0] eq 'recv_subrem_multi') {
    (@ARGV == 3) || die "wrong num args";
    my (undef, $id_base, $tile) = @ARGV;

    $arg = "(wkr_create ctrlaccept ctrl b=:4000)\n";
    $arg .= "(wkr_create xenaout o $refsource\n";
    $arg .= tile_vsr_qr_mix($tile, $id_base + 3);
    $arg .= ")\n";
    $arg .= "
        (wkr_create udpin i0 out=o b=:3000 post.c=$multi_vs0:3000
            mjoin=$multi_vs0,$ips[0]
            mjoin=$multi_vr0,$ips[0]
            mjoin=$multi_a0,$ips[0])
        (wkr_create udpin i1 out=o b=:3000 post.c=$multi_vs1:3000
            mjoin=$multi_vs1,$ips[1]
            mjoin=$multi_vr1,$ips[1]
            mjoin=$multi_a1,$ips[1])
";

} else { die "invalid mode"; }

if($fake) {
    print "$path '\n$arg'\n";
    exit 0;
}
exec($path, $arg);

sub udpout_list {
    my ($sendjoin, @args) = @_;
    
    my $result;
    for(my $i = 0; $i < @args; $i += 3) {
	my ($wkr, $src, $dest) = ($args[$i], $args[$i + 1], $args[$i + 2]);
	if($sendjoin) { $result .= "(wkr_create udpout $wkr b=:0 mjoin=$dest,$src)\n"; }
	else { $result .= "(wkr_create udpout $wkr b=$src)\n"; }
    }
    return $result;
}

sub tile_vs_qr_mix {
    my ($tile, @ignores) = @_;
    my ($tile_x, $tile_y) = split(/,/, $tile);
    my ($qr, $mix);
    for(my $y = 0; $y < $tile_y; $y++) {
	for(my $x = 0; $x < $tile_x; $x++) {
	    my $id_base = (($y * $tile_x) + $x) * 4;
	    my $id = $id_base + 1;
	    if(! grep { $_ == $id } @ignores) {
		my $pos_x = (5120 / $tile_x) * $x;
		my $pos_y = (1080 / $tile_y) * $y;
		$qr .= "(qr $id $id_base)\n";
		$mix .= "(vs $id scale=$tile_x,$tile_y pos=$pos_x,$pos_y)\n";
	    }
	    my $id = $id_base + 3;
	    if(! grep { $_ == $id } @ignores) {
		$qr .= "(qr $id $id_base)\n";
		$mix .= "(a $id)\n";
	    }
	}
    }
    return $qr."(mix\n".$mix.")\n";
}

sub tile_vsr_qr_mix {
    my ($tile, @ignores) = @_;
    my ($tile_x, $tile_y) = split(/,/, $tile);
    my ($qr, $mix);
    for(my $y = 0; $y < $tile_y; $y++) {
	for(my $x = 0; $x < $tile_x; $x++) {
	    my $id_base = (($y * $tile_x) + $x) * 4;
	    my $id_vs = $id_base + 1;
	    my $id_vr = $id_base + 2;
	    if((! grep { $_ == $id_vs } @ignores) && (! grep { $_ == $id_vr } @ignores)) {
		$qr .= "(qr $id_vs $id_base) (qr $id_vr $id_base)\n";
		$mix .= "(vsr $id_vs $id_vr scale=$tile_x,$tile_y)\n";
	    }
	    my $id = $id_base + 3;
	    if(! grep { $_ == $id } @ignores) {
		$qr .= "(qr $id $id_base)\n";
		$mix .= "(a $id)\n";
	    }
	}
    }
    return $qr."(mix\n".$mix.")\n";
}

sub get_ifaces {
    my @entrys = eval { get_ifaces_ipconfig() };
    if(length($@)) {
	@entrys = eval { get_ifaces_iproute2() };
	if(length($@)) {
	    die "get_ifaces cannot determine network interfaces";
	}
    }
    return @entrys;
}

sub get_ifaces_ipconfig {
    open(PIPE, "-|", 'ipconfig') || die "$!, open ipconfig failed";

    my @entrys;
    my $text;
    for(;;) {
	my $line = <PIPE>;
	if((! defined($line)) || ($line =~ m/^\S/s)) {
	    if($text =~ m|^ethernet\s+adapter\s+|si) {
		my $name = $'; #';
		$name =~ s/:\s+$//s;
		if($text =~ m/ip\s+address.*?:\s+(\S+)/mi) {
		    my $address = $1;
		    push(@entrys, [ $name, $address ]);
		}
	    }
	    defined($line) || last;
	    $text = $line;
	} else { $text .= $line; }
    }
    close(PIPE);
    return @entrys;
}

sub get_ifaces_iproute2 {
    open(PIPE, "-|", 'ip', 'addr', 'show') || die "$!, open ip failed";

    my @entrys;
    my $text;
    for(;;) {
	my $line = <PIPE>;
	if((! defined($line)) || ($line =~ m/^\S/s)) {
	    if($text =~ m|^(\d+):\s+([^:]+):|s) {
		my ($num, $name) = ($1, $2);
		if($text =~ m|^\s+link/ether\s|m) {
		    if($text =~ m|^\s+inet\s+(\S+)|m) {
			my ($address) = split(/\//, $1);
			push(@entrys, [ $name, $address ]);
		    }
		}
	    }
	    defined($line) || last;
	    $text = $line;
	} else { $text .= $line; }
    }
    close(PIPE);
    return @entrys;
}

sub ip_of_sin {
    my ($ip, $port) = split(/:/, $_[0]);
    return $ip;
}