use strict;
use warnings;

# how many valid 'loco' solutions are there?
# -> 36 of 720 are correct solutions

#+---+---+---+
#| R | G | G |
#|GhG|GuB|BtG|
#| R | R | R |
#+---+---+---+
#| R | R | R |
#|BbB|BeG|GaB|
#| R | G | G |
#+---+---+---+


# h=hart, u=huis, t=auto, b=bloem, e=eend, a=appel

use Math::Combinatorics;

my %items= (
    hart=>"RRGG", huis=>"GRGB", auto=>"GRBG", bloem=>"RRBB", eend=>"RGBG", appel=>"RGGB",
);

my $c= Math::Combinatorics->new(data=>[keys %items]);
while (my @perm= $c->next_permutation) {
    if (testperm(@perm)) {
        printperm(@perm);
    }
}

sub testperm {
    return neighbour($_[0], $_[1], 3, 2)
        && neighbour($_[1], $_[2], 3, 2)
        && neighbour($_[3], $_[4], 3, 2)
        && neighbour($_[4], $_[5], 3, 2)
        && neighbour($_[0], $_[3], 1, 0)
        && neighbour($_[1], $_[4], 1, 0)
        && neighbour($_[2], $_[5], 1, 0);
}
sub neighbour {
    my ($a, $b, $ia, $ib)= @_;
    return substr($items{$a}, $ia, 1) eq substr($items{$b}, $ib, 1);
}
sub printperm {
    my @board= split /\n/, <<__EOF__;
+---+---+---+
|   |   |   |
|   |   |   |                      
|   |   |   |
+---+---+---+
|   |   |   |
|   |   |   |                      
|   |   |   |
+---+---+---+
__EOF__
    

    placeitem(\@board, 1,1, $_[0]);
    placeitem(\@board, 5,1, $_[1]);
    placeitem(\@board, 9,1, $_[2]);

    placeitem(\@board, 1,5, $_[3]);
    placeitem(\@board, 5,5, $_[4]);
    placeitem(\@board, 9,5, $_[5]);

    print join("\n", @board)."\n\n";
}

sub placeitem {
    my ($b, $x, $y, $n)= @_;
    substr($b->[$y], $x+1, 1)= substr($items{$n}, 0, 1);
    substr($b->[$y+2], $x+1, 1)= substr($items{$n}, 1, 1);
    substr($b->[$y+1], $x, 1)= substr($items{$n}, 2, 1);
    substr($b->[$y+1], $x+2, 1)= substr($items{$n}, 3, 1);
    substr($b->[$y+1], 12+$x*2, 5)= sprintf("%-5s", $n);
}