Perl Lasic driver - basic module, PBM renderer and two example scripts.

Untested with real hardware yet.

perl/Brm/Lasic.pm

@@ -0,0 +1,179 @@
+package Brm::Lasic;
+
+=head1 NAME
+
+Brm::Lasic - interface for the brmlab lasercutter
+
+=head1 SYNOPSIS
+
+use Brm::Lasic;
+
+ $lasic = Brm::Lasic->new(dev => '/dev/ttyUSB0');
+ $lasic->reset();
+ $lasic->focus(-3);
+ $lasic->laser_on();
+ $lasic->move(40, 20);
+ $lasic->move(80, 0);
+ $lasic->laser_off();
+
+=cut
+
+use Moose;
+use Device::SerialPort;
+
+use warnings;
+use strict;
+
+our $VERSION = '0.1';
+$VERSION = eval $VERSION;
+
+=head1 DESCRIPTION
+
+Brm::Lasic instance represents a laser cutter.
+You can directly use the basic functions like moving the laser,
+turning the laser on/off etc.
+Further add-ons provide extended functionality
+like rendering a picture.
+
+=head2 ATTRIBUTES
+
+=over 4
+
+=item B<dev>
+
+Name with the tty device associated with Lasic serial port.
+=cut
+has 'dev' => (is => 'ro', isa => 'Str', required => 1);
+
+=item B<port>
+
+The tty device object. Avoid using directly.
+=cut
+has 'port' => (is => 'rw', isa => 'Device::SerialPort');
+
+=item B<fd>
+
+The tty device filehandle. Avoid using directly.
+=cut
+has 'fd' => (is => 'rw', isa => 'Device::SerialPort');
+
+=back
+
+=head2 METHODS
+
+=over 4
+
+=item B<new>(dev => tty device name)
+
+The dev attribute must be specified.
+=cut
+
+sub BUILD {
+	my $self = shift;
+
+	use Symbol qw(gensym);
+	my $fd = gensym();
+	my $port = tie(*$fd, "Device::SerialPort", $self->dev());
+	$port or die $self->dev().": $!";
+	$self->port($port);
+	$self->fd($fd);
+
+	$self->port->datatype('raw');
+	$self->port->baudrate(115200);
+	$self->port->databits(8);
+	$self->port->parity("none");
+	$self->port->stopbits(1);
+	$self->port->handshake("none");
+	$self->port->write_settings();
+}
+
+=item B<reset>
+
+Reset the laser cutter. This makes the cutter re-calibrate itself
+in both axes and then moves to the (0, 0) position.
+=cut
+
+sub reset {
+	my $self = shift;
+	$self->msg('s', 1);
+}
+
+=item B<focus>($steps)
+
+Adjust focus. $steps (positive for down, negative for up)
+denotes the number of focus adjustment steps.
+=cut
+
+sub focus {
+	my $self = shift;
+	my ($steps) = @_;
+	if ($steps > 0) {
+		$self->msg('s', 3) for (1..$steps);
+	} else {
+		$self->msg('s', 2) for (1..-$steps);
+	}
+}
+
+=item B<laser_on>
+
+Turn on the laser (to etching intensity).
+=cut
+
+sub laser_on {
+	my $self = shift;
+	$self->msg('l', 254);
+}
+
+=item B<laser_off>
+
+Turn off the laser (to navigation intensity).
+=cut
+
+sub laser_off {
+	my $self = shift;
+	$self->msg('l', 0);
+}
+
+=item B<move>($x, $y)
+
+=item B<move>($x, $y, $speed)
+
+Move the laser to given coordinates.
+If $speed is not specified (recommended), a reasonable default is used.
+=cut
+
+sub move {
+	my $self = shift;
+	my ($x, $y, $speed) = @_;
+	defined $speed or $speed = 20;
+	$self->msg('v', $speed, $x, $y);
+}
+
+=item B<msg>(...)
+
+Send a message to the serial port and wait for its completion.
+=cut
+
+sub msg {
+	my $self = shift;
+
+	my (@args) = @_;
+	push @args, 1;
+
+	my $fd = $self->fd();
+	print $fd join(' ', @args)."\r\n";
+	my $msg = <$fd>;
+	chomp $msg;
+	print "(rep: $msg)\n";
+}
+
+=back
+
+=head1 COPYRIGHT
+
+(c) 2011 Petr Baudis E<lt>pasky@ucw.czE<gt>.
+This module may be redistributed using the same terms as Perl itself.
+
+=cut
+
+1;

