Graphics-Penplotter-GcodeXY
view release on metacpan or search on metacpan
Spiral direction. `0` (`$SWIRL_CW`) gives a clockwise whirl; `1`
(`$SWIRL_CCW`) gives a counter-clockwise whirl.
- `draw => \@bool` (optional, default all `1`)
A reference to an array of boolean flags, one per edge, that controls whether
each edge of every nested polygon is drawn. Setting some flags to false can
produce striking visual effects.
- `iterations => $n` (optional)
Draw exactly `$n` nested polygons (not counting the base polygon). When
given, this takes precedence over `min_size`.
- `min_size => $pct` (optional, default `1.0`)
Stop iterating once the length of the first edge of the current polygon has
shrunk to `$pct` percent of the original first-edge length. Ignored when
`iterations` is also given.
Returns `1` on success. Croaks on invalid input.
## Swirl package variables
- `$Graphics::Penplotter::GcodeXY::Swirl::SWIRL_CW`
Constant `0` - clockwise direction (the default).
- `$Graphics::Penplotter::GcodeXY::Swirl::SWIRL_CCW`
lib/Graphics/Penplotter/GcodeXY.pm view on Meta::CPAN
Spiral direction. C<0> (C<$SWIRL_CW>) gives a clockwise whirl; C<1>
(C<$SWIRL_CCW>) gives a counter-clockwise whirl.
=item C<draw =E<gt> \@bool> (optional, default all C<1>)
A reference to an array of boolean flags, one per edge, that controls whether
each edge of every nested polygon is drawn. Setting some flags to false can
produce striking visual effects.
=item C<iterations =E<gt> $n> (optional)
Draw exactly C<$n> nested polygons (not counting the base polygon). When
given, this takes precedence over C<min_size>.
=item C<min_size =E<gt> $pct> (optional, default C<1.0>)
Stop iterating once the length of the first edge of the current polygon has
shrunk to C<$pct> percent of the original first-edge length. Ignored when
C<iterations> is also given.
=back
Returns C<1> on success. Croaks on invalid input.
=back
=head2 Swirl package variables
=over 4
lib/Graphics/Penplotter/GcodeXY/Swirl.pm view on Meta::CPAN
# ===========================================================================
# PUBLIC API
# ===========================================================================
=for comment
swirl( points => \@pts, # flat [x0,y0, x1,y1, ...] array (compulsory)
d => \@d, # per-edge advance percentages (compulsory)
direction => 0|1, # 0=CW (default), 1=CCW
draw => \@bool, # per-edge draw flags (default: all 1)
iterations => $n, # stop after $n nested polygons (highest precedence)
min_size => $pct, # stop when first edge shrinks to $pct% of original
)
=cut
sub swirl ($self, %args) {
# -----------------------------------------------------------------------
# 1. Required parameters
# -----------------------------------------------------------------------
my $pts_ref = $args{points}
or $self->_croak('swirl: "points" is required');
my $d_ref = $args{d}
or $self->_croak('swirl: "d" (per-edge percentages) is required');
# -----------------------------------------------------------------------
# 2. Optional parameters with defaults
# -----------------------------------------------------------------------
my $direction = $args{direction} // $SWIRL_CW;
my $draw_ref = $args{draw};
my $iterations = $args{iterations}; # undef → use size-based termination
my $min_size = $args{min_size} // 1.0; # percent of original first-edge length
# -----------------------------------------------------------------------
# 3. Validate inputs
# -----------------------------------------------------------------------
my @pts = @{$pts_ref};
my @d = @{$d_ref};
$self->_croak('swirl: "points" must contain an even number of elements (x,y pairs)')
if @pts % 2;
lib/Graphics/Penplotter/GcodeXY/Swirl.pm view on Meta::CPAN
# 6. Termination threshold (size-based)
# -----------------------------------------------------------------------
my $orig_edge_len = _edge_len( $verts[0], $verts[1] );
# Avoid division-by-zero for degenerate polygons
my $threshold = $orig_edge_len > 0
? $orig_edge_len * $min_size / 100.0
: 0;
# Guard against a zero (or near-zero) threshold that would cause a
# near-infinite loop when min_size => 0. Clamp to a relative epsilon
# of 1e-9 so the loop always terminates within a reasonable number of
# iterations (the polygon simply converges to numerical noise).
if ( $orig_edge_len > 0 && $threshold < $orig_edge_len * 1e-9 ) {
$threshold = $orig_edge_len * 1e-9;
}
# -----------------------------------------------------------------------
# 7. Draw the base (outermost) polygon
# -----------------------------------------------------------------------
$self->_swirl_draw_poly( \@verts, \@draw );
# -----------------------------------------------------------------------
# 8. Iterate inward
# -----------------------------------------------------------------------
my $iter = 0;
ITERATE: while (1) {
# Fixed-iteration termination (highest precedence)
last ITERATE if defined $iterations && $iter >= $iterations;
# Compute next ring of vertices
my @new_verts;
for my $i ( 0 .. $n - 1 ) {
my $j = ( $i + 1 ) % $n;
if ( $direction == $SWIRL_CW ) {
# CW: new vertex i moves fraction df[i] from verts[i] toward verts[j]
push @new_verts, [
$verts[$i][0] + $df[$i] * ( $verts[$j][0] - $verts[$i][0] ),
$verts[$i][1] + $df[$i] * ( $verts[$j][1] - $verts[$i][1] ),
lib/Graphics/Penplotter/GcodeXY/Swirl.pm view on Meta::CPAN
push @new_verts, [
$verts[$j][0] + $df[$i] * ( $verts[$i][0] - $verts[$j][0] ),
$verts[$j][1] + $df[$i] * ( $verts[$i][1] - $verts[$j][1] ),
];
}
}
$iter++;
@verts = @new_verts;
# Size-based termination (only when iterations not fixed)
unless ( defined $iterations ) {
last ITERATE if $orig_edge_len == 0;
my $cur_edge_len = _edge_len( $verts[0], $verts[1] );
last ITERATE if $cur_edge_len <= $threshold;
}
# Draw this ring
$self->_swirl_draw_poly( \@verts, \@draw );
}
return 1;
lib/Graphics/Penplotter/GcodeXY/Swirl.pm view on Meta::CPAN
Graphics::Penplotter::GcodeXY::Swirl - Whirl (pursuit-curve) polygon generation for GcodeXY
=head1 SYNOPSIS
use Graphics::Penplotter::GcodeXY;
my $g = Graphics::Penplotter::GcodeXY->new(
xsize => 200, ysize => 200, units => 'mm',
);
# Simple square whirl, 100 iterations, 20% advance per edge
$g->swirl(
points => [ 10,10, 190,10, 190,190, 10,190 ],
d => [ 20, 20, 20, 20 ],
iterations => 100,
);
# Triangular whirl, varying d, stops when first edge reaches 1% of original
$g->swirl(
points => [ 100,10, 190,170, 10,170 ],
d => [ 15, 25, 10 ],
min_size => 1,
);
# Counter-clockwise hexagonal whirl, two edges suppressed for visual effect
lib/Graphics/Penplotter/GcodeXY/Swirl.pm view on Meta::CPAN
after each iteration. The base polygon is always drawn first.
=head1 TERMINATION
Iteration stops when the first condition that has been configured is met:
=over 4
=item 1.
B<Fixed iteration count> (C<iterations =E<gt> $n>): exactly C<$n> nested
polygons are drawn inside the base (highest precedence).
=item 2.
B<Size threshold> (C<min_size =E<gt> $pct>): iteration stops when the length of
the first edge of the current polygon falls to or below C<$pct> percent of the
corresponding edge of the base polygon. The default is C<1.0> (one percent).
=back
lib/Graphics/Penplotter/GcodeXY/Swirl.pm view on Meta::CPAN
(C<$SWIRL_CCW>) gives a counter-clockwise whirl.
=item C<draw =E<gt> \@bool> (optional, default all C<1>)
A reference to an array of boolean flags, one per edge, that controls whether
each edge of every nested polygon is drawn. When all flags are true the
implementation uses C<polygon()> for efficiency; otherwise individual C<line()>
calls are made for the enabled edges. Setting some flags to false can produce
striking visual effects (see Mitchell, Figures 6 and 7).
=item C<iterations =E<gt> $n> (optional)
Draw exactly C<$n> nested polygons (not counting the base polygon). When
given, this takes precedence over C<min_size>.
=item C<min_size =E<gt> $pct> (optional, default C<1.0>)
Stop iterating once the length of the first edge of the current polygon has
shrunk to C<$pct> percent of the original first-edge length. Ignored when
C<iterations> is also given.
=back
Returns C<1> on success. Croaks on invalid input.
=back
=head1 PACKAGE VARIABLES
=over 4
t/17-swirl.t view on Meta::CPAN
# Invalid direction
{
my $g = new_g();
eval { $g->swirl( points => \@SQUARE, d => \@D4, direction => 2 ) };
ok( $@, 'swirl with direction=2 croaks' );
}
# Valid minimal call returns 1
{
my $g = new_g();
my $rc = eval { $g->swirl( points => \@SQUARE, d => \@D4, iterations => 5 ) };
ok( !$@, 'swirl with valid args does not croak' );
is( $rc, 1, 'swirl returns 1 on success' );
}
# ===========================================================================
# 3. Iteration control: fixed count
# ===========================================================================
note('--- 3. fixed iteration count ---');
# With iterations => N the base polygon is always drawn plus N inner ones.
# Each square ring is a closed polygon: 4 edges + closing move = at least
# 4 G01 lines. So total G01 count >= 4 * (N+1).
{
for my $n ( 1, 5, 20 ) {
my $g = new_g();
$g->swirl( points => \@SQUARE, d => \@D4, iterations => $n );
my $g01 = count_g01($g);
ok( $g01 >= 4 * ( $n + 1 ),
"iterations=$n: G01 count ($g01) >= 4 * (n+1) = " . 4*($n+1) );
}
}
# iterations => 0 draws only the base polygon
{
my $g = new_g();
$g->swirl( points => \@SQUARE, d => \@D4, iterations => 0 );
my $g01 = count_g01($g);
ok( $g01 >= 4, "iterations=0: base polygon (>= 4 G01 lines) drawn ($g01)" );
# The number of draw lines should not exceed what a single square needs.
# A closed polygon is 4 line segments; generous upper bound is 10.
ok( $g01 <= 10, "iterations=0: no extra polygons drawn ($g01 <= 10)" );
}
# More iterations → more gcode
{
my $g5 = new_g();
$g5->swirl( points => \@SQUARE, d => \@D4, iterations => 5 );
my $g20 = new_g();
$g20->swirl( points => \@SQUARE, d => \@D4, iterations => 20 );
ok( count_g01($g20) > count_g01($g5),
'more iterations produce more G01 draw lines' );
}
# ===========================================================================
# 4. Iteration control: size-based termination
# ===========================================================================
note('--- 4. size-based termination ---');
# With a very loose threshold (50%) the whirl stops quickly
t/17-swirl.t view on Meta::CPAN
}
# ===========================================================================
# 5. Clockwise vs counter-clockwise direction
# ===========================================================================
note('--- 5. CW vs CCW direction ---');
# Both directions produce the same number of G01 lines for the same number
# of iterations (the winding differs but the count does not).
{
my $g_cw = new_g();
$g_cw->swirl( points => \@SQUARE, d => \@D4, direction => 0, iterations => 10 );
my $g_ccw = new_g();
$g_ccw->swirl( points => \@SQUARE, d => \@D4, direction => 1, iterations => 10 );
is( count_g01($g_cw), count_g01($g_ccw),
'CW and CCW produce the same number of G01 lines' );
}
# The coordinate outputs must differ (the polygons are mirror images)
{
my $g_cw = new_g();
$g_cw->swirl( points => \@SQUARE, d => \@D4, direction => 0, iterations => 3 );
my $g_ccw = new_g();
$g_ccw->swirl( points => \@SQUARE, d => \@D4, direction => 1, iterations => 3 );
my $cw_page = join( '', @{ $g_cw->{currentpage} } );
my $ccw_page = join( '', @{ $g_ccw->{currentpage} } );
isnt( $cw_page, $ccw_page,
'CW and CCW produce different gcode output (mirror images)' );
}
# Using the package constants gives the same result as numeric literals
{
my $g_lit = new_g();
$g_lit->swirl( points => \@SQUARE, d => \@D4, direction => 1, iterations => 5 );
my $g_const = new_g();
$g_const->swirl(
points => \@SQUARE,
d => \@D4,
direction => $Graphics::Penplotter::GcodeXY::Swirl::SWIRL_CCW,
iterations => 5,
);
is( join( '', @{ $g_lit->{currentpage} } ),
join( '', @{ $g_const->{currentpage} } ),
'SWIRL_CCW constant gives same result as direction => 1' );
}
# ===========================================================================
# 6. Per-edge draw flags
# ===========================================================================
note('--- 6. per-edge draw flags ---');
# All edges drawn (default) vs some suppressed: suppressing edges reduces G01 count
{
my $g_full = new_g();
$g_full->swirl( points => \@SQUARE, d => \@D4, iterations => 10 );
my $g_part = new_g();
$g_part->swirl(
points => \@SQUARE,
d => \@D4,
iterations => 10,
draw => [ 1, 0, 1, 0 ], # alternating: skip 2 edges per ring
);
ok( count_g01($g_part) < count_g01($g_full),
'suppressing 2 edges per ring reduces G01 count' );
}
# Suppressing all edges should produce zero G01 lines
{
my $g = new_g();
$g->swirl(
points => \@SQUARE,
d => \@D4,
iterations => 10,
draw => [ 0, 0, 0, 0 ],
);
is( count_g01($g), 0, 'draw=[0,0,0,0]: no G01 lines produced' );
}
# Suppressing no edges gives same count as omitting the draw argument
{
my $g_no_draw = new_g();
$g_no_draw->swirl( points => \@SQUARE, d => \@D4, iterations => 10 );
my $g_all_draw = new_g();
$g_all_draw->swirl(
points => \@SQUARE,
d => \@D4,
iterations => 10,
draw => [ 1, 1, 1, 1 ],
);
is( count_g01($g_no_draw), count_g01($g_all_draw),
'draw=[1,1,1,1] gives same count as omitting draw argument' );
}
# ===========================================================================
# 7. Varying d values per edge
# ===========================================================================
note('--- 7. varying d values ---');
# Uniform d and varying d with same mean produce different gcode
{
my $g_uni = new_g();
$g_uni->swirl( points => \@SQUARE, d => [ 20, 20, 20, 20 ], iterations => 10 );
my $g_var = new_g();
$g_var->swirl( points => \@SQUARE, d => [ 5, 40, 10, 25 ], iterations => 10 );
isnt(
join( '', @{ $g_uni->{currentpage} } ),
join( '', @{ $g_var->{currentpage} } ),
'varying d produces different gcode from uniform d',
);
}
# Triangle with varying d
{
my $g = new_g();
my $rc = eval {
$g->swirl( points => \@TRIANGLE, d => \@D3, iterations => 15 );
};
ok( !$@, 'triangle with varying d does not croak' );
is( $rc, 1, 'triangle with varying d returns 1' );
ok( count_g01($g) > 0, 'triangle with varying d produces draw lines' );
}
# d => [50,50,50,50] should still run without crashing (degenerate case)
{
my $g = new_g();
eval { $g->swirl( points => \@SQUARE, d => [ 50,50,50,50 ], iterations => 5 ) };
ok( !$@, 'd=50 (degenerate) does not croak' );
}
# ===========================================================================
# 8. Output produces gcode
# ===========================================================================
note('--- 8. gcode output ---');
# currentpage must contain G00 travel and G01 draw lines after swirl
{
my $g = new_g();
$g->swirl( points => \@SQUARE, d => \@D4, iterations => 5 );
ok( count_g00($g) > 0, 'currentpage contains G00 travel lines' );
ok( count_g01($g) > 0, 'currentpage contains G01 draw lines' );
}
# Successive swirl calls accumulate in currentpage
{
my $g = new_g();
$g->swirl( points => \@SQUARE, d => \@D4, iterations => 5 );
my $len1 = scalar @{ $g->{currentpage} };
$g->swirl( points => \@TRIANGLE, d => \@D3, iterations => 5 );
my $len2 = scalar @{ $g->{currentpage} };
ok( $len2 > $len1,
'successive swirl calls accumulate in currentpage' );
}
# After swirl the psegments queue is populated (drawn via polygon/line)
{
my $g = new_g();
$g->swirl( points => \@SQUARE, d => \@D4, iterations => 3 );
# psegments may or may not be populated depending on stroke; the key
# check is that currentpage has content — done above. Just verify no crash.
ok( 1, 'no crash verifying psegments after swirl' );
}
# ===========================================================================
# 9. Geometric correctness (new vertex lies on edge)
# ===========================================================================
#
# We verify that for iterations => 1, CW direction, uniform d=20%, each new
# vertex of the inner ring lies exactly 20% of the way along the corresponding
# edge of the base square.
#
# Base square vertices (in order):
# V0=(10,10) V1=(90,10) V2=(90,90) V3=(10,90)
#
# For d=20% CW:
# new[0] = V0 + 0.20*(V1-V0) = (10 + 0.2*80, 10) = (26, 10)
# new[1] = V1 + 0.20*(V2-V1) = (90, 10 + 0.2*80) = (90, 26)
# new[2] = V2 + 0.20*(V3-V2) = (90 - 0.2*80, 90) = (74, 90)
t/17-swirl.t view on Meta::CPAN
{
my @expected_xy = (
[ 26, 10 ],
[ 90, 26 ],
[ 74, 90 ],
[ 10, 74 ],
);
my $g = new_g();
$g->swirl( points => \@SQUARE, d => \@D4, iterations => 1 );
my $page = join( "\n", @{ $g->{currentpage} } );
for my $pt ( @expected_xy ) {
my ( $ex, $ey ) = @{$pt};
# sprintf format used by the module: "%.5f"
my $xs = sprintf '%.5f', $ex;
my $ys = sprintf '%.5f', $ey;
like(
$page,
qr/G0[01]\s+X\s*$xs\s+Y\s*$ys/,
"inner ring vertex ($ex,$ey) appears in gcode",
);
}
}
# For CCW with d=20%, new[0] = V1 + 0.20*(V0-V1) = (90-0.2*80, 10) = (74, 10)
{
my $g = new_g();
$g->swirl( points => \@SQUARE, d => \@D4, direction => 1, iterations => 1 );
my $page = join( "\n", @{ $g->{currentpage} } );
my $xs = sprintf '%.5f', 74;
my $ys = sprintf '%.5f', 10;
like(
$page,
qr/G0[01]\s+X\s*$xs\s+Y\s*$ys/,
'CCW: first inner vertex (74,10) appears in gcode',
);
}
t/17-swirl.t view on Meta::CPAN
# swirl() must not introduce its own GcodeXY object attributes beyond what
# GcodeXY itself defines. We verify that calling swirl leaves exactly the
# same attribute keys as before (GcodeXY manages state, not the role).
note('--- 11. no shared-state pollution ---');
{
my $g = new_g();
my %keys_before = map { $_ => 1 } keys %{$g};
$g->swirl( points => \@SQUARE, d => \@D4, iterations => 5 );
# Keys that are legitimately added by drawing (currentpage, psegments, etc.)
# are already present after new(); swirl must not introduce NEW top-level keys.
my %keys_after = map { $_ => 1 } keys %{$g};
my @new_keys = grep { !exists $keys_before{$_} } keys %keys_after;
is( scalar @new_keys, 0,
'swirl does not introduce new top-level object attributes (' .
join( ',', @new_keys ) . ')' );
}
( run in 2.128 seconds using v1.01-cache-2.11-cpan-96521ef73a4 )