use strict;
use warnings;
use feature    qw/ say /;
use List::Util qw/ first uniqnum /;
use PDL;
use PDL::Image2D;

# It's important that shape doesn't touch boundaries.
# Otherwise neighbours could be found across image edges,
# or substr (below) can look outside argument.

my ( $w, $h ) = ( 42, 33 );
my $str = << 'END';
..........................................
..............................#...........
.......................########...........
.....................##########...........
.....................##########...........
.....................##########...........
..#.................#############.......#.
.###...............######################.
.###..............#######################.
..####............#######################.
...#####..........#######################.
....######........#######################.
....##########....#######################.
....#####################################.
....#####################################.
....#####################################.
.......##################################.
.......##################################.
.......##################################.
........#################################.
........#################################.
........#################################.
.........################################.
.........################################.
.........################################.
..........##############################..
...........#############################..
................########################..
.......................#################..
...........................#############..
.................................######...
.................................#####....
..........................................
END
$str =~ tr/.#\n/01/d;

my ( $w_, $h_ ) = ( 3 * $w, 3 * $h );
my $in  = pdl([ split '', $str ])-> reshape( $w, $h );
my $img = zeroes( $w_, $h_ );
rescale2d( $in, $img );

my $kernel_1 = pdl([ qw/
 0 -1  0
-1  4 -1
 0 -1  0
/])-> reshape( 3, 3 );

my $kernel_2 = pdl([ qw/
 0 -2  0
-1  5 -1
 0 -2  0
/])-> reshape( 3, 3 );

$img = conv2d( $img, $kernel_1 ) > 0;
$img = conv2d( $img, $kernel_2 );
$img = ( $img == 1 ) + ( $img >= 3 );

# Dump image any time for inspection,
# terminal must be wider than $w_ (126).
#
# my @lst = $img-> list;
# say splice @lst, 0, $w_ while @lst;

# Back to Perl from PDL-land.

my $s = ${ $img-> byte-> get_dataref };

my @checks = (                  # 8 neighbours
-$w_ - 1,  -$w_, -$w_ + 1,
      -1,               1,
 $w_ - 1,   $w_,  $w_ + 1,
);

my $i = CORE::index $s, "\1";   # 1st point
my @list = ( $i );
substr $s, $i, 1, "\0";

while () {
    my $j = first { "\1" eq substr $s, $i + $_, 1 } @checks;
    last unless defined $j;
    $i += $j;
    push @list, $i;
    substr $s, $i, 1, "\0";
}

die if CORE::index( $s, "\1" ) >= 0;        # can't be

# Scale point coordinates back to original,
# squash duplicates.

@list = uniqnum map {
    use integer;
    my $x = $_ % $w_ / 3;
    my $y = $_ / $w_ / 3;
    $x + $y * $w
} @list;

# @list uniquely identifies sequence to create polyline,
# can be converted to (x,y) pairs if required.
# Below is simple transformation to 2D picture.

my $out = '.' x ( $w * $h );
my $n   = 0;
for ( @list ) {
    substr $out, $_, 1, $n ++;
    $n %= 10;
}
say substr $out, 0, $w, '' while $out;

##</code><code>##

..........................................
..............................0...........
.......................76543212...........
.....................98.......1...........
.....................0........0...........
.....................1........9...........
..5.................2..........87.......9.
.6.4...............3.............65432108.
.7.3..............4.....................7.
..8.21............5.....................6.
...9..09..........6.....................5.
....0...87........7.....................4.
....1.....6543....8.....................3.
....2.........2109......................2.
....3...................................1.
....456.................................0.
.......7................................9.
.......8................................8.
.......9................................7.
........0...............................6.
........1...............................5.
........2...............................4.
.........3..............................3.
.........4..............................2.
.........5..............................1.
..........6............................0..
...........78901.......................9..
................2345678................8..
.......................9012............7..
...........................345678......6..
.................................9....5...
.................................01234....
..........................................

##</code><code>##

$img  = conv2d( $img, $kernel ) == 1;
$img += 48;

my $s = ${ $img-> byte-> get_dataref };

my @checks = (              # increments to
-$w_ - 1 ,1, 1,             # 8 neighbours
 $w_ - 2,    2,
 $w_ - 2, 1, 1,
);

my $i = CORE::index $s, 1;  # 1st point
my @list = ( $i );
substr $s, $i, 1, 0;

push @list, $i
    while first { substr $s, $i += $_, 1, 0 } @checks;

##</code><code>##

>perl -MList::Util=uniqnum -E "say for uniqnum 1,1,2,1
1
2

##</code><code>##

>perl -E "say '1121'=~tr/12/12/sr"
121

##</code><code>##

my $prev = -1;
@list = grep { 
    my $res = $prev != $_; 
    $prev = $_; 
    $res 
} map {
    use integer;
    my $x = $_ % $w_ / 3;
    my $y = $_ / $w_ / 3;
    $x + $y * $w
} @list;