#!/usr/bin/perl

###############
## Libraries ##
###############
use strict;
use warnings;
use Data::Dumper::Concise;
use Function::Parameters;
use lib ".";
use Shape;


##################
## Main Program ##
##################
my $pts     = assign_points();
my $sh      = Shape->new($pts, 1);
my $outline = $sh->outline;

printf "[Resulting Outline]\n";
foreach my $a_point (@$outline) {
    printf "[%s],", join(',', @$a_point);
}
print "\n";


#################
## Subroutines ##
#################
fun assign_points() {
    return [
        [527,83],[527,84],[526,84],[525,84],[524,84],[523,84],[522,84],
       # ... Many more points -- see the original code ...
  ];
}

##</code><code>##

package Shape;


#=============#
## Libraries ##
#=============#
use strict;
use warnings;
use feature qw( say );
use Data::Dumper::Concise;
use Function::Parameters;


#===============#
## Constructor ##
#===============#
method new($proto: $a_points = [ ], $b_debug = 0) {
    my $self = {
        points => $a_points,
        debug  => $b_debug,
    };

    bless $self, $proto;

    $self->_find_extrema();
    $self->{image} = $self->_construct_image();

    return $self;
}


#==================#
## Public methods ##
#==================#


#=============#
## Accessors ##
#=============#
method debug()   { return $self->{debug} }
method points()  { return $self->{points} }
method image()   { return $self->{image} }
method extrema() { return @{$self->{extrema}} }


#
#  outline()
#
#  Returns the outline of the shape, constructing it first if necessary.
#
method outline() {
    if (!$self->{outline}) {
        $self->remove_interior;
        my ($x, $y) = $self->find_horizontal_edge();
        $self->_find_outline($x, $y);
    }

    return $self->{outline};
}


#
#  prune_interior_points()
#
#  Removes points within the interior of the shape.
#
#  Such points are defined as being bordered on all 4 sides
#  (excluding diagonals) by other points in the shape.
#
#  For example, the points '#' in the shape on the left would be
#  pruned to produce the shape on the right (where 'o' stands for
#  a point which has been pruned, so is actually no longer present
#  in the shape):
#
#      . . . . . . . . . . . .        . . . . . . . . . . . .
#      . . . # . . . . . . . .        . . . # . . . . . . . .
#      . . # # # . . . . . . .        . . # o # . . . . . . .
#      . . . # # # # # # # # .        . . . # o # # # # # # .
#      . . # # # # # # # # . .        . . # o o o o o o # . .
#      . # # # # # # # # . . .        . # # o o o o o # . . .
#      . . . # # # # # # # # .        . . . # o o o o o # # .
#      . . . . # # # # # . . .        . . . . # # # # # . . .
#      . . . . . . . . # # . .        . . . . . . . . # # . .
#      . . . . . . . . . . . .        . . . . . . . . . . . .
#
method prune_interior_points() {
    my $a_pruned = [ ];

    my $a_points = $self->points;

    for (my $i = 0; $i < @$a_points; $i++) {
        my $a_pt = $a_points->[$i];
        my ($x, $y) = @$a_pt;
        if (!$self->_point_is_surrounded($x, $y, $a_points)) {
            push @$a_pruned, [ $x, $y ];
        }
    }

    return $self->{points} = $a_pruned;
}


