AoC 2024, day 6 (Perl)

#!/usr/bin/perl

use strict;
use warnings;

use feature         qw(say);
use List::AllUtils  qw(firstidx);
use Math::Vector::Real;

my ($y,$x) = Math::Vector::Real->canonical_base(2);
my @Dirs = ($y, -$x, -$y, $x);

# Read in grid, adding sentinel ~s to right and bottom
my @Grid = map { chomp; [split(//), '~'] } <>;
push( @Grid, [('~') x $Grid[0]->@*] );

sub grid_at ($) { my $p = shift; return ($Grid[$p->[0]][$p->[1]]) }

my $start_pos;
my $face = 2;
foreach my $y (0 .. $#Grid) {
    my $x = firstidx { $_ eq '^' } $Grid[$y]->@*;
    if ($x != -1) {
        $start_pos = V($y,$x);
        last;
    }
}

sub test_block {
    my ($block, $pos, $face, $path) = @_;
    my %visit;

    $Grid[$block->[0]][$block->[1]] = '#';

    while (&grid_at( $pos ) ne '~') {
        my $ahead = $pos + $Dirs[$face];

        if (&grid_at( $ahead ) eq '#') {
            $face = ($face + 1) % 4;
        } else {
            last if ($visit{$ahead}{$face} or ($path->{$ahead} and $path->{$ahead}{$face}));
            $pos = $ahead;
        }
        $visit{$pos}{$face}++;
    }

    $Grid[$block->[0]][$block->[1]] = '.';

    return (&grid_at( $pos ) ne '~');
}

my %path;
my %block;
my $pos = $start_pos;
my $count = 0;

$path{$pos}{$face}++;
while (&grid_at( $pos ) ne '~') {
    my $ahead = $pos + $Dirs[$face];

    print ::stderr "$count\r"  if (++$count % 500 == 0);

    if (&grid_at( $ahead ) eq '#') {
        $face = ($face + 1) % 4;
    } else {
        if (&grid_at( $ahead ) eq '.' and !$block{$ahead} and !$path{$ahead}) {
            $block{$ahead}++ if (&test_block( $ahead, $pos, $face, \%path ));
        }

        $pos = $ahead;
    }
    $path{$pos}{$face}++;
}

say "Part 1: ", (scalar keys %path) - 1;
say "Part 2: ", (scalar keys %block);