<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Triangul;

use strict;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION     = 1.00;
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw(&amp;new &amp;triangul);
%EXPORT_TAGS = ( DEFAULT =&gt; [qw(&amp;new &amp;triangul)],
                   Both    =&gt; [qw(&amp;new &amp;triangul)]);


sub triangul {
	my $pol = shift; # ref to array
	my $n	= shift; # scalar
	my $nrs = shift; # ref to Array of Hashs struct trianrs { int A, B, C }
	my $orienta = shift; # ref to sub
	my $PP	= shift; #ref to array of Vector2D to be passed or orienta

	my $j = 0;

	my @ptr = ();
	my ( $q, $qA, $qB, $qC);
	my $r = -1;
	my $collinear;
	my $polconvex = 1;


	if ( $n &lt; 3 ) { return -1; }
	if ( $n == 3 ) {
		my $rec = {};
		$rec-&gt;{A} = $pol-&gt;[0]; $rec-&gt;{B} = $pol-&gt;[1]; $rec-&gt;{C} = $pol-&gt;[2];
		push( @$nrs, $rec );
		return 1;
	}

	my @ort = (0..($n-1));
	for ( my $ortI=0; $ortI&lt;$n-1; $ortI++ ) { $ort[$ortI] = 0;}

	do {
		$collinear = 0;
		for( my $i=0; $i&lt;$n; $i++ ) {
			my $i1 = ($i &lt;($n-1) ? $i  + 1 : 0 );
			my $i2 = ($i1&lt;($n-1) ? $i1 + 1 : 0 );
			$ort[$i1] = &amp;$orienta( $pol-&gt;[$i], $pol-&gt;[$i1], $pol-&gt;[$i2], $PP );
			if ( $ort[$i1] == 0 ) {
				$collinear = 1;
				for ( $j=$i1; $j&lt;$n-1; $j++ ) { $pol-&gt;[$j] = $pol-&gt;[$j+1]; }
				$n--;
				last;
			}
			if ( $ort[$i1] &lt; 1 ) { $polconvex = 0; } 
		}

	} while ( $collinear != 0 );
	if ( $n &lt; 3 ) { return -1; }
	if ( $polconvex != 0 ) {
		for ( $j=0; $j&lt;$n-2; $j++ ) {
			my $rec = {};
			# I don't know if 0 here is a typo
			# or actually correct
			#$rec-&gt;{A} = $pol-&gt;[0];	
			$rec-&gt;{A} = $pol-&gt;[$j];	
			$rec-&gt;{B} = $pol-&gt;[$j+1];	
			$rec-&gt;{C} = $pol-&gt;[$j+2];	
			$nrs-&gt;[$j]= $rec;
			#push( @$nrs, $rec );
		}
		return $n-2;
	}
 
	for( my $i=1; $i&lt;$n; $i++ ) { $ptr[$i-1]=$i; }
	$ptr[$n-1] = 0;

	$q = 0;
	$qA = $ptr[$q];
	$qB = $ptr[$qA];
	$qC = $ptr[$qB];
	$j=0;
	for( my $m=$n; $m&gt;2; $m-- ) {
		for( my $k=0; $k&lt;$m; $k++ ) {
			# try triangle ABC
			my $ortB = $ort[$qB];
			my $ok = 0;
			# B is canidate for convex
			if ( $ortB &gt; 0 ) {
				my $A = $pol-&gt;[$qA];
				my $B = $pol-&gt;[$qB];
				my $C = $pol-&gt;[$qC];
				$ok = 1;
				$r = $ptr[$qC];
				while( $r != $qA &amp;&amp; $ok != 0 ) {
					my $P = $pol-&gt;[$r]; # ABC counter clockwise
					$ok = 	$P == $A || 
						$P == $B || 
						$P == $C ||
						&amp;$orienta( $A, $B, $P, $PP ) &lt; 0 ||
						&amp;$orienta( $B, $C, $P, $PP ) &lt; 0 ||
						&amp;$orienta( $C, $A, $P, $PP ) &lt; 0;
					if( length($ok) == 0 ) { $ok = 0;}
					$r = $ptr[$r];
				} #end while 
				# ok means: P coinciding with A, B , or C
				# or outside ABC
				if( $ok != 0 ) {
					my $rec = {};
					$rec-&gt;{A} = $pol-&gt;[$qA];
					$rec-&gt;{B} = $pol-&gt;[$qB];
					$rec-&gt;{C} = $pol-&gt;[$qC];
					# push might be better
					#push( @$nrs, $rec );
					$nrs-&gt;[$j] = $rec;
					$j++;
				} 
			} # end if ortB
			if ( ($ok != 0 ) || ($ortB == 0) ) {
				$ptr[$qA] = $qC;
				$qB = $qC;
				$qC = $ptr[$qC];
				if( $ort[$qA] &lt; 1 ) {
					$ort[$qA] = &amp;$orienta( $pol-&gt;[$q], $pol-&gt;[$qA], $pol-&gt;[$qB], $PP);
				}
				if( $ort[$qB] &lt; 1 ) {
					$ort[$qB] = &amp;$orienta( $pol-&gt;[$qA], $pol-&gt;[$qB], $pol-&gt;[$qC], $PP);
				}
				while( ($ort[$qA] == 0) &amp;&amp; ($m &gt; 2) ) {
					$ptr[$q] = $qB;
					$qA = $qB;
					$qB = $qC;
					$qC = $ptr[$qC];
					$m--;
				}
				while( ($ort[$qB]) == 0 &amp;&amp; ($m &gt; 2) ) {
					$ptr[$qA] = $qC;
					$qB = $qC;
					$qC = $ptr[$qC];
					$m--;
				}
				last;
			} #end if ok or ortB
			$q = $qA;
			$qA = $qB;
			$qB = $qC;
			$qC = $ptr[$qC];
		} # end for k
	} # end for m
	return $j;
} #end sub triangul

1;
</pre></body></html>