Code to create SVG images of periodic functions for my amusement

both.pl

#!/usr/bin/env perl

use feature qw'say' ;
use strict ;
use warnings ;
use utf8 ;

use Data::Dumper ;
use Getopt::Long ;
use SVG ;

use lib '/home/jacoby/lib' ;
use Spirograph ;

my $conf = {
    height      => 800 ,
    width       => 800 ,
    k           => 30 ,
    r           => 11.5 ,
    stroke      => 'black' ,
    fill        => 'none' ,
    name        => 'both.svg' ,
    } ;

GetOptions(
    'height=i'      => \$conf->{ height } ,
    'width=i'       => \$conf->{ width } ,
    'k=f'           => \$conf->{ k } ,
    'r=f'           => \$conf->{ r } ,
    'name=s'        => \$conf->{ name } ,
    ) ;

my $svg = SVG->new(
    height => $conf->{ height },
    width  => $conf->{ width },
    ) ;

my $grp = $svg->group(
    id    => 'group_y',
    style => {
        stroke => $conf->{ stroke } ,
        fill   => $conf->{ fill },
        }
        ) ;

epicycloid( {
        grp    => $grp,
        stroke => 'blue',
        def    => {
            r => $conf->{ r },
            k => $conf->{ k },
            },
        center => {
            x => $conf->{ height } / 2 ,
            y => $conf->{ width  } / 2 ,
            },
        }
    ) ;
hypocycloid( {
        grp    => $grp,
        stroke => 'red',
        def    => {
            r => $conf->{ r },
            k => $conf->{ k },
            },
        center => {
            x => $conf->{ height } / 2 ,
            y => $conf->{ width  } / 2 ,
            },
        }
    ) ;

my $output = $svg->xmlify ;
if ( open my $fh , '>' , $conf->{ name } ) {
    print $fh $output ;
    close $fh ;
    say 'Done' ;
    }
else {
    say 'fail' ;
    }

exit ;

Spirograph.pm

package Spirograph ;

use feature qw{ state say } ;
use strict ;
use warnings ;

use CGI ;
use Data::Dumper ;
use Exporter 'import' ;
use Math::Trig ;
use SVG ;

our @EXPORT ;

BEGIN {
    our @EXPORT = qw{
        epicycloid
        hypocycloid
        hypotrochoid
        } ;
    }

my @range = 0 .. 50_000 ;
my $denom = 400 ;

# http://en.wikipedia.org/wiki/Epicycloid
# x(angle) = r( k + 1 )cos(angle) -rcos((k+1)(angle))
# y(angle) = r( k + 1 )sin(angle) -rsin((k+1)(angle))
sub epicycloid {
    my $object = shift ;
    my $grp    = $object->{ grp } ;
    my $prev   = 0 ;

    my $centXY = $object->{ center } ;
    my $prevXY = {} ;
    my $currXY = {} ;

    my $o ;
    for my $i ( qw{ k r } ) {
        $o->{ $i } = $object->{ def }->{ $i } ;
        }

    for my $deg ( map { $_ / $denom } @range ) {
        $o->{ n } = $deg ;    # deg2rad( $deg ) ;

        # epicycloid ==============================================
        $currXY->{ x } = eXpos( $o ) ;
        $currXY->{ y } = eYpos( $o ) ;

        $grp->line(
            x1    => $centXY->{ x } + $prevXY->{ x },
            y1    => $centXY->{ y } - $prevXY->{ y },
            x2    => $centXY->{ x } + $currXY->{ x },
            y2    => $centXY->{ y } - $currXY->{ y },
            style => {
                stroke => $object->{ stroke },
                fill   => 'none',
                }
                ) unless $deg == $prev ;

        $prev          = $deg ;
        $prevXY->{ x } = $currXY->{ x } ;
        $prevXY->{ y } = $currXY->{ y } ;

        # epicycloid ==============================================

        }

    }

sub eXpos {
    my $obj = shift ;
    my ( $k, $r, $n ) = map { $obj->{ $_ } } qw{ k r n } ;
    return ( $r * ( $k + 1 ) * cos( $n ) ) - ( $r * cos( $n * ( $k + 1 ) ) ) ;
    }

