From 538247e00b5bbf14e4328ed76f77e7896198b9a7 Mon Sep 17 00:00:00 2001 From: "chuck.mcmanis" Date: Tue, 21 Dec 2010 21:41:16 +0000 Subject: [PATCH] initial checkin of perl support git-svn-id: https://eggbotcode.googlecode.com/svn/trunk@185 72233254-1b6c-9e9c-5072-401df62706fb --- EggBot-Perl/EggBot.pm | 337 ++++++++++++++++++++++++++++++++++++ EggBot-Perl/HPGL.pm | 107 ++++++++++++ EggBot-Perl/README | 38 ++++ EggBot-Perl/egg_drive.pl | 33 ++++ EggBot-Perl/egg_plot.pl | 155 +++++++++++++++++ EggBot-Perl/preview-plot.pl | 97 +++++++++++ EggBot-Perl/svg-test.pl | 48 +++++ 7 files changed, 815 insertions(+) create mode 100755 EggBot-Perl/EggBot.pm create mode 100755 EggBot-Perl/HPGL.pm create mode 100644 EggBot-Perl/README create mode 100755 EggBot-Perl/egg_drive.pl create mode 100755 EggBot-Perl/egg_plot.pl create mode 100755 EggBot-Perl/preview-plot.pl create mode 100755 EggBot-Perl/svg-test.pl diff --git a/EggBot-Perl/EggBot.pm b/EggBot-Perl/EggBot.pm new file mode 100755 index 0000000..6190ac1 --- /dev/null +++ b/EggBot-Perl/EggBot.pm @@ -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 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; + diff --git a/EggBot-Perl/HPGL.pm b/EggBot-Perl/HPGL.pm new file mode 100755 index 0000000..d335b03 --- /dev/null +++ b/EggBot-Perl/HPGL.pm @@ -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; +} diff --git a/EggBot-Perl/README b/EggBot-Perl/README new file mode 100644 index 0000000..2e9ac6a --- /dev/null +++ b/EggBot-Perl/README @@ -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 + diff --git a/EggBot-Perl/egg_drive.pl b/EggBot-Perl/egg_drive.pl new file mode 100755 index 0000000..035f08e --- /dev/null +++ b/EggBot-Perl/egg_drive.pl @@ -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 = ; + 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(); + diff --git a/EggBot-Perl/egg_plot.pl b/EggBot-Perl/egg_plot.pl new file mode 100755 index 0000000..e46a40d --- /dev/null +++ b/EggBot-Perl/egg_plot.pl @@ -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 = ; + $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 = ; + $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 = ; + $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 = ; + 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); + } + } +} diff --git a/EggBot-Perl/preview-plot.pl b/EggBot-Perl/preview-plot.pl new file mode 100755 index 0000000..7da6870 --- /dev/null +++ b/EggBot-Perl/preview-plot.pl @@ -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]) { + } + } + } +} diff --git a/EggBot-Perl/svg-test.pl b/EggBot-Perl/svg-test.pl new file mode 100755 index 0000000..fd5faab --- /dev/null +++ b/EggBot-Perl/svg-test.pl @@ -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"; + } +}