view release on metacpan or  search on metacpan

lib/Graphics/Penplotter/GcodeXY/Geometry2D.pm  view on Meta::CPAN

sub _transform ($self, $npts, $ptsref) {
    foreach my $k ( 0 .. $npts - 1 ) {
        my $tmp =
            $self->{CTM}->[0][0] * $ptsref->[ 2 * $k ] +
            $self->{CTM}->[0][1] * $ptsref->[ 2 * $k + 1 ] +
            $self->{CTM}->[0][2];
        $ptsref->[ 2 * $k + 1 ] =
            $self->{CTM}->[1][0] * $ptsref->[ 2 * $k ] +
            $self->{CTM}->[1][1] * $ptsref->[ 2 * $k + 1 ] +
            $self->{CTM}->[1][2];
        $ptsref->[ 2 * $k ] = $tmp;
    }
    return 1;
}


# ===========================================================================
# ARC / FILLET GEOMETRY HELPERS
# ===========================================================================

# Signed cross product of two 2-D vectors.
sub _cross2 ($self, $v1x, $v1y, $v2x, $v2y) {
    return ( $v1x * $v2y - $v2x * $v1y );
}

# Angle subtended by two vectors: cos(a) = u·v / (‖u‖·‖v‖).
sub _dot2 ($self, $ux, $uy, $vx, $vy) {
    my $d = sqrt( ( $ux*$ux + $uy*$uy ) * ( $vx*$vx + $vy*$vy ) );
    return 0.0 if $d == 0.0;
    return acos( ( $ux*$vx + $uy*$vy ) / $d );
}

# Find a,b,c for Ax + By + C = 0 through p1 and p2.
sub _linecoefs ($self, $p1x, $p1y, $p2x, $p2y) {
    my $c = ( $p2x * $p1y ) - ( $p1x * $p2y );
    my $a = $p2y - $p1y;
    my $b = $p1x - $p2x;
    return ( $a, $b, $c );
}

# Return signed distance from line Ax + By + C = 0 to point P.
sub _linetopoint ($self, $a, $b, $c, $px, $py) {
    my $d = sqrt( $a*$a + $b*$b );
    return 0.0 if $d == 0.0;
    return ( $a*$px + $b*$py + $c ) / $d;
}

# Given line ax + by + c = 0 and point p, find the foot of the perpendicular from p.
sub _pointperp ($self, $a, $b, $c, $px, $py) {
    my ( $x, $y ) = ( 0.0, 0.0 );
    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 );
    if ( $d1 == 0.0 ) { return (undef) x 12 }
    $mpx = ( $p1x + $p2x ) / 2.0;
    $mpy = ( $p1y + $p2y ) / 2.0;
    $d2  = $self->_linetopoint( $a2, $b2, $c2, $mpx, $mpy );
    if ( $d2 == 0.0 ) { return (undef) x 12 }
    $rr  = ( $d1 <= 0.0 ) ? -$r : $r;
    $c1p = $c1 - $rr * sqrt( $a1*$a1 + $b1*$b1 );
    $rr  = ( $d2 <= 0.0 ) ? -$r : $r;
    $c2p = $c2 - $rr * sqrt( $a2*$a2 + $b2*$b2 );
    $d   = $a1*$b2 - $a2*$b1;
    $xc  = ( $c2p*$b1 - $c1p*$b2 ) / $d;
    $yc  = ( $c1p*$a2 - $c2p*$a1 ) / $d;
    $pcx = $xc;
    $pcy = $yc;
    ( $xa, $ya ) = $self->_pointperp( $a1, $b1, $c1, $pcx, $pcy );
    ( $xb, $yb ) = $self->_pointperp( $a2, $b2, $c2, $pcx, $pcy );
    $p2x  = $xa;  $p2y  = $ya;
    $p3x  = $xb;  $p3y  = $yb;
    $gv1x = $xa - $xc;  $gv1y = $ya - $yc;
    $gv2x = $xb - $xc;  $gv2y = $yb - $yc;
    $pa   = atan2( $gv1y, $gv1x );
    $aa   = $self->_dot2( $gv1x, $gv1y, $gv2x, $gv2y );
    if ( $self->_cross2( $gv1x, $gv1y, $gv2x, $gv2y ) < 0.0 ) { $aa = -$aa }
    return ( $p1x, $p1y, $p2x, $p2y, $p3x, $p3y, $p4x, $p4y,
             $xc, $yc, $pa * $R2D, $aa * $R2D );
}


# ===========================================================================
# FLOATING-POINT UTILITIES
# ===========================================================================

# Floating-point absolute value.
sub _fabs ($val) {
    return ( $val >= 0.0 ) ? $val : -$val;
}

# Floating-point equality within $EPSILON.
sub _feq ($x, $y) {
    return ( _fabs( $x - $y ) < $EPSILON ) ? 1 : 0;
}

# Square of the Euclidean distance between two points.
sub _calc_sq_distance ($x1, $y1, $x2, $y2) {
    return ( $x2 - $x1 )**2 + ( $y2 - $y1 )**2;
}


# ===========================================================================
# UNIT CONVERSION

lib/Graphics/Penplotter/GcodeXY/Geometry2D.pm  view on Meta::CPAN

# ===========================================================================
# ANGLE CONVERSION (public utility functions)
# ===========================================================================

# Convert degrees to radians.
sub radians ($deg) { return $deg * $D2R }

# Convert radians to degrees.
sub degrees ($rad) { return $rad / $D2R }


# ===========================================================================
# SEGMENT INTERSECTION (Cramer's Rule)
# ===========================================================================

# Return the parametric intersection parameter t of two line segments,
# or 0 if they do not intersect.  Touching segments are not considered to intersect.
#
# Theory (parametric line representation):
#   P  = P1 + k(P2-P1)         Q  = P3 + l(P4-P3)
#   Intersection when P=Q:
#       k = [ (x4-x3)(y1-y3) - (y4-y3)(x1-x3) ] / denom
#       l = [ (x2-x1)(y1-y3) - (y2-y1)(x1-x3) ] / denom
#   where denom = (y4-y3)(x2-x1) - (x4-x3)(y2-y1)
#   Intersection is valid when both k and l are in (0,1).
sub _getsegintersect ($self, $p0x, $p0y, $p1x, $p1y, $p2x, $p2y, $p3x, $p3y) {
    my ( $s02x, $s02y, $s10x, $s10y, $s32x, $s32y, $s_numer, $t_numer, $denom );
    $s10x  = $p1x - $p0x;
    $s10y  = $p1y - $p0y;
    $s32x  = $p3x - $p2x;
    $s32y  = $p3y - $p2y;
    $denom = $s10x * $s32y - $s32x * $s10y;
    return 0 if $denom == 0;    # collinear
    my $denomPositive = ( $denom > 0 );
    $s02x    = $p0x - $p2x;
    $s02y    = $p0y - $p2y;
    $s_numer = $s10x * $s02y - $s10y * $s02x;
    return 0 if ( ( $s_numer < 0 ) == $denomPositive );
    $t_numer = $s32x * $s02y - $s32y * $s02x;
    return 0 if ( ( $t_numer < 0 ) == $denomPositive );
    return 0 if (  ( $s_numer > $denom ) == $denomPositive
                || ( $t_numer > $denom ) == $denomPositive );
    return $t_numer / $denom;
}


# ===========================================================================
# LIANG-BARSKY LINE CLIPPING
# ===========================================================================

# 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 ) {
        if ( $edge == 0 ) { $p = -$xdelta; $q = -( $botx - $x0src ) }
        if ( $edge == 1 ) { $p =  $xdelta; $q =    $topx - $x0src   }
        if ( $edge == 2 ) { $p = -$ydelta; $q = -( $boty - $y0src ) }
        if ( $edge == 3 ) { $p =  $ydelta; $q =    $topy - $y0src   }
        if ( $p == 0 && $q < 0 ) {
            return ( -1, -1, -1, -1, 2 );    # parallel and outside
        }
        if ( $p < 0 ) {
            $r = 1.0 * $q / $p;
            return ( -1, -1, -1, -1, 2 ) if $r > $t1;
            $t0 = $r if $r > $t0;            # clip start
        }
        elsif ( $p > 0 ) {
            $r = 1.0 * $q / $p;
            return ( -1, -1, -1, -1, 2 ) if $r < $t0;
            $t1 = $r if $r < $t1;            # clip end
        }
    }
    $info = 1 if $t0 == 0.0 && $t1 == 1.0;
    $info = 3 if $t0 == 0.0 && $t1 != 1.0;
    $info = 4 if $t0 != 0.0 && $t1 == 1.0;
    $info = 5 if $t0 != 0.0 && $t1 != 1.0;
    return (
        $x0src + $t0 * $xdelta,
        $y0src + $t0 * $ydelta,
        $x0src + $t1 * $xdelta,
        $y0src + $t1 * $ydelta,
        $info,
    );
}


1;

__END__

=head1 NAME

Graphics::Penplotter::GcodeXY::Geometry2D - Geometric primitives and transformations for GcodeXY

=head1 SYNOPSIS

    $g->moveto(10, 20);
    $g->line(30, 40);
    $g->circle(50, 50, 10);
    $g->rotate(45);
    $g->arc(0, 0, 5, 0, 180);

=head1 DESCRIPTION