#
#  show_points()
#
#  Creates a simple ascii display of the points in the shape
#
method show_points($label = "Shape") {
    my $a_points = $self->points;
    my ($minx, $miny, $maxx, $maxy) = $self->extrema();
    my $width  = $maxx - $minx + 1;
    my $height = $maxy - $miny + 1;
    my $N      = @$a_points;

    say "\n[$label: $N points]";

    # Create a blank shape
    my $shape = [ ];
    for (my $y = 0; $y < $height + 2; $y++) {
        my $row = $shape->[$y] = [ ];
        for (my $x = 0; $x < $width + 2; $x++) {
            $row->[$x] = 0;
        }
    }

    # Fill in the points for the current shape
    for (my $i = 0; $i < @$a_points; $i++) {
        my $a_point = $a_points->[$i];
        my ($x, $y) = @$a_point;
        $y = $y - $miny + 1;
        $x = $x - $minx + 1;
        my $row    = $shape->[$y];
        $row->[$x] = 1;
    }

    # Display the resulting shape
    for (my $y = 0; $y < $height + 2; $y++) {
        my $row  = $shape->[$y];
        my $line = join("", map { $_? '#': '.' } @$row);
        say $line;
    }
}

  
method clone_image($a_image = $self->image) {
    my $a_clone = [ ];

    for (my $i = 0; $i < @$a_image; $i++) {
        my $a_row = $a_image->[$i];
        push @$a_clone, [ @$a_row ];
    }

    return $a_clone;
}


method remove_interior() {
    my $a_image = $self->image;
    my $a_new   = $self->clone_image($a_image);

    my $height  = @$a_image;
    my $width   = @{$a_image->[0]};

    # Temporarily mark interior points
    for (my $y = 1; $y < $height; $y++) {
        for (my $x = 1; $x < $width; $x++) {
            if ($self->_is_interior_point($x, $y, $a_image)) {
                $a_new->[$y][$x]  = 'o';
            }
        }
    }

    $self->debug and $self->_print_image($a_new);
    $self->{image} = $a_new;
}


method find_horizontal_edge($a_image = $self->image) {
    my $height  = @$a_image;
    my $width   = @{$a_image->[0]};

    for (my $y = 0; $y < $height - 1; $y++) {
        for (my $x = 0; $x < $width - 1; $x++) {
            my $pt0 = $a_image->[$y][$x]   || ' ';
            my $pt1 = $a_image->[$y][$x+1] || ' ';
            my $pt2 = $a_image->[$y+1][$x] || ' ';
            if ($pt0 eq '#' and $pt1 eq '#' and $pt2 eq 'o') {
                return ( $x, $y );
            }
        }
    }

    $self->_fatal("Unable to find a horizontal outer edge");
}


#===================#
## Private methods ##
#===================#
method _debug($msg) {
    $self->{debug} or return;
    say $msg;
}


method _fatal($msg) {
    my $lnum = (caller)[2];
    die "(Shape.pm) FATAL[$lnum]:  $msg\n";
}


#  
#  _point_is_surrounded($x, $y, $a_points)
#  
#  Given a point ($x, $y), returns nonzero iff that point is bounded
#  on all 4 sides (excluding diagonals) by other points.
#  
method _point_is_surrounded($x, $y, $a_points = $self->points) {
    my $nneighbors = 0;

    for (my $i = 0; $i < @$a_points; $i++) {
        my $a_pt = $a_points->[$i];
        my ($x1, $y1) = @$a_pt;
        my $dx = abs($x1 - $x);
        my $dy = abs($y1 - $y);
        if ((1 == $dx and 0 == $dy) or (0 == $dx and 1 == $dy)) {
            ++$nneighbors;
        }
    }

    return (4 == $nneighbors)? 1: 0;
}


#
#  _is_interior_point($x, $y, $a_image)
#
#  Given a point ($x, $y) and an image $a_image, returns nonzero iff that
#  point in the image is surrounded on all 4 sides (excluding diagonals)
#  by other points.
#
method _is_interior_point($x, $y, $a_image = $self->image) {
    (($a_image->[$y][$x]   || ' ') eq '#') or return 0;
    (($a_image->[$y-1][$x] || ' ') eq '#') or return 0;
    (($a_image->[$y+1][$x] || ' ') eq '#') or return 0;
    (($a_image->[$y][$x-1] || ' ') eq '#') or return 0;
    (($a_image->[$y][$x+1] || ' ') eq '#') or return 0;
    return 1;
}


#  
#  _construct_image()
#  
#  Creates the 2-dimensional image  defined by the shape's points.
#  
method _construct_image() {
    my ($minx, $miny, $maxx, $maxy) = $self->extrema();

    my $height  = $maxy - $miny + 1;
    my $width   = $maxx - $minx + 1;
    my $a_image = [ ];

    for (my $i = 0; $i < $height; $i++) {
        push @$a_image, [ (' ') x $width ];
    }

    my $a_points = $self->points;

    for my $a_pt (@$a_points) {
        my ($x, $y) = @$a_pt;
        $a_image->[$y - $miny][$x - $minx] = '#';
    }

    $self->debug and $self->_print_image($a_image);
    return $a_image;
}


method _print_image($a_image = $self->image) {
    print "\n";
    my $a_line0 = $a_image->[0];
    my $width   = @$a_line0;

    print "  ";
    for (my $i = 0; $i < $width; $i++) {
        printf "%d", $i % 10;
    }
    print "\n";

    for (my $i = 0; $i < @$a_image; $i++) {
        my $a_line = $a_image->[$i] || 0;
        $a_line or $self->fatal("Image[$i] is NOT an array");
        printf ": %s : % 3u\n", join("", @$a_line), $i;
    }

    print "Type [CR]"; <STDIN>;
    return;
}


#
#  _find_extrema
#
#  Finds the bounding box, represented by the Min (X, Y) and Max (X, Y)
#  points for the shape.
#  
method _find_extrema() {
    my $a_points = $self->points;
    my ($minx, $miny, $maxx, $maxy);

    for (my $i = 0; $i < @$a_points; $i++) {
        my ($x, $y) = @{$a_points->[$i]};
        defined($x) or $self->_fatal("Undefined X");
        defined($y) or $self->_fatal("Undefined Y");

        if (0 == $i) {
            $minx = $maxx = $x;
            $miny = $maxy = $y;
        }

        ($x < $minx) and $minx = $x;
        ($y < $miny) and $miny = $y;
        ($x > $maxx) and $maxx = $x;
        ($y > $maxy) and $maxy = $y;
    }

    my $a_extrema = $self->{extrema} = [ $minx, $miny, $maxx, $maxy ];
    return @$a_extrema;
}


#
#  _find_outline($x, $y, $a_image)
#
# Given a horizontal edge point ($x, $y) and an optional image $a_image,
# constructs the outline of the shape by walking around it, choosing the
# best direction each time.
#
# Thanks to roboticus from perlmonks for the original algorithm.
# Ref:  http://perlmonks.com/?node_id=1204093
#
# Roboticus writes:
#   We've found a bit of horizontal edge, and we're proceeding in the +X
#   direction, and we know the interior of the polygon is on the right hand
#   side.
#
#   So we'll build a simple state machine that walks the edge.
#
#   $x, $y  - current point on the edge
#   $in_dir - the direction we came from
##
method _find_outline($x, $y, $a_image = $self->image) {
    # Get the extrema of the shape
    my ($minx, $miny, $maxx, $maxy) = $self->_find_extrema;

    # Follow the border
    my $a_outline = [[ $x + $minx, $y + $miny ]];
    my $in_dir    = '8';
    my $cnt       = 0;
    my $npts      = 0;      # Total points in image

    # Discard interior points, which are no longer needed
    for (my $y = 0; $y < @$a_image; $y++) {
        my $a_row = $a_image->[$y];
        for (my $x = 0; $x < @$a_row; $x++) {
            ($a_row->[$x] =~ /[ox]/) and $a_row->[$x] = ' ';
            ($a_row->[$x] eq '#')    and ++$npts;
        }
    }

    while (1) {
        my $sym = chr(65 + $cnt++ % 26);
        $in_dir = $self->_new_dir($a_image, $npts, \$x, \$y, $in_dir, $sym);

        if (!$in_dir) {
            $npts or last;
            $self->debug and $self->_print_image($a_image);
            $self->_fatal("There were $npts unused points");
        }

        push @$a_outline, [ $x + $minx, $y + $miny ];
        --$npts;
    }

    $self->debug and $self->_print_image($a_image);
    $self->{outline} = $a_outline;
}


#
# This method is also based on the algorithm by roboticus from perlmonks
#
# The direction code maps to the following directions:
#
#               6
#           5   ^   7
#            \  |  /
#             \ | /
#        4 <--- o ---> 8
#             / | \
#            /  |  \
#           3   v   1
#               2
#
##
method _new_dir($a_image, $npts, $s_x, $s_y, $in_dir, $sym) {
    my $height    = @$a_image;
    my $width     = @{$a_image->[0]};

    # Input dirction mapped to preferred output direction
    my $h_dirs = {
        '1' => [qw( 3 4 5 6 7 8 2 )], '2' => [qw( 3 4 5 6 7 8 1 )],
        '3' => [qw( 4 5 6 7 8 1 2 )], '4' => [qw( 5 6 7 8 1 2 3 )],
        '5' => [qw( 6 7 8 1 2 3 4 )], '6' => [qw( 7 8 1 2 3 4 5 )],
        '7' => [qw( 1 2 3 4 5 6 )],   '8' => [qw( 3 4 5 6 7 )],
    };

    # Delta X, Y and new input direction IN   [ dx, dy, newdir ]
    my $h_deltas = {
        '1' => [ -1, -1, '5' ],  '2' => [  0, -1, '6' ],
        '3' => [  1, -1, '7' ],  '4' => [  1,  0, '8' ],
        '5' => [  1,  1, '1' ],  '6' => [  0,  1, '2' ],
        '7' => [ -1,  1, '3' ],  '8' => [ -1,  0, '4' ],
    };

    my $a_dirs = $h_dirs->{$in_dir};

    for my $dir (@$a_dirs) {
        my ($dx, $dy, $newdir) = @{$h_deltas->{$dir}};
        my ($x1, $y1) = ($$s_x + $dx, $$s_y + $dy);
        if ($x1 >= 0 and $y1 >= 0 and $x1 < $width and $y1 < $height) {
            my $pixel = $a_image->[$y1][$x1] || ' ';
            if ($pixel eq '#') {
                $$s_x += $dx;
                $$s_y += $dy;
                $a_image->[$$s_y][$$s_x] = $sym;
                return $newdir;
            }
        }
    }

    # If there are still unused points in the image, just pick
    # the closest point and use that.
    ##
    ($npts > 0) and return $self->_closest_point($a_image, $s_x, $s_y, $sym);

    return 0;
}


method _distance($x0, $y0, $x1, $y1) {
    return sqrt(($y1 - $y0) ** 2 + ($x1 - $x0) ** 2);
}


method _closest_point($a_image, $s_x, $s_y, $sym) {
    my $mindist = 9999;
    my ($x1, $y1);

    for (my $y = 0; $y < @$a_image; $y++) {
        my $a_row = $a_image->[$y];
        for (my $x = 0; $x < @$a_row; $x++) {
            ($x == $$s_x and $y == $$s_y) and next;
            my $pixel = $a_image->[$y][$x] || ' ';
            if ($pixel eq '#') {
                my $newdist = $self->_distance($x, $y, $$s_x, $$s_y);
                if ($newdist < $mindist) {
                    ($mindist, $x1, $y1) = ($newdist, $x, $y);
                }
            }
        }
    }

    my $dx     = $x1 - $$s_x;
    my $dy     = $y1 - $$s_y;
    $$s_x      = $x1;
    $$s_y      = $y1;
    $a_image->[$$s_y][$$s_x] = '*';

    (0 == $dx) and return ($dy < 0)? 6: 2;  # North or South
    (0 == $dy) and return ($dx < 0)? 4: 8;  # West or East
    ($dx < 0)  and return ($dy < 0)? 5: 3;  # Northwest or Southwest
    ($dx > 0)  and return ($dy < 0)? 7: 1;  # Northeast or Southeast

    return 0;
}


1;