use strict;
use warnings;
use 5.10.0;

use re 'eval';

#Some Cube solver with one (very) big regex
#http://en.wikipedia.org/wiki/Soma_cube

sub rotate;  #rotate one shape (branch, tricube, ...)
sub makereg; #make regex for one shape (one orientation)
sub rot24; #list every regex for one shape (every directions)

#http://en.wikipedia.org/wiki/Soma_cube
my %tricube; # The "L" tricube.
$tricube{0,0,0} = 1;	#1st cube - coord (0,0,0)
$tricube{-1,0,0} = 1;	#2nd cube - coord (-1,0,0)
$tricube{-1,1,0} = 1;	#...

my %ltetra=%tricube; #L tetracube: a row of three blocks with one added below the left side.
$ltetra{1,0,0} = 1;

my %ttetra=%tricube; #T tetracube: a row of three blocks with one added below the center.
$ttetra{-1,-1,0} = 1;

my %stetra=%tricube; #S tetracube: bent triomino with block placed on outside of clockwise side.
$stetra{0,-1,0} = 1;

my %lscrew=%tricube; #Left screw tetracube: unit cube placed on top of anticlockwise side. Chiral in 3D.
$lscrew{-1,1,1} = 1;

my %rscrew=%tricube; #Right screw tetracube: unit cube placed on top of clockwise side. Chiral in 3D.
$rscrew{-1,1,-1} = 1;

my %branch=%tricube; #Branch tetracube: unit cube placed on bend. Not chiral in 3D.
$branch{-1,0,1} = 1;

#7 lines to determine 1 position by shape
#first line is different than others because we don't want to find symetries
#1) L tetracube is the only shape which can oriented in 24 ways
#2) L tetracube must not lie in the middle
# see : http://www.mathematische-basteleien.de/somacube.htm#Positions%20of%20the%20Soma%20Pieces%203%20and%202
# In consequence we force 1 orientation of L tetracube in lower face (z=-1) : this way, we have 240 solutions

my $gr=<<GR; 
123__456__789__________________________________________________
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
GR

# a char. is a position in the cube :
# z=-1	z=0	z=1
#
# 789	ghi	GHI
# 456	def	DEF
# 123	abc	ABC
#
# ex: ( 0,-1,-1) => 2
# ex: ( 1, 0, 1) => F

#rotation matrix (Ox, Oy, Oz)  -90°, 180°, 90°
my (@rx,@ry,@rz);
for my $sin (-1 .. 1) {
    my $cos = $sin?0:-1; # if sin=± 1 then cos=0  ;  if sin=0 then cos=-1
    push @rx , [ [1,0,0],[0,$cos,-$sin],[0,$sin,$cos] ] ;
    push @ry , [ [$cos,0,$sin],[0,1,0],[-$sin,0,$cos] ] ;
    push @rz , [ [$cos,-$sin,0],[$sin,$cos,0],[0,0,1] ] ;
}

my $bigregex = join ".*\n.*?",  # a newline between each shape-related regex
		makereg(\%ltetra), #orientation is forced to avoid similar solutions (by symetry)
		rot24(\%ttetra,1..4), # "1..4" parameters produces (?!\1|\2|\3|\4) $1,...$4 captured before with : makereg(\%ltetra)
		rot24(\%stetra,1..8), 
		rot24(\%lscrew,1..12),
		rot24(\%rscrew,1..16),
		rot24(\%branch,1..20),
		rot24(\%tricube,1..24),
		;
$bigregex.=".*\n";
#print length $bigregex;
#print $bigregex;

$|=1;
$gr =~ qr{$bigregex(?{print "$1$2$3$4 $5$6$7$8 $9$10$11$12 $13$14$15$16 $17$18$19$20 $21$22$23$24 $25$26$27\n"})(?!)};

#fast first solution:
#$gr =~ qr{$bigregex(?{print "$1$2$3$4 $5$6$7$8 $9$10$11$12 $13$14$15$16 $17$18$19$20 $21$22$23$24 $25$26$27\n"})};

sub makereg {
	my $shape = shift;
	my $not = '';
	$not = '(?!\\'.(join'|\\',@_).')' if (scalar @_); #  (?!\1|\2|\3|\4)
	my $max= scalar keys %$shape; #number of unit cubes (4 except for the "L" tricube)
	my $count=0;
	my $reg='';
	for my $z (-1 .. 1) {
		for my $y (-1 .. 1) {
			for my $x (-1 .. 1) {
				if (exists $shape->{$x,$y,$z}) {
				#$string =~ /[[:alnum:]]/ #  Any alphanumeric character. ("[A-Za-z0-9]")
				$reg.="$not([[:alnum:]])";
				$count++;
				return $reg if ($count == $max);
				} elsif ($count) {
					$reg.='.';
				}
			}
			if ($count) {
				$reg.='..';
			}
		}
		if ($count) {
			$reg.='..........'; 	# 10 chars -- warning: do not replace with  '.{10}'
						# because '...{10}' will be the same regex than '.{10}..'
						# but will not be the same string - see %copy in sub rot24
		}
	}
}

sub rotate {
	my $r = $_[0]; #rotation (matrix)
	my $from = $_[1];
	my $to = $_[2];
	for my $c (keys %$from) {
		my ($x,$y,$z) = split $; , $c;
		my ($xn,$yn,$zn) = map {$x*$_->[0]+$y*$_->[1]+$z*$_->[2]} @$r ;
		$to->{$xn,$yn,$zn}=1;
	}
}

sub rot24 { #6 faces x 4 orientations
	my ($shape,@excep)=@_;
	my @sh24;
	my @r;
	my %copy;
	my %rot;
	my $reg;
	push @r,$shape;
	$reg = makereg($shape,@excep);
	push @sh24,$reg if not $copy{$reg}++;
	for my $i (0 .. 2) { #Oz 4 rotations (Identity + 3 rot)
		undef %rot;
		rotate($rz[$i],$shape,\%rot);
		$reg = makereg(\%rot,@excep);
		push @sh24,$reg if not $copy{$reg}++;
		push @r,{ (%rot) };
	}
	for my $i (0,2) { # Oy 2 rotations 
		undef %rot;
		rotate($ry[$i],$shape,\%rot);
		$reg = makereg(\%rot,@excep);
		push @sh24,$reg if not $copy{$reg}++;
		push @r,{ (%rot) };
	}
	for my $s (@r) { # 6 faces, 4 orientations (Identity + 3 rotations)
		for my $i (0 .. 2) {
			undef %rot;
			rotate($rx[$i],$s,\%rot);
			$reg = makereg(\%rot,@excep);
			push @sh24,$reg if not $copy{$reg}++;
		}
	}
	return (
		'(?|' . (join '|', @sh24 ) . ')'
	);	# (?| reg1 | reg2 | reg3 | ... )
	#(?|pattern) in perldoc perlre :
	#This is the "branch reset" pattern, which has the special property that the capture groups 
	# are numbered from the same starting point in each alternation branch.
	# It is available starting from perl 5.10.0.
}