File Coverage

blib/lib/Math/JSpline.pm

Criterion	Covered	Total	%
statement	9	54	16.6
branch	0	22	0.0
condition	0	15	0.0
subroutine	3	4	75.0
pod	0	1	0.0
total	12	96	12.5

package Math::JSpline;

use 5.010001;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Math::JSpline ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	JSpline
);

our $VERSION = '0.02';



# Do a J-Spline, with facility to handle ending points properly as well (or do loops too)
sub JSpline { # link=0 (join), 1 (simple clamp), 2 (tangent clamp), or 3 (loop)
  my ($sl,$a,$b,$link,@pts)=@_;	# sl usually ~ 5.  a=b=1 for b-spline, a=b=0 for 4-point subdiv, etc
  my @ret;

  foreach my $px(@pts) {

    my(@x)=@{$px}; 	# Where the spline gets built

    my $k = 0;
    while ( $k++ < $sl ) {

      if($link==1) {	# simple clamping	0Pn = 20Pn–1 – 0Pn–2 and 0Pn+1 = 20Pn–1 – 0Pn–3.
        push(@x,$x[$#x]*2-$x[$#x-1]);		# 0P–1 = 20P0 – 0P1 and 0P–2 = 20P0 – 0P2.
        push(@x,$x[$#x-1]*2-$x[$#x-3]);
        my $px1=$x[0]*2-$x[1];		# 0Pn = 20Pn–1 – 0Pn–2 and 0Pn+1 = 20Pn–1 – 0Pn–3.
        my $px2=$x[0]*2-$x[2];
        @x=($px2,$px1,@x);


      } elsif($link==2) { # tangent preservation	0P–1 = (9–s)/4 0P0 + (s–3)/2 0P1 + (1–s)/4 0P2 and 0P–2 = (12–s)/2 0P0 + (s–8) 0P1 + (6–s)/2 0P2
        my $px1=(9-$a)/4  * $x[0] + ($a-3)/2 * $x[1] + (1-$a)/4 * $x[2];
        my $px2=(12-$a)/2 * $x[0] + ($a-8)   * $x[1] + (6-$a)/2 * $x[2];
        @x=($px2,$px1,@x);
        $px1=(9-$a)/4  * $x[$#x] + ($a-3)/2 * $x[$#x-1] + (1-$a)/4 * $x[$#x-2];
        $px2=(12-$a)/2 * $x[$#x] + ($a-8)   * $x[$#x-1] + (6-$a)/2 * $x[$#x-2];
        push @x,$px1; push @x,$px2;
      }

      my $j = 0; my (@tx,$ptx);
      while ( $j <= $#x ) {
        last if(($j==$#x)&&($link!=3));
        if (( $j == 0 ) && ($link!=3)){    	# Anchor start of output line to the start point
          push( @tx, $x[$j] );
        }

        elsif(( $j + 1 <= $#x )||($link==3)) {    #
	  if($link==3) {
            $ptx = ( $a * $x[( $j - 1 )%($#x+1)] + ( 8 - 2 * $a ) * $x[$j] + $a * $x[( $j + 1 )%($#x+1)] ) / 8;
	  } else {
            $ptx = ( $a * $x[ $j - 1 ] + ( 8 - 2 * $a ) * $x[$j] + $a * $x[ $j + 1 ] ) / 8;
	  }
          push( @tx, $ptx );
        }

        if (($link==3)||( $j + 2 <= $#x && $j > 0)) {
          my ( $ptx );
	  if($link==3) {
            $ptx = ( ( $b - 1 ) * $x[($j -1)%($#x+1)] + ( 9 - $b ) * $x[ $j ] + ( 9 - $b ) * $x[( $j + 1 )%($#x+1)] + ( $b - 1 ) * $x[( $j + 2 )%($#x+1)] ) / 16;
          } else {
            $ptx = ( ( $b - 1 ) * $x[$j -1] + ( 9 - $b ) * $x[ $j ] + ( 9 - $b ) * $x[ $j + 1 ] + ( $b - 1 ) * $x[ $j + 2 ] ) / 16;
	  }
          push( @tx, $ptx );
        }
        $j++;
      }


      if($link==3) {
        # skip push
      } elsif($link>0) {
        @tx=@tx[3..$#tx-2];
      } else {
        push( @tx, $x[$#x] );
      }

      @x=@tx;
    }
    if($link==3) {
      push @x,$x[0]; #join end to start for drawing
    }
    push @ret,\@x;
  }
  return @ret;
} # jsplinexyl


# Preloaded methods go here.

1;
__END__