use v6;

#try to move the mein piece right, and try to remove obstacles

class Groove {
	has @.start;
	has Str $.name;
	has  @.right;
};

grammar PieceGrammar {
	token TOP { ^ <groove> <range> $ }
	token range {  (\d ** 2..3) 
			<!{ my @a := $0.comb.sort;
				@a leg (@a[0]..@a[*-1]);
				}> }
	token groove { <[a..w]> }
};

class Piece {
	has @.cells;
	has Groove $.groove;

	method doMove(Int $direction) {
		for @.cells -> $cell {
			@$cell >>+=>> (@$direction <<*>> $.groove.right);
		}
	}

	method Str {
		my @curcell = @($.groove.start);
		my $str = $.groove.name;
		for 1..7 {
			$str ~= $_ if !(@.cells[0] leg @curcell) ff !(@.cells[*-1] leg @curcell); 
			@curcell <<+=>> $.groove.right;
		}
		return $str;
	}
};

class Board {
	has @.cells;
	has Piece @.pieces;
	has Groove %.grooves;

	submethod initGrooves(@range, %starts, @direction) {
		for @range Z %starts{@range} -> $key, $value {
			my $field = $value.comb.map: {.ord};
			%.grooves{$key} = Groove.new(:name($key),:right(@direction),:start($field));
		}
	}

	submethod BUILD {
		my %starts = {:a<at>, :b<bs>, :c<cr>, :d<dq>, :e<ep>, :f<fq>, :g<gq>,:h<hr>,
			:i<ep>, :j<fp>,	:k<fq>, :l<gq>, :m<gr>, :n<hr>, :o<hs>, :p<fp>, :q<gq>,
			:r<hr>, :s<hs>, :t<gt>, :u<fu>, :v<ev>, :w<dw>};
		self.initGrooves('a'..'h',%starts,(0,1));
		self.initGrooves('i'..'o',%starts,(-1,1));
		self.initGrooves('p'..'w',%starts,(-1,0));
	}

	method isOnBoard(@cell) {
		return 'a'.ord+'t'.ord <= ([+] @cell) <= 'd'.ord+'w'.ord
			 && 'a'.ord-'u'.ord <= ([-] @cell) <= 'g'.ord-'q'.ord;
	}

	method getPiece(@cell) {
		for @.pieces -> $piece {
			if ($piece.cells.grep: {!($_ leg @cell)}) {
				return $piece;#cast?
			}
		}
		return Bool::False;
	}

	method addPiece(Piece $piece) {
		for $piece.cells -> $cells {
			if (!self.isOnBoard(@$cells) or self.getPiece(@$cells)) {
				die "invalid pieces";
			}
		}
		@.pieces.push($piece);
	}
};

sub move($board, @plan) {
	@plan or return ("end");
	my ($piece,$direction) = @(pop @plan);

	my $cell = $piece.cells[$direction < 0 ?? 0 !! *-1];
	my @newcell = @$cell >>+>> ($direction <<*>> $piece.groove.right);
	if (my $obstacle = $board.getPiece(@newcell)) {
		my ($left, $right) = $obstacle.cells.elems, 1;
		while $obstacle.cells[$right-1] leg @newcell {
			($left, $right) <<+=>> (-1,1);
		}
		my $lastdir = 0;
		for @plan.reverse -> $p {
			if ($p[0] ~~ $obstacle) {
				$lastdir = $p[1];
				last;
			}
		}
		if (my $resultl = ($lastdir != -1) &&
			move($board, (@plan,[($piece,$direction)],[$obstacle,-1] xx $left).list)) {
			return @$resultl;
		}
		if (my $resultr = ($lastdir != 1) &&
			move($board, (@plan,[($piece,$direction)],[$obstacle,1] xx $right).list)) {
			return @$resultr;
		}
		return Bool::False;
	} elsif ($board.isOnBoard(@newcell)) {
		$piece.doMove($direction);
		if ( my $solution = move($board, @plan)) {
			my $res = $piece.Str;
			$piece.doMove(-$direction);
			return ($piece.Str, $res, @$solution);
		}
		$piece.doMove(-$direction);
		return Bool::False;
	} else {
		return Bool::False;
	}
}

sub MAIN {
	my Board $board .= new();
	while $*IN.get() -> $line {
		my $g := PieceGrammar.parse($line) or say "invalid Piece" and return;
		my @d := $g{'range'}.comb.sort;
		my $groove = $board.grooves{$g{'groove'}};
		my @cells = ((@d <<->> 1) X* $groove.right).map: 
								->$x,$y {[$groove.start <<+>> ($x, $y)]};
		$board.addPiece(Piece.new(:cells(@cells), :groove($groove)));
	}
	my $start = $board.getPiece(('g'.ord,'q'.ord));
	$start and $start.cells.elems == 2 and $start.groove.name eq "l" or say "No bullet specified" and return;
	my @plan = [$start,1] xx 4;
	my @solution = move($board, @plan);
	@solution[0] or say "no solution" and return;
	my ($curgroove, $curpos, $curstart) = ();

	while (@solution.shift ~~ /(.)(\d+)/) {
		if ($0 ne $curgroove) {
			$curgroove.defined and say "$curgroove\[$curstart -> $curpos\]";
			($curgroove, $curstart) = ($0,$1);
		} else {
			$curpos = $1;
		}
	}
	say "$curgroove\[$curstart -> $curpos\]";
}