#!/usr/bin/perl

use strict;
use warnings;

my $start =
  'aaABbb'. #  0 -  5
  'a## #b'. #  6 - 11
  'a C  b'. # 12 - 17
  'a#C##b'. # 18 - 23
  'aABbbb'. # 24 - 29
  '##### '; # 30 - 35

my %move = ($start => 1);
my @next = ($start);
my %parent = ();
while (@next) {
    # Breitensuche
    my $map = shift @next;

    for (my $pos = 0; $pos < length $map; $pos++) {
        if ((my $wurm = substr($map, $pos, 1)) =~ /[ABC]/) {
            # hoch
            if ($pos > 5 and substr($map, $pos - 6, 1) eq ' ') {
                my $map2 = move($map, $pos - 6, $wurm);
                unless ($move{$map2}) {
                    $move{$map2} = $move{$map} + 1;
                    push @next, $map2;
                    $parent{$map2} = $map;
                }
            }

            # runter
            if ($pos < 30 and substr($map, $pos + 6, 1) eq ' ') {
                my $map2 = move($map, $pos + 6, $wurm);
                unless ($move{$map2}) {
                    $move{$map2} = $move{$map} + 1;
                    push @next, $map2;
                    $parent{$map2} = $map;
                }

                # Abbruch-Bedingung
                if ($pos == 29 and $wurm eq 'A') {
                    print "Ende erreicht: $move{$map2} Zuege.\n";

                    while ($map2 ne $start) {
                        show_map($map2);
                        $map2 = $parent{$map2};
                    }

                    exit;
                }
            }

            # links
            if ($pos % 6 > 0 and substr($map, $pos - 1, 1) eq ' ') {
                my $map2 = move($map, $pos - 1, $wurm);
                unless ($move{$map2}) {
                    $move{$map2} = $move{$map} + 1;
                    push @next, $map2;
                    $parent{$map2} = $map;
                }
            }

            # rechts
            if ($pos % 6 < 5 and substr($map, $pos + 1, 1) eq ' ') {
                my $map2 = move($map, $pos + 1, $wurm);
                unless ($move{$map2}) {
                    $move{$map2} = $move{$map} + 1;
                    push @next, $map2;
                    $parent{$map2} = $map;
                }
            }
        }
    }
}


sub move {
    my ($map, $pos, $wurm) = @_;

    my $map2 = $map;
    substr($map2, $pos, 1, $wurm);

    my @wurm = ($pos);
    my %wurm = ($pos => 1);

    my $found = 1;
    while ($found) {
        # hoch
        if ($pos > 5 and not $wurm{$pos - 6} and
            substr($map2, $pos - 6, 1) =~ /$wurm/i) {
            $pos = $pos - 6;
            push @wurm, $pos;
            $wurm{$pos} = 1;
        }
        # runter
        elsif ($pos < 30 and not $wurm{$pos + 6} and
               substr($map2, $pos + 6, 1) =~ /$wurm/i) {
            $pos = $pos + 6;
            push @wurm, $pos;
            $wurm{$pos} = 1;
        }
        # links
        elsif ($pos % 6 > 0 and not $wurm{$pos - 1} and
               substr($map2, $pos - 1, 1) =~ /$wurm/i) {
            $pos = $pos - 1;
            push @wurm, $pos;
            $wurm{$pos} = 1;
        }
        # rechts
        elsif ($pos % 6 < 5 and not $wurm{$pos + 1} and
               substr($map2, $pos + 1, 1) =~ /$wurm/i) {
            $pos = $pos + 1;
            push @wurm, $pos;
            $wurm{$pos} = 1;
        }
        else {
            $found = 0;
        }
    }

    # 2. Position klein
    substr($map2, $wurm[1], 1, lc $wurm);

    # Ende weg
    substr($map2, $wurm[-1], 1, ' ');

    # neues Ende gross
    substr($map2, $wurm[-2], 1, $wurm);

    return $map2;
}

sub show_map {
    my ($map) = @_;

    printf("%s\n%s\n%s\n%s\n%s\n%s\n\n",
           substr($map,  0, 6),
           substr($map,  6, 6),
           substr($map, 12, 6),
           substr($map, 18, 6),
           substr($map, 24, 6),
           substr($map, 30, 6),
          );
}