#!/usr/bin/perl -w
use strict;

my @chip = ( [1] );      #  1 code (v boring non-encoding one)
@chip = dbl_chip(@chip);   #  2 codes
@chip = dbl_chip(@chip);   #  4 codes
@chip = dbl_chip(@chip);   #  8 codes
@chip = dbl_chip(@chip);   # 16 codes
# @chip = dbl_chip(@chip); # 32 codes
# @chip = dbl_chip(@chip); # 64 codes

my $a = $chip[12]; my $ia = [inv(@$a)];
my $b = $chip[7]; my $ib = [inv(@$b)]; # 43/64 not terrible?
my $i = $chip[0];  # identity
my $s = $chip[1];  # sync

# 65x12 images
my @empty = matrix(
    ("+"x65) x 12
);
my @sync = matrix(qw(
    -----------------------------------------------------------------
    -----++++++----------++++++----------++++++----------++++++------
    -----++++++----------++++++----------++++++----------++++++------
    -----++++++----------++++++----------++++++----------++++++------
    -----++++++----------++++++----------++++++----------++++++------
    -----++++++----------++++++----------++++++----------++++++------
    -----++++++----------++++++----------++++++----------++++++------
    -----++++++----------++++++----------++++++----------++++++------
    -----++++++----------++++++----------++++++----------++++++------
    -----++++++----------++++++----------++++++----------++++++------
    -----++++++----------++++++----------++++++----------++++++------
    -----------------------------------------------------------------
));
my @siga = matrix(qw(
    -----------------------------------------------------------------
    --++---++-----+++-----++++++----++-----++--++-----++--++-----++--
    --++---++----++-++----+++++++---++-----++--++-----++--++-----++--
    --++---++---++---++---------++--+++----++--+++----++--++-----++--
    --++---++--++-----++--------++--++++---++--++++---++--++-----++--
    --++---++--+++++++++--+++++++---++-++--++--++-++--++--++--+--++--
    --++---++--+++++++++--+++++++---++--++-++--++--++-++--++-+++-++--
    ---++-++---++-----++--------++--++---++++--++---++++--++++-++++--
    ---++-++---++-----++--------++--++----+++--++----+++--+++---+++--
    ----+++----++-----++--+++++++---++-----++--++-----++--++-----++--
    ----+++----++-----++--++++++----++-----++--++-----++--++-----++--
    -----------------------------------------------------------------
));
my @sigb = matrix(qw(
    -----------------------------------------------------------------
    ---++++++--++--++-----+++-----++-----++--++----+----+++-----+----
    ---++++++--++--++----++-++----++-----++--++---++---+++++---+++---
    -----++----++--++---++---++---+++----++--++--++---++-------+++---
    -----++----++--++--++-----++--++++---++--++-++----+++------+++---
    -----++----++++++--+++++++++--++-++--++--++++------+++-----+++---
    -----++----++++++--+++++++++--++--++-++--++++-------+++-----+----
    -----++----++--++--++-----++--++---++++--++-++-------+++---------
    -----++----++--++--++-----++--++----+++--++--++------+++----+----
    -----++----++--++--++-----++--++-----++--++---++--+++++----+++---
    -----++----++--++--++-----++--++-----++--++----+---+++------+----
    -----------------------------------------------------------------
));
# cat /dev/urandom | tr -dc '+-' | fold -b65 | head -12 # for "secret"
my @code = matrix(qw(
    -+-++--++-++-++-------++++--+-++--+-+++---+++-+-+---++--++++---+-
    --+-++-+-++--+-+--++++--+++-++-++--++-+-----+++--+-+++--++---+--+
    -++++-+++-+-+--+++-+---++++++-++++++---+++-++-+-+-++-+-++--+-----
    -+-----++--++++++-----++---+-+--+-+--+-+++-+--+-+---+-+++-++-++--
    ++-+---++++-+++-++----+-++--+--++-++-+++-+++-+--+--+--+++-+++-+-+
    --++-++---+++-++-++-+-++----+-+++---+-+--++++++-+--++-+---+--+---
    ++----+-+-++-+------+--+-+-+-++-----++---+-++++++--+--++-++-++++-
    -++++-++-----+++-+-+-+-----+++-----+++------+-+----++---++++-++++
    --+++--+-+--+++++-+---+-+-+--+--+-++++-----++--++-+-+----+--+++-+
    ++--+++-------+++-++-+++++++++-++---+-+-+++--------++--+-++--++++
    --+++--++----+-+-++-++++--++-+++--+++---+-++++-+--+---++++-++++++
    -+++++-++-+++----++++++++-++-++-+++++++--+---++-+-+++++++-+++-+-+
));
@sigb = mult([@sigb], [@code]); # sigb is now encoded with "secret" too

my @spreada = split_by(4, @$a); # ... as a 4x4 matrix
my @spreadb = split_by(4, @$b);
my @spreadi = split_by(4, @$i);
my @spreads = split_by(4, @$s);

my @bigs   = scale_by([@sync],  [@spreads]);
my @biga   = scale_by([@siga],  [@spreada]);
my @bigb   = scale_by([@sigb],  [@spreadb]);
my @big_s  = scale_by([@empty], [@spreads]);
my @big_a  = scale_by([@empty], [@spreada]);
my @big_b  = scale_by([@empty], [@spreadb]);
my @big_c  = scale_by([@code],  [@spreadi]);
my @big_bc = scale_by([@code],  [@spreadb]);
my @bign  = ();  # 12x4  x  65x4  of "band noise"
for (1..48) {
    push @bign, [ map { int(rand(2))-int(rand(2)) } 1..260 ]
}

my @rx =  add([@biga], [@bigb]);
@rx    =  add([@rx],   [@bigs]);
@rx    =  add([@rx],   [@bign]);

