#! /usr/bin/perl

use strict;
use warnings FATAL => 'all';

my $debug = 0;


# lookup tables
# +-------+-------+-------+
# | A1 .. | A2 .. | .. .. |
# |       |       |       |
# | .. .. | B1 .. | B2 .. |
# +-------+-------+-------+    +-------+    +-------|
# | A3 C1 | A4 C2 | .. .. |    | AA BB |    |  1  2 |
# |       |       |       |    |       |    |       |
# | .. .. | B3 D1 | B4 D2 |    | CC DD |    |  4  8 |
# +-------+-------+-------+    +-------+    +-------|
# | .. C3 | .. C4 | .. .. |
# |       |       |       |
# | .. .. | .. D3 | .. D4 |
# +-------+-------+-------+

# +---------------+---------------+---------------+
# | .. ..   .. .. | .. ..   .. .. | .. ..   .. .. |
# | .. ..   .. .. | .. ..   .. .. | .. ..   .. .. |
# |               |               |               |
# | .. ..   A1 .. | A2 B1   A2 B1 | .. B2   .. .. |
# | .. ..   .. .. | .. ..   .. .. | .. ..   .. .. |
# +---------------+---------------+---------------+
# | .. ..   A3 .. | A* B3   A4 B* | .. B4   .. .. |
# | .. ..   C1 .. | C2 D1   C2 D1 | .. D2   .. .. |
# |               |               |               |
# | .. ..   A3 .. | A4 B3   A4 B3 | .. B4   .. .. |
# | .. ..   C1 .. | C* D1   C2 D* | .. D2   .. .. |
# +---------------+---------------+---------------+
# | .. ..   .. .. | .. ..   .. .. | .. ..   .. .. |
# | .. ..   C3 .. | C4 D3   C4 D3 | .. D4   .. .. |
# |               |               |               |
# | .. ..   .. .. | .. ..   .. .. | .. ..   .. .. |
# | .. ..   .. .. | .. ..   .. .. | .. ..   .. .. |
# +---------------+---------------+---------------+


#		A1  A2  A3  A4  B1  B2  B3  B4  C1  C2  C3  C4  D1  D2  D3  D4
#		..  ..  .+  x+  ..  ..  +x  +.  .+  ++  .+  ++  ++  +.  ++  +.
#		.+  ++  .+  ++  ++  +.  ++  +.  .+  x+  ..  ..  +x  +.  ..  ..

#		nibble
#		 0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
#		..  +.  .+  ++  ..  +.  .+  ++  ..  +.  .+  ++  ..  +.  .+  ++
#		..  ..  ..  ..  +.  +.  +.  +.  .+  .+  .+  .+  ++  ++  ++  ++

# rules: b0000xxxm
# 		000/0	000/1	001/0	001/1	010/0	010/1	011/0	011/1
# 		  0/0	  0/1	  1/0 	  1/1	  2/0	  2/1	  3/0	  3/1


my @bits = (
	"....", "+...", ".+..", "++..", "..+.", "+.+.", ".++.", "+++.",
	"...+", "+..+", ".+.+", "++.+", "..++", "+.++", ".+++", "++++"
);

sub count($$) {
	my ($bits, $pat) = @_;
	my $c = 0;
	for (my $i = 0; $i < 4; $i++) {
		if (substr($bits, $i, 1) eq "+" && substr($pat, $i, 1) eq "+") {
			$c++;
		}
	}
	return $c;
}

sub match($) {
	my $pat = shift;
	print "\t.db\t";
	for (my $i = 0; $i < 16; $i++) {
		my $c = count($bits[$i], $pat);
		printf "%2d", ($c << 4);
		if ($i != 15) {
			print ", ";
		}
	}
	print "\n";
}

sub match_pat($@) {
	my ($me, @pats) = @_;
	my $i = 1;
	foreach my $pat (@pats) {
		print "bitref_$me$i:\n";
		match($pat);
		$i++;
	}
}

sub match_result($$$) {
	my ($me, $m, $pat) = @_;
	print "bitref_$me:\n";

	my @binary = ( "...", "..+", ".+.", ".++", "+..", "+.+", "++.", "+++" );

	my $mecount = $pat;
	$mecount =~ tr/.+/+./;

#	print "mecount: $mecount\n";

	# neighbour count is in native binary order (000, 001, 010, 011 etc.)
	# cells are in reverse, 0b0000DCBA

	# three-nibble neighbourhood can have at most 5 live neighbours
	for (my $n = 0; $n <= 5; $n++) {
		($debug) || print "\t.db\t";
		for (my $i = 0; $i < 16; $i++) {
			my $c = $n + count($bits[$i], $mecount);
			my $live = count($bits[$i], $pat);
			my $r;
			if (($live == 1 && ($c == 2 || $c == 3)) ||
					($live == 0 && $c == 3)) {
				$r = $m;
			} else {
				$r = 0;
			}
			if ($debug) {
				print "($c/$live) " .
						$binary[$n] ." " .
						$bits[$i] . " -> $r\n";
			} else {
				print "$r";
				if ($i != 15) {
					print ", ";
				}
			}
		}
		($debug) || print "\n";
	}
}


print "\n";
match_pat("a", "...+", "..++", ".+.+", ".+++");
match_result("a", 1, "+...");

print "\n";
match_pat("b", "..++", "..+.", "+.++", "+.+.");
match_result("b", 2, ".+..");

print "\n";
match_pat("c", ".+.+", "++.+", ".+..", "++..");
match_result("c", 4, "..+.");

print "\n";
match_pat("d", "+++.", "+.+.", "++..", "+...");
match_result("d", 8, "...+");