kopia lustrzana https://github.com/evil-mad/EggBot
initial checkin of perl support
git-svn-id: https://eggbotcode.googlecode.com/svn/trunk@185 72233254-1b6c-9e9c-5072-401df62706fbpull/47/head
chuck.mcmanis
rodzic
36cb9f0200
commit
538247e00b
|
|
@ -0,0 +1,337 @@
|
|||
# Perl library to talk with the EggBot
|
||||
# written Dec-2010 by Chuck McManis
|
||||
# Should be portable to any Perl 5.10 system with a POSIX package
|
||||
# (which should be all of them)
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package EggBot;
|
||||
|
||||
BEGIN {
|
||||
require Exporter;
|
||||
our @ISA = qw( Exporter );
|
||||
our @EXPORT_OK = qw( new );
|
||||
}
|
||||
|
||||
use POSIX qw( :termios_h );
|
||||
use Fcntl;
|
||||
use Time::HiRes qw( sleep usleep );
|
||||
use Getopt::Long;
|
||||
|
||||
sub new {
|
||||
my $self = shift;
|
||||
my $class = ref ($self) || $self;
|
||||
my (%opts) = @_;
|
||||
$self = bless {}, $class;
|
||||
|
||||
$self->{'flip'} = 0;
|
||||
if (defined($opts{'flip'})) {
|
||||
$self->{'flip'} = $opts{'flip'};
|
||||
}
|
||||
$self->{'draw_speed'} = 250;
|
||||
if (defined $opts{'draw_speed'}) {
|
||||
$self->{'draw_speed'} = $opts{'draw_speed'};
|
||||
}
|
||||
$self->{'move_speed'} = 600;
|
||||
if (defined $opts{'move_speed'}) {
|
||||
$self->{'move_speed'} = $opts{'move_speed'};
|
||||
}
|
||||
$self->{'debug'} = 0;
|
||||
if (defined $opts{'debug'}) {
|
||||
$self->{'debug'} = $opts{'debug'};
|
||||
}
|
||||
$self->{'error'} = 0; # set to true if last command errored out
|
||||
$self->{'sync'} = 0; # set to true when sync'd up
|
||||
|
||||
# try to puzzle out if an EggBot is attached. This is
|
||||
# done by starting at unit 0 and walking up to unit 9
|
||||
# checking to see if a sync command works.
|
||||
my $unit = 0;
|
||||
while (1) {
|
||||
$self->{'device'} = "/dev/ttyACM$unit";
|
||||
if (sysopen ($self->{'fh'}, $self->{'device'}, O_RDWR | O_NDELAY)) {
|
||||
# check to see if an EggBot is listening ...
|
||||
last if $self->resync();
|
||||
close $self->{'fh'};
|
||||
}
|
||||
$unit += 1;
|
||||
return if ($unit > 10);
|
||||
}
|
||||
print "Device $self->{device} connected to EggBot.\n";
|
||||
|
||||
$self->{'fd'} = fileno ($self->{'fh'});
|
||||
_setup_fd($self->{'fd'});
|
||||
|
||||
$self->{'max_x'} = 3200;
|
||||
$self->{'max_y'} = 800;
|
||||
if (defined $opts{'limits'}) {
|
||||
my ($mx, $my) = $opts{'limits'} =~ /(\d+),(\d+)/;
|
||||
($self->{'max_x'}, $self->{'max_y'}) = ($mx, $my);
|
||||
}
|
||||
$self->{'pen_high'} = 25_000;
|
||||
$self->{'pen_low'} = 20_000;
|
||||
$self->{'pen_speed'} = 100;
|
||||
$self->{'pen_up_speed'} = 500;
|
||||
$self->{'pen_delay'} = [.5, .75]; # up, down delay in S
|
||||
$self->resync();
|
||||
if (! $self->{'sync'}) {
|
||||
warn "Unable to sync with EggBot!\n";
|
||||
return;
|
||||
}
|
||||
$self->_do_cmd("sc,4,$self->{pen_high}");
|
||||
$self->_do_cmd("sc,5,$self->{pen_low}");
|
||||
$self->_do_cmd("sc,10,$self->{pen_speed}");
|
||||
$self->_do_cmd("sc,11,$self->{pen_up_speed}");
|
||||
$self->{'pen_state'} = 0;
|
||||
$self->pen_up();
|
||||
return $self;
|
||||
}
|
||||
|
||||
=head2 resync()
|
||||
|
||||
Synchronize with the EBB on the EggBot. Send the 'v' (version)
|
||||
command up to four times trying to get the EggBot to respond
|
||||
with the firmware version string. String should start with
|
||||
EBBv13_and_above or the sync will fail.
|
||||
|
||||
Returns true if resync was successful. Note when the instance
|
||||
is created it comes up in "sync", you only need to call this
|
||||
after a command has returned an error.
|
||||
=cut
|
||||
sub resync {
|
||||
my ($self) = @_;
|
||||
my $retries = 4;
|
||||
while ($retries > 0) {
|
||||
my ($e, $m) = $self->_do_cmd('v', 1);
|
||||
last if ($e == 0);
|
||||
$retries -= 1;
|
||||
}
|
||||
$self->{'sync'} = ($retries > 0);
|
||||
$self->{'error'} = 0;
|
||||
return $self->{'sync'};
|
||||
}
|
||||
|
||||
=head2 close( )
|
||||
|
||||
Close the access to the eggbot. Object cannot be
|
||||
re-used after this.
|
||||
=cut
|
||||
sub close {
|
||||
my ($self) = @_;
|
||||
close $self->{'fh'};
|
||||
}
|
||||
|
||||
=head2 motor_off()
|
||||
|
||||
Turn off the holding current to the stepper motors (they
|
||||
can be moved freely then and they will not be too hot)
|
||||
=cut
|
||||
sub motor_off {
|
||||
my ($self) = @_;
|
||||
|
||||
if (! $self->{'sync'}) {
|
||||
warn "Can't call motor_off: EggBot not sync'd\n";
|
||||
return;
|
||||
}
|
||||
my ($e, undef) = $self->_do_cmd('em,0,0');
|
||||
return $e;
|
||||
}
|
||||
|
||||
=head2 motor_on()
|
||||
|
||||
Enable the holding current to the stepper motors.
|
||||
=cut
|
||||
sub motor_on {
|
||||
my ($self) = @_;
|
||||
|
||||
if (! $self->{'sync'}) {
|
||||
warn "Can't call motor_on: EggBot not sync'd\n";
|
||||
return;
|
||||
}
|
||||
my ($e, undef) = $self->_do_cmd('em,1,1');
|
||||
return $e;
|
||||
}
|
||||
|
||||
=head2 pen_up()
|
||||
|
||||
Put the pen on the EggBot into the 'up' position.
|
||||
=cut
|
||||
sub pen_up {
|
||||
my ($self) = @_;
|
||||
|
||||
if (! $self->{'sync'}) {
|
||||
warn "Can't call pen_up: EggBot not sync'd\n";
|
||||
return;
|
||||
}
|
||||
return 0 if ($self->{'pen_state'} == 1);
|
||||
my ($e, undef) = $self->_do_cmd('sp,1');
|
||||
$self->{'pen_state'} = 1;
|
||||
print "Pen sleep ($self->{pen_delay}[1])\n" if $self->{'debug'};
|
||||
sleep($self->{'pen_delay'}[1]);
|
||||
return $e;
|
||||
}
|
||||
|
||||
=head2 pen_down()
|
||||
|
||||
Put the pen on the EggBot into the 'down' position.
|
||||
=cut
|
||||
sub pen_down {
|
||||
my ($self) = @_;
|
||||
|
||||
if (! $self->{'sync'}) {
|
||||
warn "Can't call pen_down: EggBot not sync'd\n";
|
||||
return;
|
||||
}
|
||||
return 0 if ($self->{'pen_state'} == 0);
|
||||
my ($e, $m) = $self->_do_cmd('sp,0');
|
||||
$self->{'pen_state'} = 0;
|
||||
print "Pen sleep ($self->{pen_delay}[0])\n" if $self->{'debug'};
|
||||
sleep($self->{'pen_delay'}[0]);
|
||||
return $e;
|
||||
}
|
||||
|
||||
=head2 set_home()
|
||||
|
||||
Set the 'home' (or 0,0) position for the current plot. Basically
|
||||
this resets the internal notion of where the EggBot thinks its
|
||||
currently drawn to, to 0,0. If you call home() it will send the
|
||||
plot back to this point.
|
||||
=cut
|
||||
sub set_home {
|
||||
my ($self) = @_;
|
||||
$self->{'cur_x'} = 0;
|
||||
$self->{'cur_y'} = 0;
|
||||
}
|
||||
|
||||
=head2 set_max(x, y)
|
||||
|
||||
Set the "maximum" extension of X and Y to these values.
|
||||
=cut
|
||||
sub set_max {
|
||||
my ($self, $x, $y) = @_;
|
||||
$self->{'max_x'} = $x;
|
||||
$self->{'max_y'} = $y;
|
||||
}
|
||||
|
||||
=head2 move_to(x, y)
|
||||
|
||||
Move the plotter (with the pen up) to absolute location (x, y)
|
||||
=cut
|
||||
sub move_to {
|
||||
my ($self, $x, $y) = @_;
|
||||
|
||||
$self->pen_up();
|
||||
$x = $self->{'max_x'} if ($x > $self->{'max_x'});
|
||||
$x = 0 if ($x < 0);
|
||||
$y = $self->{'max_y'} if ($y > $self->{'max_y'});
|
||||
$y = 0 if ($y < 0);
|
||||
if ($self->{'flip'}) {
|
||||
$x *= -1;
|
||||
$y *= -1;
|
||||
}
|
||||
my $dx = $x - $self->{'cur_x'};
|
||||
my $dy = $y - $self->{'cur_y'};
|
||||
my $dist = sqrt ($dx * $dx + $dy * $dy);
|
||||
my $delay = int ($dist * 1000.0 / $self->{'move_speed'});
|
||||
$self->{'cur_x'} = $x;
|
||||
$self->{'cur_y'} = $y;
|
||||
my ($e, $m) = $self->_do_cmd("sm,$delay,$dy,$dx");
|
||||
$delay *= .95;
|
||||
usleep($delay * 1000);
|
||||
return $e;
|
||||
}
|
||||
|
||||
=head2 draw_to(x, y)
|
||||
|
||||
Move the plotter (with the pen down) to absolute location (x, y)
|
||||
=cut
|
||||
sub draw_to {
|
||||
my ($self, $x, $y) = @_;
|
||||
|
||||
$self->pen_down();
|
||||
$x = $self->{'max_x'} if ($x > $self->{'max_x'});
|
||||
$x = 0 if ($x < 0);
|
||||
$y = $self->{'max_y'} if ($y > $self->{'max_y'});
|
||||
$y = 0 if ($y < 0);
|
||||
if ($self->{'flip'}) {
|
||||
$x *= -1;
|
||||
$y *= -1;
|
||||
}
|
||||
my $dx = $x - $self->{'cur_x'};
|
||||
my $dy = $y - $self->{'cur_y'};
|
||||
my $dist = sqrt ($dx * $dx + $dy * $dy);
|
||||
my $delay = int ($dist * 1000.0 / $self->{'draw_speed'});
|
||||
$self->{'cur_x'} = $x;
|
||||
$self->{'cur_y'} = $y;
|
||||
my ($e, $m) = $self->_do_cmd("sm,$delay,$dy,$dx");
|
||||
$delay *= .95;
|
||||
usleep($delay * 1000);
|
||||
return $e;
|
||||
}
|
||||
|
||||
# Utility routines - used by the class but not exported
|
||||
#
|
||||
# _do_cmd - send a command string to the egg_bot and collect
|
||||
# the response. Returns the response.
|
||||
sub _do_cmd {
|
||||
my ($self, $cmd, $sync) = @_;
|
||||
my $resp = "";
|
||||
my $fh = $self->{'fh'};
|
||||
my $verbose = $self->{'debug'};
|
||||
my $output;
|
||||
my $timeout = 50;
|
||||
my $result = "";
|
||||
|
||||
print ":$cmd -> " if $verbose;
|
||||
syswrite ($fh, "$cmd\r");
|
||||
usleep (100_000); # give it a bit to start responding
|
||||
while ($timeout) {
|
||||
my $c;
|
||||
my $cnt = sysread($fh, $c, 255);
|
||||
if ($cnt) {
|
||||
$resp .= $c;
|
||||
last if ($resp =~ /\n/);
|
||||
} else {
|
||||
$timeout--;
|
||||
usleep (100_000);
|
||||
}
|
||||
}
|
||||
my $error = 0;
|
||||
chomp($resp); # get rid of newline (if present)
|
||||
$resp =~ s/\r//g; # get rid of trailing <CR> if present
|
||||
if ($timeout == 0) {
|
||||
# fake an error message if we timed out
|
||||
$resp = "!0 Err:Timeout talking to board.";
|
||||
$error = 1;
|
||||
} elsif ($sync) {
|
||||
# on sync we're looking for the version banner
|
||||
$error = $resp !~ /^EBBv13_and_above/;
|
||||
} else {
|
||||
# otherwise message other than 'OK' is an error
|
||||
$error = $resp !~ /^OK$/;
|
||||
}
|
||||
print "$resp:\n" if $verbose;
|
||||
return ($error, $resp);
|
||||
}
|
||||
|
||||
# _setup_fd - this basically uses the POSIX termios
|
||||
# class to setup the serial port to be in 'raw' mode,
|
||||
# which is to say unbuffered, and without echo or translation
|
||||
# on the part of the OS.
|
||||
sub _setup_fd {
|
||||
my ($fd) = @_;
|
||||
|
||||
my $ti = POSIX::Termios->new() or die "No TERMIOS support!";
|
||||
$ti->setiflag( &POSIX::IGNBRK | &POSIX::IGNPAR);
|
||||
$ti->setoflag( 0 );
|
||||
$ti->setcflag( &POSIX::CS8 | &POSIX::CREAD | &POSIX::CLOCAL );
|
||||
$ti->setcc(&POSIX::VMIN, 1);
|
||||
#$ti->setcc(&POSIX::VTIME, 10);
|
||||
$ti->setispeed(&POSIX::B9600);
|
||||
$ti->setospeed(&POSIX::B9600);
|
||||
$ti->setattr($fd, &POSIX::TCSANOW);
|
||||
};
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -0,0 +1,107 @@
|
|||
# Simple HPGL interperter/reader for EggBot with Cairo preview
|
||||
# mode (saves on eggs)
|
||||
# Written Dec-2010 Chuck McManis
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package HPGL;
|
||||
|
||||
BEGIN {
|
||||
require Exporter;
|
||||
my @ISA = qw( Exporter );
|
||||
my @EXPORT_OK = qw( new );
|
||||
}
|
||||
|
||||
my %pens = (
|
||||
black => [0, 0, 0], #0
|
||||
blue => [0, 0, 1], #1
|
||||
red => [1, 0, 0], #2
|
||||
green => [0, 1, 0], #3
|
||||
magenta => [1, 0, 1], #4
|
||||
yellow => [1, 1, 0], #5
|
||||
cyan => [0, 1, 1], #6
|
||||
brown => [0, 1, 1], #7
|
||||
orange => [.7, 0.25, .25], #8
|
||||
);
|
||||
|
||||
# 0 1 2 3 4 5 6 7 8
|
||||
my @pen_colors = qw( black blue red green magenta yellow cyan brown orange);
|
||||
|
||||
|
||||
# this creates an in memory image of the HPGL plot
|
||||
# we assume that the plot was done with a lower left
|
||||
# hand origin (all positive numbers)
|
||||
sub new {
|
||||
my $self = shift;
|
||||
my $class = ref ($self) || $self;
|
||||
|
||||
my ($file, $verbose) = @_;
|
||||
$self = bless {}, $class;
|
||||
my %penplots;
|
||||
my $current_pen;
|
||||
my $points_array;
|
||||
my $points = 0;
|
||||
my ($xmin, $xmax, $ymin, $ymax) = (0, 0, 0, 0);
|
||||
|
||||
open (my $fh, "<", $file) or die "No such file $!\n";
|
||||
while (my $line = <$fh>) {
|
||||
chomp($line);
|
||||
my ($cmd, $arg) = $line =~ /([A-Z]{2})(.*);/;
|
||||
print "Command '$cmd' argument '$arg'\n" if $verbose;
|
||||
if ($cmd eq "SP") {
|
||||
($current_pen) = $arg =~/(\d+)/;
|
||||
$current_pen -= 1;
|
||||
last if ($current_pen == -1);
|
||||
$current_pen = $pen_colors[$current_pen];
|
||||
print "current pen set to $current_pen\n" if $verbose;
|
||||
if (not defined $penplots{$current_pen}) {
|
||||
$penplots{$current_pen} = [];
|
||||
}
|
||||
$points_array = $penplots{$current_pen};
|
||||
next;
|
||||
}
|
||||
next if (($cmd ne "PU") and ($cmd ne "PD"));
|
||||
die "no current pen\n" if (!defined $current_pen);
|
||||
|
||||
my ($x, $y) = $arg =~ /([\-0-9]+)\s+([\-0-9]+)/;
|
||||
if ($cmd eq "PU") {
|
||||
push @{$points_array}, ['m', $x, $y];
|
||||
} elsif ($cmd eq "PD") {
|
||||
push @{$points_array}, ['d', $x, $y];
|
||||
}
|
||||
$points += 1;
|
||||
print " [ $x, $y] = '$line'\n" if $verbose;
|
||||
$xmin = $x if ($x < $xmin);
|
||||
$ymin = $y if ($y < $ymin);
|
||||
$xmax = $x if ($x > $xmax);
|
||||
$ymax = $y if ($y > $ymax);
|
||||
}
|
||||
$self->{'plots'} = \%penplots;
|
||||
$self->{'points'} = $points;
|
||||
$self->{'size'} = [$xmax, $ymax];
|
||||
$self->{'origin'} = [0, 0]; # reserved
|
||||
$self->{'scale'} = 1.0;
|
||||
$self->{'size'} = [$xmax - $xmin, $ymax - $ymin];
|
||||
close $fh;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# Return a list of pens used in this plot
|
||||
sub pens {
|
||||
my ($self) = @_;
|
||||
my @used_pens = sort keys %{$self->{'plots'}};
|
||||
return \@used_pens;
|
||||
}
|
||||
|
||||
# return the drawing/moving commands for this pen
|
||||
sub points {
|
||||
my ($self, $pen) = @_;
|
||||
return $self->{'plots'}{$pen};
|
||||
}
|
||||
|
||||
# return the plot 'size' in plot units
|
||||
sub size {
|
||||
my ($self) = @_;
|
||||
my @d = @{$self->{'size'}};
|
||||
return @d;
|
||||
}
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
Perl support for the EggBot
|
||||
|
||||
This is some code I've hacked together to drive the EggBot using perl scripts.
|
||||
It should be fairly easy to port it to other languages if you want although
|
||||
the existing Eggbot extension scripts are in Python.
|
||||
|
||||
EggBot.pm - this is the core module, use EggBot->new() to instantiate a new
|
||||
eggbot controller object.
|
||||
|
||||
HPGL.pm - Parse (simply) the HPGL language. HPGL ".PLT" files are very simple
|
||||
text files consisting of PU (pen up) and PD (pen down) commands which
|
||||
are analogs for move_to and draw_to operations. SP (set pen) sets the
|
||||
current pen color. HPGL will collect all the lines drawn by each color
|
||||
into a separate list.
|
||||
|
||||
egg_drive.pl - a program that uses EggBot.pm and lets you send arbitrary
|
||||
commands to the EBB. This can substitute for a terminal connection
|
||||
since it lets you send any string through.
|
||||
|
||||
egg_plot.pl - reads an HPGL file, and then after asking you to home the pen
|
||||
plots it. It will stop and ask for pen changes based on the
|
||||
HP standard pen colors (for pens 1 through 8).
|
||||
|
||||
preview-plot.pl - this does what egg_plot does except that rather than send
|
||||
the plot to an egg it creates a PNG (portable network graphics)
|
||||
bitmap file which represents what would have been plotted. Since
|
||||
it doesn't show the warping that occurs from the round surface
|
||||
of the egg.
|
||||
|
||||
svg-test.pl - this was a test program I wrote to see if perl could parse
|
||||
SVG files (uh doh!) and got worried that it would take too long
|
||||
to deal with two new technologies (SVG + EggBot) and reduced it
|
||||
to one (EggBot) by switching to HPGL (which many graphics programs
|
||||
support out of the box).
|
||||
|
||||
--Chuck
|
||||
December 2010
|
||||
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
#!/usr/bin/perl
|
||||
# command processor for Egg Bot
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Getopt::Long;
|
||||
use EggBot qw( new );
|
||||
|
||||
my $verbose = 1;
|
||||
|
||||
GetOptions(
|
||||
"--verbose+" => \$verbose,
|
||||
);
|
||||
|
||||
print "Egg Bot Commander.\n";
|
||||
my $egg = EggBot->new(debug => 1, limits => "3200,1000");
|
||||
print "EggBot not found!\n" if (! defined $egg);
|
||||
exit 1 if (! defined $egg);
|
||||
|
||||
print "Opened access to the Egg Bot\n";
|
||||
|
||||
while (1) {
|
||||
print "enter something : ";
|
||||
my $thing = <STDIN>;
|
||||
chomp($thing);
|
||||
next if (not defined $thing);
|
||||
print "attempting to send command $thing...\n";
|
||||
my $result = $egg->_do_cmd($thing);
|
||||
last if ($thing =~ /exit/);
|
||||
}
|
||||
|
||||
$egg->close();
|
||||
|
||||
|
|
@ -0,0 +1,155 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use EggBot;
|
||||
use HPGL;
|
||||
use Getopt::Long;
|
||||
|
||||
my $dev = "/dev/ttyACM0";
|
||||
my $test_num = -1;
|
||||
my $limit = "3200,1000";
|
||||
my $verbose = 0;
|
||||
my $flip = 0;
|
||||
|
||||
GetOptions(
|
||||
'port|device=s' => \$dev,
|
||||
'test=i' => \$test_num,
|
||||
'limits=s' => \$limit,
|
||||
'debug+' => \$verbose,
|
||||
'flip+' => \$flip,
|
||||
);
|
||||
|
||||
print "EggPlot v0.5, Dec 2010 by C. McManis\n";
|
||||
my $egg = EggBot->new(device => $dev,
|
||||
debug => $verbose,
|
||||
flip => $flip,
|
||||
limits => $limit)
|
||||
|| die "Cannot talk to the EggBot.\n";
|
||||
|
||||
print "EggBot found!\n";
|
||||
$egg->motor_off();
|
||||
$egg->pen_up();
|
||||
my $pi = 3.141592654;
|
||||
my $deg2rad = $pi / 180.0;
|
||||
|
||||
if ($test_num == 1) {
|
||||
print "Test 1:\n Move pen to home position.\n";
|
||||
print "Then hit enter when ready to plot.\n";
|
||||
my $line = <STDIN>;
|
||||
$egg->motor_on();
|
||||
$egg->set_home();
|
||||
test1();
|
||||
exit 0;
|
||||
} elsif ($test_num == 2) {
|
||||
print "Test 2:\n Move pen to home position.\n";
|
||||
print "Then hit enter when ready to plot.\n";
|
||||
my $line = <STDIN>;
|
||||
$egg->motor_on();
|
||||
$egg->set_home();
|
||||
test2();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
my $filename = shift @ARGV;
|
||||
die "Nothing to plot" if (not defined $filename);
|
||||
print "Reading $filename ...";
|
||||
my $plt = HPGL->new($filename);
|
||||
if (defined $plt) {
|
||||
my ($w, $h) = $plt->size();
|
||||
print "Done.\n Move pen to home position.\n";
|
||||
print "Then hit enter when ready to plot.\n";
|
||||
print "Plot is $w wide by $h tall.\n";
|
||||
print "Note output is FLIPPED.\n" if $flip;
|
||||
my $line = <STDIN>;
|
||||
$egg->motor_on();
|
||||
$egg->set_home();
|
||||
print "Read in $filename.\n";
|
||||
print "It uses the following pens: \n";
|
||||
my $pens = $plt->pens();
|
||||
my @pen_list = grep (!/black/, @{$pens});
|
||||
push @pen_list, "black";
|
||||
foreach my $p (@pen_list) {
|
||||
my $points = $plt->points($p);
|
||||
$egg->pen_up();
|
||||
print "Please put in the $p colored pen and press enter.\n";
|
||||
my $xx = <STDIN>;
|
||||
print "Plotting ", scalar @{$points}," points in $p\n";
|
||||
foreach my $cmd (@{$points}) {
|
||||
my ($nx, $ny) = ($cmd->[1], $cmd->[2]);
|
||||
|
||||
if ($cmd->[0] eq 'm') {
|
||||
$egg->move_to($nx, $ny);
|
||||
} elsif ($cmd->[0] eq 'd') {
|
||||
$egg->draw_to($nx, $ny);
|
||||
}
|
||||
}
|
||||
}
|
||||
$egg->pen_up();
|
||||
$egg->motor_off();
|
||||
}
|
||||
exit 0;
|
||||
# Test 2 really checks to see if the pen up/down
|
||||
# logic is working correctly. It draws a few
|
||||
# circles of varying size.
|
||||
#
|
||||
test2();
|
||||
$egg->motor_off();
|
||||
$egg->close();
|
||||
sub test2 {
|
||||
my @circles = (
|
||||
[50, 50, 50],
|
||||
[100, 400, 50],
|
||||
[300, 600, 100],
|
||||
[400, 500, 75],
|
||||
[475, 425, 50],
|
||||
[525, 375, 25]
|
||||
);
|
||||
foreach my $c (@circles) {
|
||||
circle(@{$c});
|
||||
}
|
||||
}
|
||||
|
||||
# Test 1 draws lines back and forth the full Y travel
|
||||
# and completely around the egg/ball. It gives a good
|
||||
# example of linearity of the setup.
|
||||
sub test1 {
|
||||
my @lines = (
|
||||
[0, 0],
|
||||
[0, 800],
|
||||
[200, 800],
|
||||
[200, 0]
|
||||
);
|
||||
for (my $x = 0; $x < 3200; $x += 400) {
|
||||
foreach my $p (@lines) {
|
||||
my $err = $egg->draw_to($x+$p->[0], $p->[1]);
|
||||
if ($err) {
|
||||
print "Eggbot returned an error.\n";
|
||||
$egg->motor_off();
|
||||
exit 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# utility routine to draw circles as 36 segments.
|
||||
sub circle {
|
||||
my ($x, $y, $r) = @_;
|
||||
|
||||
print "Draw circle @ [$x, $y] of radius $r\n";
|
||||
if ($egg->move_to($x+$r, $y)) {
|
||||
print "EggBot error.\n";
|
||||
$egg->motor_off();
|
||||
exit(1);
|
||||
}
|
||||
for (my $i = 0; $i <= 360; $i += 10) {
|
||||
my ($nx, $ny);
|
||||
$nx = $x + int ($r * cos($i*$deg2rad) + 0.5);
|
||||
$ny = $y + int ($r * sin($i*$deg2rad) + 0.5);
|
||||
if ($egg->draw_to($nx, $ny)) {
|
||||
print "EggBot error.\n";
|
||||
$egg->motor_off();
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,97 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use Cairo;
|
||||
use HPGL;
|
||||
use Getopt::Long;
|
||||
|
||||
my $output_file = "plot-preview.png";
|
||||
my $verbose = 0;
|
||||
|
||||
GetOptions(
|
||||
"output=s" => \$output_file,
|
||||
"verbose+" => \$verbose,
|
||||
);
|
||||
|
||||
# read in the .plt file
|
||||
my $file = shift @ARGV;
|
||||
my $plt = HPGL->new($file) or die "Can't read $file\n";
|
||||
|
||||
# these are the default pens
|
||||
my %pens = (
|
||||
black => [0, 0, 0], #0
|
||||
blue => [0, 0, 1], #1
|
||||
red => [1, 0, 0], #2
|
||||
green => [0, 1, 0], #3
|
||||
magenta => [1, 0, 1], #4
|
||||
yellow => [1, 1, 0], #5
|
||||
cyan => [0, 1, 1], #6
|
||||
brown => [0, 1, 1], #7
|
||||
orange => [.7, 0.25, .25], #8
|
||||
);
|
||||
|
||||
my ($max_x, $max_y) = $plt->size();
|
||||
print "Preview plot of $file, its size is [$max_x, $max_y]\n";
|
||||
my $surface = Cairo::ImageSurface->create('argb32', $max_x, $max_y);
|
||||
my $ctx = Cairo::Context->create($surface);
|
||||
$ctx->set_source_rgb(1, 1, 1);
|
||||
$ctx->rectangle(0, 0, $max_x, $max_y);
|
||||
$ctx->fill();
|
||||
my $pen_list = $plt->pens();
|
||||
|
||||
# put 'black' on at the end of the list
|
||||
my @pen_order = grep(!/black/, @{$pen_list});
|
||||
push @pen_order, 'black';
|
||||
|
||||
foreach my $pen_color (@pen_order) {
|
||||
print "Plotting color: $pen_color\n";
|
||||
$ctx->set_source_rgb(@{$pens{$pen_color}});
|
||||
my $points = $plt->points($pen_color);
|
||||
my $cnt = 0;
|
||||
foreach my $p (@{$points}) {
|
||||
$cnt += 1;
|
||||
# account for different plot layout PNG vs EggBot
|
||||
my $nx;
|
||||
my $ny;
|
||||
$nx = $p->[1];
|
||||
$ny = $max_y - $p->[2];
|
||||
if ($p->[0] eq 'm') {
|
||||
$ctx->move_to($nx, $ny);
|
||||
} else {
|
||||
$ctx->line_to($nx, $ny);
|
||||
}
|
||||
}
|
||||
print "Plotted $cnt points in that color.\n";
|
||||
$ctx->stroke();
|
||||
}
|
||||
$surface->write_to_png("plot-preview.png");
|
||||
|
||||
# figure out all the line segments in a plot color
|
||||
sub segments {
|
||||
my ($points) = @_;
|
||||
my @segs;
|
||||
# assume we start from zero
|
||||
my ($cur_x, $cur_y) = (0, 0);
|
||||
foreach my $p (@{$points}) {
|
||||
if ($p->[0] eq 'd') {
|
||||
# create a segment if drawing
|
||||
push @segs, [$cur_x, $cur_y, $p->[1], $p->[2]];
|
||||
}
|
||||
# always update the current cursor
|
||||
($cur_x, $cur_y) = ($p->[1], $p->[2]);
|
||||
}
|
||||
}
|
||||
# now @segs has all line segments we expect
|
||||
# to draw
|
||||
# Go through them and build connected paths
|
||||
my @paths;
|
||||
my @segs2;
|
||||
while (1) {
|
||||
my $p = shift @segs; # grab first segment
|
||||
my ($ex, $ey) = ($p->[2], $p->[3]); # end of segment
|
||||
while (my $n = shift @segs) {
|
||||
if ($s2[0] == $s[2] and $s2[1] eq $s[3]) {
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
#!/usr/bin/perl
|
||||
# testing SVG support in perl
|
||||
use strict;
|
||||
use warnings;
|
||||
use SVG;
|
||||
use SVG::Parser;
|
||||
|
||||
my $svg= SVG->new(width=>3200, height=>800);
|
||||
$svg->circle(id=>'my_circle', cx=>100, cy=>100, r=>50);
|
||||
my $out = $svg->xmlify;
|
||||
print $out;
|
||||
|
||||
my $parser = SVG::Parser->new(-debug => 1);
|
||||
|
||||
my $xml;
|
||||
{
|
||||
local $/=undef;
|
||||
open (my $fh, "<", "three-boxes.svg");
|
||||
$xml = <$fh>;
|
||||
close $fh;
|
||||
}
|
||||
my $svg2 = $parser->parse($xml);
|
||||
print "Parsed the svg file\n";
|
||||
my $gc = $svg2->getChildren();
|
||||
print "Fetched children from svg they were:\n";
|
||||
foreach my $c (@{$gc}) {
|
||||
tree_walk($c, "");
|
||||
}
|
||||
my $element_count;
|
||||
|
||||
print "Printed out $element_count elements.\n";
|
||||
|
||||
|
||||
sub tree_walk {
|
||||
my ($el, $ndent) = @_;
|
||||
my $children;
|
||||
$element_count += 1;
|
||||
$children = $el->{'-childs'};
|
||||
if (defined $children) {
|
||||
print "Node has ", scalar @{$children}," children.\n";
|
||||
}
|
||||
foreach my $ele (@{$children}) {
|
||||
tree_walk($ele, $ndent . " ");
|
||||
}
|
||||
foreach my $k (keys %{$el}) {
|
||||
print "$ndent $k: --> $el->{$k}\n";
|
||||
}
|
||||
}
|
||||
Ładowanie…
Reference in New Issue