if (-t STDOUT || !@ARGV) {
    prmatrix(@chip);
    
    pr4x4($s,              "for sync");
    pr4x4($a,              "for A?");
    pr4x4($ia,             "for !A?");
    pr4x4($b,              "for B?");
    pr4x4($ib,             "for !B?");
    pr4x4([mult( $a, $b)], "A x B");
    pr4x4([mult( $a,$ib)], "A x !B");
    pr4x4([mult($ia, $b)], "!A x B");
    pr4x4([mult($ia,$ib)], "!A x !B");
    
    print "###### siga:\n";   prmatrix(@siga);
    print "###### sigb:\n";   prmatrix(@sigb);
    
    print "###### biga:\n";   prmatrix(@biga);
    print "###### bigb:\n";   prmatrix(@bigb);
    print "###### bigs:\n";   prmatrix(@bigs);
    print "###### big_s:\n";  prmatrix(@big_s);
    print "###### bign:\n";   prmatrix(@bign);
    
    print "###### big_a:\n";  prmatrix(@big_a);
    print "###### big_b:\n";  prmatrix(@big_b);
    print "###### big_bc:\n"; prmatrix(@big_bc);
    print "###### big_s:\n";  prmatrix(@big_s);
    
    print "###### rx:\n";     prmatrix(@rx);
    
    print
      "### Now re-run like: $0 1 > 1.png\n",
      "### to output frames [1..20]\n";
    exit;
}
elsif (@ARGV && $ARGV[0] eq "s")     { prpgm(1,       @big_s ); }
elsif (@ARGV && $ARGV[0] eq "ss")    { prpgm(1,       @bigs ); }
elsif (@ARGV && $ARGV[0] eq "a")     { prpgm(1,       @big_a ); }
elsif (@ARGV && $ARGV[0] eq "b")     { prpgm(1,       @big_b ); }
elsif (@ARGV && $ARGV[0] eq "c")     { prpgm(1,       @big_c ); }
elsif (@ARGV && $ARGV[0] eq "n")     { prpgm(2,       @bign ); }
elsif (@ARGV && $ARGV[0] eq "bc")    { prpgm(1,       @big_bc ); }
elsif (@ARGV && $ARGV[0] eq "sdec")  { prpgm(4, mult([@big_s] ,[@rx]) ); }
elsif (@ARGV && $ARGV[0] eq "adec")  { prpgm(4, mult([@big_a] ,[@rx]) ); }
elsif (@ARGV && $ARGV[0] eq "bdec")  { prpgm(4, mult([@big_b] ,[@rx]) ); }
elsif (@ARGV && $ARGV[0] eq "bcdec") { prpgm(4, mult([@big_bc],[@rx]) ); }
else                                 { prpgm(4,                 @rx ); }

sub prpgm {
    my $max = shift;
    print "P2 ",
      scalar(@{$_[0]}), " ",
      scalar(@_), " ", $max+$max, "\n";
    for my $line (@_) {
	print join("\n", map { $_+$max } @$line), "\n";
    }
}

sub matrix {
    # given a list of ("-+-", "+-+", "+++") strings,
    # turn them into a real matrix - an array of arrayrefs
    my %map = ( "+" => 1, "-" => -1, "0" => 0 );
    my @ret = ();
    for my $string (@_) {
	push @ret, [ map($map{$_}, split //, $string) ];
    }
    return @ret;
}

sub dbl_chip {
    # given an NxN matix of chip codes, make the 2Nx2N matrix
    # not quite: return scale_by([[1,1],[1,-1]], [@_]);
    my @ret = ();
    for (@_) {
	push @ret, [ @$_,     @$_  ];
	push @ret, [ @$_, inv(@$_) ];
    }
    return @ret;
}

sub scale_by {
    # given an AX x AY matrix and a BX x BY one,
    # create a big AXxBX x AYxBY one, wherein the
    # output is like a giant A made of small Bs and
    # inversions thereof.
    my ($ma, $mb) = @_;
    my @ret = ();
    for my $rowa (@$ma) { for my $rowb (@$mb) {
	my @retrow = ();
	for my $cola (@$rowa) { for my $colb (@$rowb) {
	    push @retrow, $cola * $colb;
	}}
	push @ret, [ @retrow ];
    }}
    return @ret;
}
sub inv {
    my @ret = ();
    for (@_) { push @ret, -$_; }
    return @ret;
}

sub pr4x4 {
    my $dat = shift;
    print "### @_\n" if @_;
    prmatrix(split_by(4, @$dat));
}

sub split_by {
    my $n = shift;
    my @ret = ();
    while (@_) {
	push @ret, [ splice @_,0,$n,() ];
    }
    return @ret;
}

sub prmatrix {
    # dump a big XxY matrix
    for my $y (@_) {
	for my $x (@$y) {
	    if    ($x > 0) { print "+" ; }
	    elsif ($x < 0) { print "-"; }
	    else           { print "0"; }
	}
	print "\n";
    }
}

sub mult {
    # multiply together the contents of 2 arrayREFs
    # ... or arrayrefs of arrayrefs
    my @one = @{shift()};
    my @two = @{shift()};
    my @ret = ();
    while (@one) {
	if (ref($one[0])) {
	    push @ret, [ mult(shift(@one), shift(@two)) ];
	} else {
	    push @ret, shift(@one) * shift(@two);
	}
    }
    return @ret;
}

sub add {
    # add together the contents of 2 arrayREFs
    my @one = @{shift()};
    my @two = @{shift()};
    my @ret = ();
    while (@one) {
	if (ref($one[0])) {
	    push @ret, [ add(shift(@one), shift(@two)) ];
	} else {
	    push @ret, shift(@one) + shift(@two);
	}
    }
    return @ret;
}