Graphics-Penplotter-GcodeXY
view release on metacpan or search on metacpan
See [Graphics::Penplotter::GcodeXY::Anamorphic](https://metacpan.org/pod/Graphics%3A%3APenplotter%3A%3AGcodeXY%3A%3AAnamorphic) for the full description
of the physical model and image coordinate convention.
- anamorphic($cx, $cy, $R \[, %opts\])
Replace the current segment path with its anamorphic distortion for a
cylindrical mirror of radius `$R` centred at `($cx, $cy)`, then flush the
path via `stroke`.
The intended image is whatever is already in the segment path when this method
is called. The bounding box of the existing drawable segment endpoints is
used as the image extent. Each endpoint is independently projected onto the
paper via the cylindrical mirror model; segments whose endpoints cannot be
projected are dropped, and path continuity is maintained automatically.
The `$cx`, `$cy`, `$R`, and observer parameters must be expressed in the
same coordinate space as the segment path (device coordinates as used
internally by GcodeXY). For typical plots with no active transform this is
equivalent to the drawing unit.
Options:
- `obs_dist` (default 5\*R)
lib/Graphics/Penplotter/GcodeXY.pm view on Meta::CPAN
return 1;
}
#
# Warn if the pen ends up outside the page boundary
# We need DEVICE coordinates here for obvious reasons
#
sub _warn ($self, $x, $y) {
my ( $x0clip, $y0clip, $x1clip, $y1clip, $info );
if ( !$self->{warn} ) { return 0 }
# we check only the endpoint for now.
# just assume the line started at (0.1, 0.1)
if ( ( $x < 0 ) || ( $y < 0 ) ) {
print STDOUT "Out of bound: ($x,$y)" . $EOL;
return 0;
}
( $x0clip, $y0clip, $x1clip, $y1clip, $info ) =
$self->_LiangBarsky( 0, 0, $self->{xsize}, $self->{ysize}, 0.1, 0.1, $x, $y );
if ( $info != 1 ) {
print STDOUT "Out of bound: ($x,$y)" . $EOL;
}
lib/Graphics/Penplotter/GcodeXY.pm view on Meta::CPAN
=over 4
=item anamorphic($cx, $cy, $R [, %opts])
Replace the current segment path with its anamorphic distortion for a
cylindrical mirror of radius C<$R> centred at C<($cx, $cy)>, then flush the
path via C<stroke>.
The intended image is whatever is already in the segment path when this method
is called. The bounding box of the existing drawable segment endpoints is
used as the image extent. Each endpoint is independently projected onto the
paper via the cylindrical mirror model; segments whose endpoints cannot be
projected are dropped, and path continuity is maintained automatically.
The C<$cx>, C<$cy>, C<$R>, and observer parameters must be expressed in the
same coordinate space as the segment path (device coordinates as used
internally by GcodeXY). For typical plots with no active transform this is
equivalent to the drawing unit.
Options:
=over 4
lib/Graphics/Penplotter/GcodeXY/Anamorphic.pm view on Meta::CPAN
return () if $t_paper < 0;
my $px = $mx + $t_paper * $rx;
my $py = $my + $t_paper * $ry;
return ($px, $py);
}
# ---------------------------------------------------------------------------
# _ana_resample_segment
#
# Given endpoints (x0,y0) and (x1,y1) in image space, return a list of
# [ x, y ] sample-point arrayrefs spaced at most $step apart. The start
# point is NOT included (the caller holds it); the end point IS included.
# ---------------------------------------------------------------------------
sub _ana_resample_segment {
my ($x0, $y0, $x1, $y1, $step) = @_;
my $ddx = $x1 - $x0;
my $ddy = $y1 - $y0;
my $dist = sqrt($ddx*$ddx + $ddy*$ddy);
if ($dist < 1e-12) { return ([$x1, $y1]) }
my $n = ceil($dist / $step);
lib/Graphics/Penplotter/GcodeXY/Anamorphic.pm view on Meta::CPAN
# the transformed segments back into psegments, then calls stroke() to flush.
# ---------------------------------------------------------------------------
sub anamorphic {
my ($self, $cx, $cy, $R, %opts) = @_;
$self->_croak('anamorphic: cylinder radius R must be > 0') unless $R > 0;
my $step = delete $opts{step} // 1.0;
# ------------------------------------------------------------------
# Collect all drawable segment endpoints and compute the image bbox.
# ------------------------------------------------------------------
my @segs = @{ $self->{psegments} };
my (@xs, @ys);
for my $s (@segs) {
my $k = $s->{key} // '';
next unless $k eq 'm' || $k eq 'l';
push @xs, $s->{sx}, $s->{dx};
push @ys, $s->{sy}, $s->{dy};
}
lib/Graphics/Penplotter/GcodeXY/Geometry2D.pm view on Meta::CPAN
my $d = $a*$a + $b*$b;
my $cp = $a*$py - $b*$px;
if ( $d != 0.0 ) {
$x = ( -$a*$c - $b*$cp ) / $d;
$y = ( $a*$cp - $b*$c ) / $d;
}
return ( $x, $y );
}
# Compute a circular arc fillet between lines L1 (p1..p2) and L2 (p3..p4) with radius $r.
# Returns the 8 clipped endpoint coordinates plus the arc centre and angle, or undef on failure.
# Miller, "Joining Two Lines with a Circular Arc Fillet," Graphics Gems III.
sub _fillet ($self, $p1x, $p1y, $p2x, $p2y, $p3x, $p3y, $p4x, $p4y, $r) {
my ( $a1, $b1, $c1, $a2, $b2, $c2, $c1p, $c2p, $d1, $d2, $xa, $xb, $ya, $yb, $d, $rr );
my ( $mpx, $mpy, $pcx, $pcy, $gv1x, $gv1y, $gv2x, $gv2y, $xc, $yc, $pa, $aa );
( $a1, $b1, $c1 ) = $self->_linecoefs( $p1x, $p1y, $p2x, $p2y );
( $a2, $b2, $c2 ) = $self->_linecoefs( $p3x, $p3y, $p4x, $p4y );
if ( ( $a1 * $b2 ) == ( $a2 * $b1 ) ) { return (undef) } # parallel or coincident
$mpx = ( $p3x + $p4x ) / 2.0;
$mpy = ( $p3y + $p4y ) / 2.0;
$d1 = $self->_linetopoint( $a1, $b1, $c1, $mpx, $mpy );
lib/Graphics/Penplotter/GcodeXY/Geometry2D.pm view on Meta::CPAN
# Clip a line segment to an axis-aligned rectangle.
#
# ($x1,$y1,$x2,$y2,$info) =
# $obj->_LiangBarsky($botx,$boty,$topx,$topy, $x0src,$y0src,$x1src,$y1src);
#
# $info values:
# 1 entire segment inside boundary
# 2 entirely outside (returns -1,-1,-1,-1,2)
# 3 start inside, end clipped
# 4 end inside, start clipped
# 5 both endpoints outside but interior intersects
#
# Algorithm by Daniel White (skytopia.com), bug-fixed and translated to Perl.
sub _LiangBarsky ($self, $botx, $boty, $topx, $topy, $x0src, $y0src, $x1src, $y1src) {
my $t0 = 0.0;
my $t1 = 1.0;
my $xdelta = $x1src - $x0src;
my $ydelta = $y1src - $y0src;
my ( $p, $q, $r );
my $info = 0;
foreach my $edge ( 0 .. 3 ) {
lib/Graphics/Penplotter/GcodeXY/Hatch.pm view on Meta::CPAN
# ===========================================================================
# INTERNAL: SCANLINE FILL
# ===========================================================================
# Generate hatch-fill segments for the current path by scanline intersection.
# Works in device coordinates. Graphics state is saved and restored.
#
# When hatchangle is non-zero the algorithm works in a rotated "hatch space"
# where the scanlines are always horizontal:
#
# 1. All psegment endpoints are rotated by -hatchangle into hatch space.
# 2. The bbox, scanline sweep, intersection tests, and deduplication all
# run unchanged on the rotated copy (stored temporarily in psegments).
# 3. Before recording each hatch segment, its endpoints are rotated back
# by +hatchangle into drawing space.
# 4. The original psegments are restored before flushing.
#
# This keeps every helper (_get_bbox, _identical, _sameside, _getsegintersect)
# completely unaware of the angle — they always see horizontal scanlines.
sub _dohatching ($self) {
my ( $xmind, $ymind, $xmaxd, $ymaxd );
my ( @crossings, @csorted );
my $perc = 0;
# Normalise to [0, 180): hatch lines at θ and θ+180° are identical.
lib/Graphics/Penplotter/GcodeXY/Hatch.pm view on Meta::CPAN
$self->_flushHsegments();
$self->grestore();
return 1;
}
# ===========================================================================
# INTERNAL: SCANLINE GEOMETRY HELPERS
# ===========================================================================
# True if seg1 and seg2 are the same segment (possibly with endpoints reversed).
sub _identical ($self, $seg1, $seg2) {
my %h1 = %{ $self->{psegments}[$seg1] };
my %h2 = %{ $self->{psegments}[$seg2] };
my ( $ax, $ay, $bx, $by ) = ( $h1{sx}, $h1{sy}, $h1{dx}, $h1{dy} );
my ( $cx, $cy, $dx, $dy ) = ( $h2{sx}, $h2{sy}, $h2{dx}, $h2{dy} );
return 1 if $ax == $dx && $ay == $dy && $cx == $bx && $cy == $by;
return 1 if $ax == $cx && $ay == $cy && $bx == $dx && $by == $dy;
return 0;
}
# True (1) if seg1 and seg2 share a vertex on the hatch line $y and their
# other endpoints are both on the same side of it.
# Returns -1 if the shared vertex cannot be determined.
sub _sameside ($self, $y, $seg1, $seg2) {
my %h1 = %{ $self->{psegments}[$seg1] };
my %h2 = %{ $self->{psegments}[$seg2] };
my ( $ay, $by ) = ( $h1{sy}, $h1{dy} );
my ( $cy, $dy ) = ( $h2{sy}, $h2{dy} );
my ( $y1, $y2 );
if ( $ay == $y ) { $y1 = $by }
elsif ( $by == $y ) { $y1 = $ay }
else {
lib/Graphics/Penplotter/GcodeXY/Hatch.pm view on Meta::CPAN
=head2 Algorithm
C<_dohatching> works in a rotated I<hatch space> where the scanlines are
always horizontal, regardless of the requested C<hatchangle>:
=over 4
=item 1.
All C<psegments> endpoints are rotated by B<-hatchangle> into hatch space
and stored in a temporary array, which is swapped into C<$self-E<gt>{psegments}>.
=item 2.
The bounding box, scanline sweep, intersection tests (C<_getsegintersect>),
and vertex deduplication (C<_identical>, C<_sameside>) all run unchanged on
the rotated copy, they always see horizontal scanlines and need no
modification.
=item 3.
Before each hatch segment is recorded via C<_addhsegmentpath>, its
endpoints are rotated back by B<+hatchangle> into drawing space.
=item 4.
The original C<psegments> are restored before C<_flushHsegments> writes
the gcode.
=back
=head1 METHODS
lib/Graphics/Penplotter/GcodeXY/Split.pm view on Meta::CPAN
}
else { # G01
$f->do_penup() if $penstate == $PENDOWN;
$f->_addfastmove( $x1, $y1 );
$f->do_pendown();
$f->_addslowmove( $x2, $y2 );
}
$location = $IN;
}
elsif ( $info == 5 ) {
# Both endpoints outside but crossing through
if ( $op == $G01 ) {
$f->do_penup() if $penstate == $PENDOWN;
$f->_addfastmove( $x1, $y1 );
$f->do_pendown();
$f->_addslowmove( $x2, $y2 );
}
# G00 entirely outside: ignore
$location = $OUT;
}
}
# ---------------------------------------------------------------------------
note('--- line element ---');
{
my ($g, $err) = do_import(
q{<line x1='1in' y1='2in' x2='3in' y2='4in'/>}
);
ok( !$err, 'line: no import error' );
my @d = draw_moves($g);
ok( @d >= 1, 'line: at least one draw move' );
ok( has_move_near(\@d, 3, 4), 'line: endpoint (3in,4in) reached' );
my @f = fast_moves($g);
ok( has_move_near(\@f, 1, 2), 'line: startpoint (1in,2in) is a fast move' );
}
note('--- rect element ---');
{
my ($g, $err) = do_import(
q{<rect x='1in' y='2in' width='3in' height='2in'/>}
);
ok( !$err, 'rect: no import error' );
}
note('--- circle element ---');
{
my ($g, $err) = do_import(
q{<circle cx='3in' cy='3in' r='2in'/>}
);
ok( !$err, 'circle: no import error' );
my @d = draw_moves($g);
ok( @d > 4, 'circle: multiple draw moves' );
# All draw endpoints must lie within r+epsilon of centre
my $ok = 1;
for my $m (@d) {
my $dist = sqrt(($m->{x}-3)**2 + ($m->{y}-3)**2);
$ok = 0 if $dist > 2.05;
}
ok( $ok, 'circle: all draw moves within radius of centre' );
}
note('--- ellipse element ---');
{
}
note('--- path cubic bezier C ---');
{
my ($g, $err) = do_import(
q{<path d='M 0in 0in C 0in 1in 2in 1in 2in 0in'/>}
);
ok( !$err, 'path C: no import error' );
my @d = draw_moves($g);
ok( @d > 2, 'path C: bezier approximated by multiple segments' );
ok( has_move_near(\@d, 2, 0), 'path C: endpoint reached' );
}
note('--- path arc A ---');
{
# A semicircle of radius 1in from (0,0) to (2,0)
my ($g, $err) = do_import(
q{<path d='M 0in 0in A 1in 1in 0 0 1 2in 0in'/>}
);
ok( !$err, 'path A: no import error' );
my @d = draw_moves($g);
ok( @d > 2, 'path A: arc approximated by multiple segments' );
ok( has_move_near(\@d, 2, 0), 'path A: arc endpoint reached' );
}
# ---------------------------------------------------------------------------
# SECTION 3 -- Transforms
# ---------------------------------------------------------------------------
note('--- translate transform ---');
{
# Line from (0,0) to (1,0), group translated by (2,3)
# -> expected draw move at (3,3)
my ($g, $err) = do_import(
q{<g transform='translate(2in,3in)'>
<line x1='0' y1='0' x2='1in' y2='0'/>
</g>}
);
ok( !$err, 'translate: no import error' );
my @d = draw_moves($g);
ok( has_move_near(\@d, 3, 3), 'translate: endpoint shifted correctly' );
}
note('--- scale transform ---');
{
# Line to (1in,1in), group scaled by 2 -> endpoint at (2,2)
my ($g, $err) = do_import(
q{<g transform='scale(2)'>
<line x1='0' y1='0' x2='1in' y2='1in'/>
</g>}
);
ok( !$err, 'scale: no import error' );
my @d = draw_moves($g);
ok( has_move_near(\@d, 2, 2), 'scale: endpoint doubled' );
}
note('--- non-uniform scale transform ---');
{
my ($g, $err) = do_import(
q{<g transform='scale(2,3)'>
<line x1='0' y1='0' x2='1in' y2='1in'/>
</g>}
);
ok( !$err, 'scale(sx,sy): no import error' );
my @d = draw_moves($g);
ok( has_move_near(\@d, 2, 3), 'scale(2,3): x and y scaled independently' );
}
note('--- rotate transform (1-arg) ---');
{
# Line along +x axis to (2in,0), rotated 90deg -> endpoint near (0,2)
my ($g, $err) = do_import(
q{<g transform='rotate(90)'>
<line x1='0' y1='0' x2='2in' y2='0'/>
</g>}
);
ok( !$err, 'rotate(90): no import error' );
my @d = draw_moves($g);
ok( has_move_near(\@d, 0, 2), 'rotate(90): x-axis line maps to y-axis' );
}
note('--- rotate transform (3-arg, rotate around point) ---');
{
# Line from (3in,1in) to (3in,3in), rotated 90 around (3in,1in)
# -> endpoint (3+2, 1+0) = (5,1)
my ($g, $err) = do_import(
q{<g transform='rotate(90, 3in, 1in)'>
<line x1='3in' y1='1in' x2='3in' y2='3in'/>
</g>}
);
ok( !$err, 'rotate(a,cx,cy): no import error' );
my @d = draw_moves($g);
# SVG rotate(90, cx, cy) = translate(cx,cy) . rotate(90) . translate(-cx,-cy)
# Vector from (3,1) to (3,3) is (0,2) [downward in SVG y-down space].
# SVG positive rotation is CW in y-down: downward -> leftward -> (-2,0).
# New endpoint: (3,1) + (-2,0) = (1,1).
ok( has_move_near(\@d, 1, 1), 'rotate(90,3,1): rotated endpoint correct' );
}
note('--- skewX transform ---');
{
my ($g, $err) = do_import(
q{<g transform='skewX(45)'>
<line x1='0' y1='0' x2='0' y2='1in'/>
</g>}
);
ok( !$err, 'skewX: no import error' );
{
# matrix(a,b,c,d,e,f): SVG column-major
# matrix(1,0,0,1,2in,3in) is a pure translate by (2,3)
my ($g, $err) = do_import(
q{<g transform='matrix(1,0,0,1,2in,3in)'>
<line x1='0' y1='0' x2='1in' y2='1in'/>
</g>}
);
ok( !$err, 'matrix: no import error' );
my @d = draw_moves($g);
ok( has_move_near(\@d, 3, 4), 'matrix translate: endpoint at (3,4)' );
}
note('--- chained transforms ---');
{
# translate(1in,0) then scale(2): point (1in,0) -> scale(1,0)=(2,0) + translate=(3,0)
# Actually transforms compose right-to-left in SVG; 'translate scale' means
# scale first, then translate.
my ($g, $err) = do_import(
q{<g transform='translate(1in,0) scale(2)'>
<line x1='0' y1='0' x2='1in' y2='0'/>
my ($g, $err) = do_import( <<'SVG' );
<defs>
<symbol id='mysym'>
<line x1='0' y1='0' x2='2in' y2='0'/>
</symbol>
</defs>
<use href='#mysym' x='1in' y='2in'/>
SVG
ok( !$err, 'symbol/use: no import error' );
my @d = draw_moves($g);
# symbol contents at (1,2) offset: line endpoint at (3,2)
ok( has_move_near(\@d, 3, 2), 'symbol/use: symbol contents rendered at offset' );
}
note('--- <symbol> is not rendered directly ---');
{
my ($g, $err) = do_import( <<'SVG' );
<symbol id='s'>
<line x1='0' y1='0' x2='5in' y2='0'/>
</symbol>
SVG
{
my ($g, $err) = do_import(
q{<g transform='translate(1in,0)'>
<g transform='translate(0,1in)'>
<line x1='0' y1='0' x2='1in' y2='0'/>
</g>
</g>}
);
ok( !$err, 'nested groups: no import error' );
my @d = draw_moves($g);
# endpoint (1,0) after nested translate(1,0)+translate(0,1) -> (2,1)
ok( has_move_near(\@d, 2, 1), 'nested groups: transforms compose' );
}
note('--- <a> element treated as passthrough group ---');
{
my ($g, $err) = do_import(
q{<a href='http://example.com'>
<line x1='0' y1='0' x2='2in' y2='0'/>
</a>}
);
note('--- multiple root-level shapes ---');
{
my ($g, $err) = do_import(
q{<line x1='0' y1='0' x2='1in' y2='0'/>
<line x1='0' y1='1in' x2='2in' y2='1in'/>
<line x1='0' y1='2in' x2='3in' y2='2in'/>}
);
ok( !$err, 'multiple shapes: no import error' );
my @d = draw_moves($g);
ok( has_move_near(\@d, 1, 0), 'multiple shapes: first line endpoint' );
ok( has_move_near(\@d, 2, 1), 'multiple shapes: second line endpoint' );
ok( has_move_near(\@d, 3, 2), 'multiple shapes: third line endpoint' );
}
note('--- zero-dimension shapes do not crash ---');
{
my ($g, $err) = do_import(
q{<rect x='1in' y='1in' width='0' height='0'/>
<circle cx='1in' cy='1in' r='0'/>
<ellipse cx='1in' cy='1in' rx='0' ry='0'/>}
);
ok( !$err, 'zero-dimension shapes: no crash' );
t/14-hatch.t view on Meta::CPAN
# Each travel move should position to the start of the following hatch line
{
my $g = new_g( hatchsep => 0.5, hatchangle => 0 );
draw_square($g);
$g->_dohatching();
my @segs = @{ $g->{hsegments} };
my $pairs = 0;
for my $i ( 0 .. $#segs - 1 ) {
if ( $segs[$i]{key} eq 'm' && $segs[ $i + 1 ]{key} eq 'l' ) {
# Travel endpoint should be the start of the hatch line
ok( near( $segs[$i]{dx}, $segs[ $i + 1 ]{sx} ) &&
near( $segs[$i]{dy}, $segs[ $i + 1 ]{sy} ),
"angle=0: travel[$i] endpoint = hatch[${\($i+1)}] start" );
$pairs++;
}
}
ok( $pairs > 0, 'angle=0: found at least one travel+hatch pair' );
}
# ===========================================================================
# 8. Vertical hatch geometry (angle = 90)
# ===========================================================================
# ==========================================================================
#
# Tests target three distinct fixes in occlusion_clip / hidden_line_remove:
#
# 1. Coplanar diagonal suppression
# Each quad face of prism() is tessellated into 2 triangles. The shared
# edge (the "diagonal") must be suppressed so cube faces appear as
# rectangles, not as two triangles.
#
# 2. Shared-reference aliasing fix
# Before the fix, multiple segment endpoints held the *same* [$x,$y]
# arrayref. An in-place viewport transform (e.g. $pt->[0] *= SCALE)
# then compounded the scale factor once per alias, producing astronomical
# coordinates. After the fix every endpoint is an independent copy.
#
# 3. Occluder support
# hidden_line_remove accepts occluders => \@meshes. Those meshes
# populate the z-buffer in a first pass so that target triangles behind
# them fail the depth test and are omitted.
{
# Helper: set up a plotter with a straight-on perspective camera.
# Eye at (0,0,-100), looking at origin, FOV=45.
my sub make_straight ($fov=45) {
# Without diagonal suppression each face would emit 5 edges -> 15 - 3 = 12
# (minus shared genuine edges), an incorrect higher count.
{
my $p = make_corner();
my $m = $p->prism(0,0,0, 20,20,20);
my $segs = $p->hidden_line_remove($m);
is scalar @$segs, 9,
'diagonal suppression: corner view, 3 faces visible -> 9 unique edges';
}
# --- 2. Aliasing fix: no two segment endpoints share the same arrayref ---
{
my $p = make_corner();
my $m = $p->prism(0,0,0, 20,20,20);
my $segs = $p->hidden_line_remove($m);
my %seen_ref;
my $aliases = 0;
for my $seg (@$segs) {
for my $pt (@$seg) {
$aliases++ if $seen_ref{"$pt"}++;
}
}
is $aliases, 0,
'aliasing fix: no segment endpoints share the same arrayref';
}
# Confirm coordinates are finite and in a sane range for NDC space.
{
my $p = make_straight();
my $m = $p->prism(0,0,0, 20,20,20);
my $segs = $p->hidden_line_remove($m);
my $ok = 1;
for my $seg (@$segs) {
for my $pt (@$seg) {
# trigger naturally, but we at least confirm return-type consistency.
my @result = ana('_ana_transform_point', 50, 50, 0,0,100,100, %cfg);
ok scalar(@result) == 0 || scalar(@result) == 2,
'transform: return is always 0 or 2 values';
}
# ==========================================================================
# SECTION 5: _ana_resample_segment
# ==========================================================================
{
# Trivial: identical points returns the endpoint
my @r0 = ana('_ana_resample_segment', 5,5, 5,5, 1.0);
is scalar @r0, 1, 'resample: zero-length returns 1 point';
ok abs($r0[0][0] - 5) < 1e-9, 'resample: zero-length point x=5';
# Segment (0,0)-(10,0) step=3: ceil(10/3)=4 intervals => 4 points
my @r1 = ana('_ana_resample_segment', 0,0, 10,0, 3);
is scalar @r1, 4, 'resample: 10/step=3 gives 4 pts';
ok abs($r1[-1][0] - 10) < 1e-9, 'resample: last point is endpoint';
ok abs($r1[0][0] - 2.5) < 1e-9, 'resample: first sample at 10/4=2.5';
# Step larger than segment => 1 point (just the endpoint)
my @r2 = ana('_ana_resample_segment', 0,0, 3,4, 100);
is scalar @r2, 1, 'resample: step>length gives 1 point';
ok abs($r2[0][0] - 3) < 1e-9, 'resample: endpoint x=3';
ok abs($r2[0][1] - 4) < 1e-9, 'resample: endpoint y=4';
# Diagonal: length=5, step=1 => 5 points, all on the line y=x*(4/3)
my @r3 = ana('_ana_resample_segment', 0,0, 3,4, 1);
is scalar @r3, 5, 'resample: diagonal 5 pts at step=1';
for my $pt (@r3) {
# Each point should satisfy y = (4/3)*x (the line from (0,0) to (3,4))
my $expected_y = ($pt->[0] / 3.0) * 4.0;
ok abs($pt->[1] - $expected_y) < 1e-9,
'resample: diagonal pt on line';
}
( run in 0.496 second using v1.01-cache-2.11-cpan-0c5ce583b80 )