sub eYpos {
    my $obj = shift ;
    my ( $k, $r, $n ) = map { $obj->{ $_ } } qw{ k r n } ;
    return ( $r * ( $k + 1 ) * sin( $n ) ) - ( $r * sin( $n * ( $k + 1 ) ) ) ;
    }

# http://en.wikipedia.org/wiki/Hypocycloid
# x(angle) = r( k + 1 )cos(angle) -rcos((k+1)(angle))
# y(angle) = r( k + 1 )sin(angle) -rsin((k+1)(angle))
sub hypocycloid {
    my $object = shift ;
    my $grp    = $object->{ grp } ;
    my $prev   = 0 ;

    my $centXY = $object->{ center } ;
    my $prevXY = {} ;
    my $currXY = {} ;

    my $o ;
    for my $i ( qw{ k r } ) {
        $o->{ $i } = $object->{ def }->{ $i } ;
        }

    for my $deg ( map { $_ / $denom } @range ) {
        $o->{ n } = $deg ;    # deg2rad( $deg ) ;

        # epicycloid ==============================================
        $currXY->{ x } = hXpos( $o ) ;
        $currXY->{ y } = hYpos( $o ) ;

        $grp->line(
            x1    => $centXY->{ x } + $prevXY->{ x },
            y1    => $centXY->{ y } - $prevXY->{ y },
            x2    => $centXY->{ x } + $currXY->{ x },
            y2    => $centXY->{ y } - $currXY->{ y },
            style => {
                stroke => $object->{ stroke },
                fill   => 'none',
                }
                ) unless $deg == $prev ;

        $prev          = $deg ;
        $prevXY->{ x } = $currXY->{ x } ;
        $prevXY->{ y } = $currXY->{ y } ;

        # epicycloid ==============================================

        }
    }

sub hXpos {
    my $obj = shift ;
    my ( $k, $r, $n ) = map { $obj->{ $_ } } qw{ k r n } ;
    return ( $r * ( $k - 1 ) * cos( $n ) ) + ( $r * cos( $n * ( $k - 1 ) ) ) ;
    }

sub hYpos {
    my $obj = shift ;
    my ( $k, $r, $n ) = map { $obj->{ $_ } } qw{ k r n } ;
    return ( $r * ( $k - 1 ) * sin( $n ) ) - ( $r * sin( $n * ( $k - 1 ) ) ) ;
    }

# http://en.wikipedia.org/wiki/Hypotrochoid
# x(angle) = (R-r)cos(angle) + d cos((R-r)/R *(angle))
# y(angle) = (R-r)sin(angle) + d sin((R-r)/R *(angle))
sub hypotrochoid {
    my $object = shift ;
    my $grp    = $object->{ grp } ;
    my $prev   = 0 ;

    my $centXY = $object->{ center } ;
    my $prevXY = {} ;
    my $currXY = {} ;

    my $o ;
    for my $i ( qw{ R r d } ) {
        $o->{ $i } = $object->{ def }->{ $i } ;
        }

    for my $deg ( map { $_ / $denom } @range ) {
        $o->{ n } = $deg ;    # deg2rad( $deg ) ;

        # hypotrochoid ==============================================
        $currXY->{ x } = htXpos( $o ) ;
        $currXY->{ y } = htYpos( $o ) ;

        $grp->line(
            x1    => $centXY->{ x } + $prevXY->{ x },
            y1    => $centXY->{ y } - $prevXY->{ y },
            x2    => $centXY->{ x } + $currXY->{ x },
            y2    => $centXY->{ y } - $currXY->{ y },
            style => {
                stroke => $object->{ stroke },
                fill   => 'none',
                }
                ) unless $deg == $prev ;

        $prev          = $deg ;
        $prevXY->{ x } = $currXY->{ x } ;
        $prevXY->{ y } = $currXY->{ y } ;

        # hypotrochoid ==============================================

        }

    }

