Code to generate graph paper in SVG with Perl
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env perl | |
use strict ; | |
use warnings ; | |
use utf8 ; | |
use feature qw{ postderef say signatures state } ; | |
no warnings qw{ experimental::postderef experimental::signatures } ; | |
use Carp ; | |
use Getopt::Long ; | |
use Pod::Usage ; # when I fix my man/help screens | |
use SVG ; | |
my $config = config() ; | |
my $svg = SVG->new( | |
height => $config->{ height }, | |
width => $config->{ width }, | |
) ; | |
if ( $config->{ dot } ) { | |
my $height = $config->{ height } ; | |
my $width = $config->{ width } ; | |
my $step = $config->{ step } ; | |
for ( my $h = 0 ; $h <= $height ; $h = $h + $step ) { | |
for ( my $v = 0 ; $v <= $width ; $v = $v + $step ) { | |
$svg->circle( | |
cx => $v, | |
cy => $h, | |
r => 0.5, | |
style => { | |
stroke => 'black', | |
'stroke-width' => 0.2, | |
fill => 'black', | |
} | |
) ; | |
} | |
} | |
say 'DOT' ; | |
} | |
else { | |
say 'LINE' ; | |
my $height = $config->{ height } ; | |
my $width = $config->{ width } ; | |
my $step = $config->{ step } ; | |
# horizontal | |
for ( my $h = 0 ; $h <= $height ; $h = $h + $step ) { | |
# say join ', ', 'Horizontal', 0, $h, $width, $h ; | |
$svg->line( | |
x1 => 0, | |
y1 => $h, | |
x2 => $width, | |
y2 => $h, | |
style => { | |
stroke => 'black', | |
'stroke-width' => 0.2, | |
fill => 'none', | |
} | |
) ; | |
} | |
# vertical | |
for ( my $v = 0 ; $v <= $width ; $v = $v + $step ) { | |
# say join ', ', 'Vertical', $v, 0, $v, $height ; | |
$svg->line( | |
x1 => $v, | |
y1 => $0, | |
x2 => $v, | |
y2 => $height, | |
style => { | |
stroke => 'black', | |
'stroke-width' => 0.2, | |
fill => 'none', | |
} | |
) ; | |
} | |
} | |
my $output = $svg->xmlify ; | |
if ( open my $fh, '>', $config->{ file } ) { | |
print $fh $output ; | |
close $fh ; | |
say 'Done' ; | |
} | |
else { | |
say 'fail' ; | |
} | |
exit ; | |
sub config () { | |
my $config = { | |
dot => 0, | |
height => 600, | |
width => 600, | |
step => 10, | |
file => 'graph.svg', | |
} ; | |
GetOptions( | |
'man' => \$config->{ man }, | |
'height=i' => \$config->{ height }, | |
'width=i' => \$config->{ width }, | |
'step=i' => \$config->{ step }, | |
'dot' => \$config->{ dot }, | |
'file=s' => \$config->{ file }, | |
) ; | |
exit if $config->{ height } < 100 ; | |
exit if $config->{ width } < 100 ; | |
exit if $config->{ step } < 1 ; | |
exit if $config->{ man } ; | |
return $config ; | |
} | |
__DATA__ | |
COPYRIGHT & LICENSE | |
Copyright 2018 - Dave Jacoby | |
This code is distributed under the same license | |
as Perl itself. It is provided free of warranty | |
and may be re-used freely. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment