use strict; use warnings; use Data::Dump 'pp'; ### # Read the image, converting non-space characters into '#' ### my $FName = shift; my $FH; if (defined $FName) { open $FH, '<', $FName or die "$FName: $!"; } else { $FH = \*DATA; } my @pts = read_image($FH); ### # Find bounds of figure ### my ($minX, $minY) = (999999999,999999999); my ($maxX, $maxY) = (-$minX, -$minY); for my $ar (@pts) { my ($x,$y) = @$ar; $minX = $x if $x < $minX; $maxX = $x if $x > $maxX; $minY = $y if $y < $minY; $maxY = $y if $y > $maxY; } print "Bounds X:$minX..$maxX, Y:$minY..$maxY\n"; ### # Build a blank canvas and the original output image ### my @canvas; push @canvas, [ (' ') x ($maxX - $minX + 1) ] for 0 .. $maxY-$minY+1; my @original = copy_array(@canvas); for my $ar (@pts) { my ($x, $y) = @$ar; $x -= $minX; $y -= $minY; $original[$y][$x] = '#'; } print "Original image (relocated, pixels set to '#'):\n"; print_array(@original); ### # Find a horizonal bit of edge from the top of the picture # NOTE: NOT ROBUST (it can be fooled). ### my ($in_dir, $start_x, $start_y) = find_start_point(@original); print "Found a bit of horizontal top edge at $start_x, $start_y\n"; ### # Build our list or border points by walking clockwise around the # border of the polygon. # # NOTE: find_start_point needs to choose a point and incoming # direction to let us walk the polygon edge clockwise. # # $x, $y - current point on the edge # $in_dir - the direction we came from ### my @dirlist = (qw(1 2 3 4 5 6 7 8 1 2 3 4 5 6 7)); my %dels = ( # IN [ dx, dy, new_in_dir ] '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' ], ); # Follow the border my @img = copy_array(@original); my @points_in_order = ( [$start_x, $start_y] ); my ($x, $y) = ($start_x, $start_y); do { # Check clockwise arc for next colored pixel my @dirs = @dirlist[0+$in_dir .. 7+$in_dir]; for my $d (@dirs) { my ($dx, $dy, $new_in_dir) = @{$dels{$d}}; my ($tx, $ty) = ($x+$dx, $y+$dy); next if $tx < 0 or $ty < 0; next if $tx >= $maxX or $ty >= $maxY; if ($img[$ty][$tx] eq '#') { ($in_dir, $x, $y) = ($new_in_dir, $tx, $ty); push @points_in_order, [ $x, $y ]; last; } } } until ($x == $start_x and $y == $start_y); ### # Render the points on a blank canvas ### my $fn_next_border_char = border_char_iterator(); @img = copy_array(@canvas); for my $i (0 .. $#points_in_order) { my ($x,$y) = @{$points_in_order[$i]}; $img[$y][$x] = $fn_next_border_char->(); } print "\nPoints rendered on blank canvas:\n"; print_array(@img); ### # Draw 'em on the solid shape, to verify that border is correct ### @img = copy_array(@original); $fn_next_border_char = border_char_iterator(); for my $i (0 .. $#points_in_order) { my ($x,$y) = @{$points_in_order[$i]}; $img[$y][$x] = $fn_next_border_char->(); } print "\nBorder points rendered on original polygon:\n"; print_array(@img); sub border_char_iterator { my $cnt = 0; my $border_chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; return sub { return substr($border_chars, $cnt++%length($border_chars), 1); } } sub print_array { print "\n"; my @array = @_; for my $i (0 .. $#array) { print ": ", join("", @{$array[$i]}), " : ", sprintf("% 3u",$i), "\n"; } print " "; print substr("1234567890"x20, 0, scalar(@{$array[0]})), "\n\n"; } sub copy_array { my @array = @_; my @ret; for my $ar (@array) { push @ret, [ @$ar ]; } return @ret; } sub read_image { my $FH = shift; my @points; while (my $line = <$FH>) { my @chars = split //, $line; for my $x (0 .. $#chars) { if ($chars[$x] !~ /\s/) { push @points, [ $x, $. ]; } } } return @points; } sub find_start_point { my @original = @_; for my $iy (0 .. $#original) { for my $ix (0 .. $#{$original[0]}) { if ($original[$iy][$ix] eq '#' and $original[$iy][$ix+1] eq '#' and $original[$iy+1][$ix] eq '#') { $start_x = $ix; $start_y = $iy; return '8', $ix, $iy; } } } } __DATA__ # ######## BBBBBBB ########## BBBBBBBBBBBBBB########## BBBBBBB ########## # ############# # ### ###################### ### ####################### #### ####################### ##### ####################### ###### ####################### ########## ####################### ##################################### ##################################### ##################################### ################################## ################################## ################################## ################################# ################################# ################################# ################################ ################################ ################################ ############################## ############################# ######################## AAAAAAAA ################# AAAAAAAA ############# AAAAAAAA ###### ##### #### $ perl ~/pm_1204060_b.pl Bounds X:1..40, Y:1..31 Original image (relocated, pixels set to '#'): : # : 0 : ######## : 1 : ####### ########## : 2 : ######################## : 3 : ####### ########## : 4 : # ############# # : 5 : ### ###################### : 6 : ### ####################### : 7 : #### ####################### : 8 : ##### ####################### : 9 : ###### ####################### : 10 : ########## ####################### : 11 : ##################################### : 12 : ##################################### : 13 : ##################################### : 14 : ################################## : 15 : ################################## : 16 : ################################## : 17 : ################################# : 18 : ################################# : 19 : ################################# : 20 : ################################ : 21 : ################################ : 22 : ################################ : 23 : ############################## : 24 : ############################# : 25 : ######################## : 26 : ######## ################# : 27 : ######## ############# : 28 : ######## ###### : 29 : ##### : 30 : : 31 1234567890123456789012345678901234567890 Found a bit of horizontal top edge at 22, 1 Points rendered on blank canvas: : H : 0 : tBCDEFGI : 1 : efghijk rs J : 2 : d lmnopq K : 3 : cbaZYXW P L : 4 : r O MN V : 5 : q s N OPQRSTUW : 6 : p t M X : 7 : o uv L Y : 8 : n wx K Z : 9 : m yz J a : 10 : l ABCD I b : 11 : k EFGH c : 12 : j d : 13 : ihg e : 14 : f f : 15 : e g : 16 : d h : 17 : c i : 18 : b j : 19 : a k : 20 : Z l : 21 : Y m : 22 : X n : 23 : W o : 24 : VUTSR p : 25 : QPONMLK q : 26 : JIHG r : 27 : FEDCBA s : 28 : z t : 29 : yxwvu : 30 : : 31 1234567890123456789012345678901234567890 Border points rendered on original polygon: : H : 0 : tBCDEFGI : 1 : efghijk rs#######J : 2 : d#######lmnopq#########K : 3 : cbaZYXW P########L : 4 : r O##########MN V : 5 : q#s N#############OPQRSTUW : 6 : p#t M#####################X : 7 : o#uv L#####################Y : 8 : n##wx K#####################Z : 9 : m###yz J#####################a : 10 : l#####ABCD I#####################b : 11 : k#########EFGH######################c : 12 : j###################################d : 13 : ihg#################################e : 14 : f################################f : 15 : e################################g : 16 : d################################h : 17 : c###############################i : 18 : b###############################j : 19 : a###############################k : 20 : Z##############################l : 21 : Y##############################m : 22 : X##############################n : 23 : W############################o : 24 : VUTSR#######################p : 25 : QPONMLK################q : 26 : ######## JIHG############r : 27 : ######## FEDCBA######s : 28 : ######## z####t : 29 : yxwvu : 30 : : 31 1234567890123456789012345678901234567890