sub htXpos {
    my $obj = shift ;
    my ( $R, $r, $d, $n ) = map { $obj->{ $_ } } qw{ R r d n } ;
    my $front = ( ( $R - $r ) * cos( $n ) ) ;
    my $back = ( $d * cos( $n * ( $R - $r ) / $r ) ) ;
    return $front + $back ;
    }

sub htYpos {
    my $obj = shift ;
    my ( $R, $r, $d, $n ) = map { $obj->{ $_ } } qw{ R r d n } ;
    my $front = ( ( $R - $r ) * sin( $n ) ) ;
    my $back = ( $d * sin( $n * ( $R - $r ) / $r ) ) ;
    return $front - $back ;
    }

sub xPos {
    my ( $length, $degrees ) = @_ ;
    return ( $length * sin( deg2rad( $degrees ) ) ) ;
    }

sub yPos {
    my ( $length, $degrees ) = @_ ;
    return ( $length * cos( deg2rad( $degrees ) ) ) ;
    }

sub distance_between_2_points {
    my ( $x1, $y1, $x2, $y2 ) = @_ ;
    my $x    = ( $x1 - $x2 )**2 ;
    my $y    = ( $y1 - $y2 )**2 ;
    my $sqrt = sqrt( $x + $y ) ;

    # say join "\t" , '' , map { sprintf '%.02f' , $_ } $x , $y , $sqrt ;
    return $sqrt ;
    }

1 ;

triangle.pl

#!/usr/bin/env perl

use feature qw'say state' ;
use strict ;
use warnings ;
use utf8 ;

use Data::Dumper ;
use DateTime ;
use Math::Trig ;
use SVG ;
use Getopt::Long ;
use Spirograph ;

my $conf = {
    height => 1000,
    width  => 1000,
    r1     => 50,
    r2     => 30,
    d      => 50,
    stroke => 'black',
    fill   => 'none',
    } ;

GetOptions(
    'height=i'   => \$conf->{ height },
    'width=i'    => \$conf->{ width },
    'r1=f'       => \$conf->{ r1 },
    'r2=f'       => \$conf->{ r2 },
    'distance=f' => \$conf->{ d },
    ) ;

my $svg = SVG->new(
    height => $conf->{ height },
    width  => $conf->{ width },
    ) ;

my $grp = $svg->group(
    id    => 'group_y',
    style => {
        stroke => $conf->{ stroke },
        fill   => $conf->{ fill },
        }
        ) ;

my $test = allPass(
    sub { return 1 },
    sub { my $i = shift ; return $i % 50 == 0 },
    ) ;

my $max = 450 ;
for my $r1 ( grep { $test->( $_ ) } 1 .. $max ) {
    my $r2    = $r1 / 3 ;
    my $d     = 150 ;
    my $color = '#0000' . sprintf( '%02x', int( 255 / $max * $r1 ) ) ;
    $color = 'black' ;
    say $color ;
    hypotrochoid( {
            grp    => $grp,
            stroke => $color,
            def    => {
                R => $r1,
                r => $r2,
                d => $d,
                },
            center => {
                x => $conf->{ height } / 2,
                y => $conf->{ width } / 2,
                },
                }
        ) ;
    }

my $output = $svg->xmlify ;

my @Rrd = map { $conf->{ $_ } } qw{ r1 r2 d } ;
my $file = 'triangles.svg' ;
if ( open my $fh, '>', $file ) {
    print $fh $output ;
    close $fh ;
    }
else {
    say 'fail' ;
    }
say 'done' ;
exit ;

############################################################
# take an array of code refs which SHOULD return boolean values
#
# allPass returns 0 if any of the coderefs doesn't return true,
#   else returns true. 
# anyPass returns 1 if any of the coderefs returns true, else
#   returns false.

sub allPass {
    return 0 if !@_ ;
    my @f = @_ ;
    return sub {
        for my $t ( @f ) {
            my $r = &$t( @_ ) ;
            return 0 unless $r >= 1;
            }
        return 1 ;
        }
    }

sub anyPass {
    return 0 if !@_ ;
    my @f = @_ ;
    return sub {
        for my $t ( @f ) {
            my $r = &$t( @_ ) ;
            return 1 if $r >= 1 ;
            }
        return 0 ;
        }
    }