Advent of code 2024 Day 6

#!/usr/bin/perl
use strict;
use warnings;

my $map = '';
my $width = 0;
while (<DATA>) {
    next unless my $hit = /^start/../^stop/;
    next if $hit == 1;
    last if $hit + 0 ne $hit;
    chomp;
    $width = length $_ unless $width;
    $map .= $_ . ':';
}

my ($moves, $result) = solve($map);

sub solve {
    my($map) = shift;
    my $moves = 1;
    printmap($map);
    my $last = '|';
    my $field = '.';
    MOVE: while (1) {
        while ($map =~ s/([-+.|])(.{$width})\^/^$2$last/) {
            ++$moves if $1 eq '.';
            $field = $1;
            $last = nextv($1);
            printmap($map);
        }
        last MOVE unless $map =~/^[-+.|#]{$width}/;
        return undef if $field eq '+';
        $map =~ s/\^/>/;
        $last = '+';
        printmap($map);
        while ($map =~ s/>([-+.|])/$last>/) {
            ++$moves if $1 eq '.';
            $field = $1;
            $last = nexth($1);
            printmap($map);
        }
        last MOVE if $map =~ />:/;
        return undef if $field eq '+';
        $map =~ s/>/v/;
        $last = '+';
        printmap($map);
        while ($map =~ s/v(.{$width})([-+.|])/$last$1v/) {
            ++$moves if $2 eq '.';
            $field = $1;
            $last = nextv($2);
            printmap($map);
        }
        last MOVE unless $map =~ /[-+.|#]{$width}:$/;
        return undef if $field eq '+';
        $map =~ s/v/</;
        $last = '+';
        printmap($map);
        while ($map =~ s/([-+.|])</<$last/) {
            ++$moves if $1 eq '.';
            $field = $1;
            $last = nexth($1);
            printmap($map);
        }
        last MOVE if $map =~ /(^|:)</;
        return undef if $field eq '+';
        $map =~ s/</^/;
        $last = '+';
        printmap($map);
    }
    return ($moves, $map);
}

sub nextv {
    my $last = shift;
    return '|' if $last eq '.';
    return '|' if $last eq '|';
    return '+';
}

sub nexth {
    my $last = shift;
    return '-' if $last eq '.';
    return '-' if $last eq '-';
    return '+';
}

printf "Moves: %d\n", $moves;

$result =~ s/[^:#.]/O/g;

my $positions = 0;
my $pos = index $result, 'O';
while ($pos >= 0) {
    my $copy = $map;
    if (substr($copy, $pos, 1) ne '^') {
        substr $copy, $pos, 1, '#';
        my($solved) = solve($copy);
        if (not defined $solved) {
            ++$positions;
        }
    }
    ++$pos;
    $pos = index $result, 'O', $pos;
}

printf "Positions: %d\n", $positions;

sub printmap {
    local $_ = shift;
    #return if $_;
    #$_ = shift;
    s/:/\n/g;
    print;
    <>
}

__DATA__
start
....#.....
.........#
..........
..#.......
.......#..
..........
.#..^.....
........#.
#.........
......#...
stop