perl/Brm/Lasic/PBM.pm

@@ -0,0 +1,104 @@
+package Brm::Lasic::PBM;
+
+=head1 NAME
+
+Brm::Lasic::PBM - Render PBM using Brm::Lasic
+
+=head1 SYNOPSIS
+
+use Brm::Lasic::PBM;
+
+ my $lasic = Brm::Lasic->new(dev => '/dev/ttyUSB0');
+ $lasic->reset();
+ my $pbm = Brm::Lasic::PBM(lasic => $lasic, file => 'brm.pbm');
+ $pbm->render();
+
+=cut
+
+use Moose;
+
+use warnings;
+use strict;
+
+our $VERSION = '0.1';
+$VERSION = eval $VERSION;
+
+=head1 DESCRIPTION
+
+Render a bitmap picture from PBM file using Brm::Lasic lasercutter.
+
+=head2 ATTRIBUTES
+
+=over 4
+
+=item B<lasic>
+
+Lasercutter instance.
+=cut
+#has 'lasic' => (is => 'ro', isa => 'Brm::Lasic', required => 1);
+
+=item B<file>
+
+Filename of the picture.
+=cut
+has 'file' => (is => 'ro', isa => 'Str', required => 1);
+
+=item B<pixeltime>
+
+Length of etching per pixel in milliseconds;
+a reasonable default is provided but this depends on the material.
+=cut
+has 'pixeltime' => (is => 'ro', isa => 'Num', default => 200, required => 1);
+
+=back
+
+=head2 METHODS
+
+=over 4
+
+=item B<new>(lasic => Brm::Lasic, file => bitmap filename)
+=item B<new>(lasic => Brm::Lasic, file => bitmap filename, pixeltime => ms)
+
+The lasic and file attributes must be specified.
+
+=item B<render>
+
+Engrave the image on the laser cutter.
+=cut
+
+sub render {
+	my $self = shift;
+	my ($w, $h, @bitmap);
+
+	open my $fd, $self->file or die $self->file.": $!";
+	# Two silly lines.
+	<$fd>; <$fd>;
+	my $dim = <$fd>; chomp $dim;
+	($w, $h) = split(/ /, $dim);
+	my @bits = <$fd>; chomp @bits;
+	@bitmap = map { split('', $_) } @bits;
+	close $fd;
+
+	for my $y (0..$h-1) {
+		for my $x (0..$w-1) {
+			my $bit = $bitmap[$y * $h + $x];
+			$bit or next;
+			$self->lasic->move($x, $y);
+			$self->lasic->laser_on();
+			use Time::HiRes;
+			Time::HiRes::usleep($self->pixeltime * 1000);
+			$self->lasic->laser_off();
+		}
+	}
+}
+
+=back
+
+=head1 COPYRIGHT
+
+(c) 2011 Petr Baudis E<lt>pasky@ucw.czE<gt>.
+This module may be redistributed using the same terms as Perl itself.
+
+=cut
+
+1;

perl/box.pl

@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+#
+# Simple Brm::Lasic example - draw a 100x100 rectangle.
+
+use warnings;
+use strict;
+
+use lib qw(.);
+use Brm::Lasic;
+
+my $lasic = Brm::Lasic->new(dev => '/dev/ttyUSB0');
+$lasic->reset();
+
+$lasic->focus(-2);
+$lasic->focus(2);
+
+$lasic->laser_on();
+$lasic->move(100, 0);
+$lasic->move(0, 100);
+$lasic->move(-100, 0);
+$lasic->move(0, -100);
+$lasic->laser_off();

perl/render.pl

@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+#
+# Render a PBM image using Brm::Lasic - pass it as a parameter!
+
+use warnings;
+use strict;
+
+use lib qw(.);
+use Brm::Lasic;
+use Brm::Lasic::PBM;
+
+my $lasic = Brm::Lasic->new(dev => '/dev/ttyUSB0');
+$lasic->reset();
+
+my $pbm = Brm::Lasic::PBM->new(lasic => $lasic, file => $ARGV[0]);
+$pbm->render();