You just need to compare the X values between $hv-1 and $hv+1 instead of between $hv and $hv+1. That is, you don't care whether the line segment that starts at the "top" goes to the left or the right of vertical, but instead whether it goes to the left or right of the line segment that ends at the "top".

[ Update: No, that won't work quite right either. If the right-of-top line segment is longer than the left-of-top line segment then the right-of-top could still end with an X coordinate that is to the left of the left-of-top line segments X coordinate. As Thelonius says, you want to compare slopes. You can probably reduce the equations so that you don't have to worry about dividing by zero and testing for multiple cases. Let me think about that...

Here is what I came up with:

    my $b = $blocks[$i];
    my $pv = $hv - 1;
    $pv = $#$b   if  $pv < 0;
    my $nv = $hv + 1;
    $nv = 0   if  $#$b < $nv;
    for my $v (  $pv, $hv, $nv  ) {
        $v = $b->[$v];
    }
    my $na= atan2( $nv->[_X] - $hv->[_X], $nv->[_Y] - $hv->[_Y] );
    my $pa= atan2( $pv->[_X] - $hv->[_X], $pv->[_Y] - $hv->[_Y] );
    if(  $na < $pa  ) {
        # Not clock-wise:
[download]

You could simplify your code a lot with a simple:

    my $pv = $hv - 1;
    $pv = $#{$blo­cks[$i]}   if  $pv < 0;
[download]

You could also make your code a lot easier to understand if you did something like:

    sub _X() { 1 }
    sub _Y() { 2 }
[download]

    if ($blocks[$i][$j][_Y] > $highest) {
[download]

And after those changes, having $xclock == 0 would mean that you have two lines that lie on top of each other (at the "top" of your "polygon"), which should probably just be considered an error.

Hey stu69art, good luck with your search for an alternative algorithm. Here are a few testcases that you can use to verify your results that covers most of the cases you might encounter. Let us know how you get on:)

#! perl -slw
use strict;

sub direction{
    local($_, @_= @_);
    push @_, $_[0];
    $_+= $a->[0]*$b->[1]-$a->[1]*$b->[0] while ($a,$b)=(shift,$_[0]), 
+@_;
    $_ < 0;
}
=pod
|   .
|  /.\
| // \\
|//   -
|\\   _
| \\ //
|  \v/
+---v-----
=cut
my @inflectiveC = ([0,3],[3,6],[5,4],[4,4],[3,5],[1,3],[3,1],[4,2],[5,
+2],[3,0]);
print direction(@inflectiveC) ? 'Clockwise' : 'Not clockwise';

my @inflectiveA = reverse @inflectiveC;
print direction(@inflectiveA) ? 'Clockwise' : 'Not clockwise';

my @mirroredXC = reverse map{ [ 0 - $_->[0], $_->[1]] } @inflectiveC;
print direction(@mirroredXC) ? 'Clockwise' : 'Not clockwise';

my @mirroredXA = map{ [ 0 - $_->[0], $_->[1]] } @inflectiveC;
print direction(@mirroredXA) ? 'Clockwise' : 'Not clockwise';

my @mirroredYC = reverse map{ [$_->[0], 0 - $_->[1]] } @inflectiveC;
print direction(@mirroredXC) ? 'Clockwise' : 'Not clockwise';

my @mirroredYA = map{ [$_->[0], 0 - $_->[1]] } @inflectiveC;
print direction(@mirroredXA) ? 'Clockwise' : 'Not clockwise';
[download]

Just looking at the figure, and assigning a few points to create a similar closed figure {(0,0), (25,15), (30,20), (35,15), (30,10), (30,0)}, I think the issue you are having is because you're changing orientations as you follow the vectors around the figure. Using the numbers above, you have the following directional vectors {(25i+15j), (5i+5j), (5i-5j), (-5i-5j), (0i-10j), (-30i+0j)}. When you progress from point (35,15) to (30,10) to (30,0), you actually swing counterclockwise on the figure, before making a clockwise swing back to the start point. This would seem to be the cause of your issue.

If I recall enough from my classes in algorithms, there are algorithms from graph theory regarding directional paths and determining if they cross themselves. Sadly, I am not where I can look them up at the moment to point you to a particular one.

I hope this helps, or that other monks can either add more detail, or point out that I am incorrect and point us both in the correct direction.

You could use the routine in Re: Re: Clockwise or Counter-clockwise and solve this problem easily. It's the same algorithm as GreenTheoremTest without the extra object calls.

| ...
| ...
| ...
------
[download]

--
$you = new YOU;
honk() if $you->love(perl)