Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 390 lines (308 sloc) 8.406 kb
3e5b371a »
2011-02-14 Initial commit.
1 package Firmata;
2
3 use Moose;
4 extends 'Reflex::Base';
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
5 use Reflex::Trait::EmitsOnChange qw(emits);
f9ce8bec »
2012-06-19 Fix for latest Reflex.
6 use Reflex::Callbacks qw(make_emitter make_terminal_emitter);
3e5b371a »
2011-02-14 Initial commit.
7
270559a2 »
2011-02-27 Properly parse Firmata strings.
8 use Carp qw(croak);
9
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
10 # TODO - This would rock more as a role.
11
3e5b371a »
2011-02-14 Initial commit.
12 has handle => ( isa => 'FileHandle', is => 'rw' );
f9ce8bec »
2012-06-19 Fix for latest Reflex.
13 has active => ( is => 'ro', isa => 'Bool', default => 1 );
3e5b371a »
2011-02-14 Initial commit.
14
f9ce8bec »
2012-06-19 Fix for latest Reflex.
15 with 'Reflex::Role::Streaming' => {
16 att_handle => 'handle',
17 att_active => 'active',
18 cb_error => make_emitter(on_error => "error"),
19 cb_closed => make_terminal_emitter(on_closed => "closed"),
20 };
3e5b371a »
2011-02-14 Initial commit.
21
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
22 has init_wait => ( isa => 'Num', is => 'rw', default => 10 );
23 has init_wait_autostart => ( isa => 'Bool', is => 'ro', default => 0 );
24 with 'Reflex::Role::Timeout' => {
25 att_delay => 'init_wait',
26 att_auto_start => 'init_wait_autostart',
27 };
28
3e5b371a »
2011-02-14 Initial commit.
29 has buffer => ( isa => 'Str', is => 'rw', default => '' );
30
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
31 # Whee.
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
32 emits protocol_version => ( is => 'rw', isa => 'Num' );
33 emits protocol_string => ( is => 'rw', isa => 'Str' );
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
34
35 {
36 package Firmata::Pin;
37 use Moose;
38
39 has id => ( is => 'ro', isa => 'Int' );
40 has mode => ( is => 'rw', isa => 'Int' );
41 has capabilities => ( is => 'rw', isa => 'ArrayRef[Int]' );
42 }
43
44 has pins => (
45 is => 'rw',
46 isa => 'ArrayRef[Maybe[Firmata::Pin]]',
47 default => sub { [] },
48 );
49
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
50 sub on_handle_error {
51 my ($self, $arg) = @_;
52 use YAML;
53 warn YAML::Dump($arg);
54 }
55
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
56 before put_handle => sub {
57 my ($self, $message) = @_;
58 print "--> ", $self->hexify($message), "\n";
59 };
60
61 sub analog_report {
62 my ($self, $port, $bool) = @_;
63 my $message = chr(0xC0 | ($port & 0x0F)) . chr((!!$bool) || 0);
64 $self->put_handle($message);
65 }
66
678be02c »
2011-03-01 Figure out digital I/O. A little baroque, but it makes sense.
67 # XXX - digital_report() works on ATMEGA ports, not discrete pins.
68 # TODO - If we want a pin API, we need to remember which pins we're
69 # polling, manipulate them as bits, and write the resulting bytes.
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
70
71 sub digital_report {
72 my ($self, $port, $bool) = @_;
678be02c »
2011-03-01 Figure out digital I/O. A little baroque, but it makes sense.
73 my $message = chr(0xD0 | ($port & 0x0F)) . chr($bool & 0x7F);
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
74 $self->put_handle($message);
75 }
76
77 ### Set Pin Mode
78
79 sub digital_in {
80 my ($self, $pin) = @_;
81 my $message = "\xF4" . chr($pin & 0x7F) . "\x00";
82 $self->put_handle($message);
83 }
84
85 sub digital_out {
86 my ($self, $pin) = @_;
87 my $message = "\xF4" . chr($pin & 0x7F) . "\x01";
88 $self->put_handle($message);
89 }
90
91 sub analog_in {
92 my ($self, $pin) = @_;
93 my $message = "\xF4" . chr($pin & 0x7F) . "\x02";
94 $self->put_handle($message);
95 }
96
97 sub pwm_out {
98 my ($self, $pin) = @_;
99 my $message = "\xF4" . chr($pin & 0x7F) . "\x03";
100 $self->put_handle($message);
101 }
102
103 sub servo_out {
104 my ($self, $pin) = @_;
105 my $message = "\xF4" . chr($pin & 0x7F) . "\x04";
106 $self->put_handle($message);
107 }
108
109 ### Sampling Interval
110
111 sub sample {
112 my ($self, $interval) = @_;
113 my $message = (
114 "\xF0\x7A" .
115 chr($interval & 0x7F) . chr( ($interval >> 7) & 0x7F) .
116 "\xF7"
117 );
118
119 $self->put_handle($message);
120 }
121
122
123
124 sub digital_set {
678be02c »
2011-03-01 Figure out digital I/O. A little baroque, but it makes sense.
125 my ($self, $port, $value) = @_;
126
127 my $message = (
128 chr( 0x90 | ($port & 0x0F) ) .
129 chr($value & 0x7F) .
130 chr(($value >> 7) & 0x7F)
131 );
132
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
133 $self->put_handle($message);
134 }
135
3e5b371a »
2011-02-14 Initial commit.
136 sub on_handle_data {
137 my ($self, $args) = @_;
138
f9ce8bec »
2012-06-19 Fix for latest Reflex.
139 my $buffer = $self->buffer() . ($args->octets());
3e5b371a »
2011-02-14 Initial commit.
140
141 # TODO - Cheezy, slow. Do better.
142
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
143 while (length $buffer) {
144
145 # Discard leading non-command data.
146 # This can occur on a framing error.
147 next if $buffer =~ s/^[\x00-\x7f]//;
148
149 # Protocol version.
3e5b371a »
2011-02-14 Initial commit.
150
151 if ($buffer =~ s/^\xF9(..)//s) {
152 my ($maj, $min) = unpack("CC", $1);
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
153 my $new_version = "$maj.$min";
154
155 my $old_version = $self->protocol_version();
156 if (defined $old_version) {
157 next if $old_version == $new_version;
158 warn "Version changed from $old_version to $new_version";
159 }
160
161 $self->protocol_version($new_version);
3e5b371a »
2011-02-14 Initial commit.
162 next;
163 }
164
165 # SysEx? Ogods!
166
167 if ($buffer =~ s/^\xF0\x79(..)(.*?)\xF7//s) {
168 my ($maj, $min) = unpack("CC", $1);
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
169 my $new_string = $self->firmata_string_parse($2);
3e5b371a »
2011-02-14 Initial commit.
170
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
171 my $new_version = "$maj.$min";
172
173 my $old_version = $self->protocol_version();
174 if (defined $old_version) {
175 unless ($old_version == $new_version) {
176 warn "Version changed from $old_version to $new_version";
177 $self->protocol_version($new_version);
178 }
179 }
180 else {
181 # This one's silent.
182 $self->protocol_version($new_version);
183 }
184
185 my $old_string = $self->protocol_string();
186 if (defined $old_string) {
187 unless ($old_string eq $new_string) {
188 warn "Version string changed from '$old_string' to '$new_string'";
189 $self->protocol_string($new_string);
190 }
191 }
192 else {
193 # This one's silent.
194 $self->protocol_string($new_string);
195 }
3e5b371a »
2011-02-14 Initial commit.
196
197 next;
198 }
199
200 # String SysEx.
201
202 if ($buffer =~ s/^\xF0\x71(.*?)\xF7//s) {
270559a2 »
2011-02-27 Properly parse Firmata strings.
203 my $string = $self->firmata_string_parse($1);
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
204 if (0) {
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
205 $self->emit(
206 event => "string",
207 args => {
208 string => $string,
209 },
210 );
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
211 }
3e5b371a »
2011-02-14 Initial commit.
212 next;
213 }
214
215 # Capability SysEx.
216
217 if ($buffer =~ s/^\xF0\x6C(.*?)\xF7//s) {
218 my $raw = $1;
219 my @pins = ($raw =~ m/([^\x7F]*)\x7F/g);
220
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
221 my @new_pins;
222
3e5b371a »
2011-02-14 Initial commit.
223 my $pin = 0;
224 foreach my $modes (@pins) {
225 foreach my $mode ($modes =~ m/(..)/sg) {
226 my ($m, $r) = unpack "CC", $mode;
227
228 my $text = [
229 qw(
230 input
231 output
232 analog
233 pwm
234 servo
235 shift
236 i2c
237 )
238 ]->[$m];
239
240 print "<-- pin $pin can $text ($r)\n";
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
241
242 $new_pins[$pin] = Firmata::Pin->new(
243 id => $pin,
244 mode => 0,
245 capabilities => [ ],
246 );
3e5b371a »
2011-02-14 Initial commit.
247 }
248
249 $pin++;
250 }
251
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
252 $self->pins(\@new_pins);
253
254 # TODO - It would be awesome to make the pins attribute-based
255 # with emits/observes traits and all. Problem is, we need to
256 # build those attributes at runtime after the object has been
257 # running for a little while.
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
258
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
259 $self->emit(
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
260 event => "initialized",
261 args => { }, # TODO - What?!
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
262 );
263
3e5b371a »
2011-02-14 Initial commit.
264 next;
265 }
266
267 # Unknown SysEx.
268
269 if ($buffer =~ s/^\xF0(.)(.*?)\xF7//s) {
270 my $cmd = ord($1);
270559a2 »
2011-02-27 Properly parse Firmata strings.
271 printf "<-- sysex %02.2X '%s'\n", $cmd, $self->hexify($2);
3e5b371a »
2011-02-14 Initial commit.
272 next;
273 }
274
275 if ($buffer =~ s/^([\xE0-\xEF])(..)//s) {
276 my $port = ord($1) & 0x0F;
277 my ($lsb, $msb) = unpack "CC", $2;
278 my $value = (($msb & 0x7F) << 7) | ($lsb & 0x7F);
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
279 if (0) {
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
280 $self->emit(
281 event => "analog",
282 args => {
283 pin => $port,
284 value => $value,
285 },
286 );
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
287 }
3e5b371a »
2011-02-14 Initial commit.
288 next;
289 }
290
291 if ($buffer =~ s/^([\x90-\x9F])(..)//s) {
292 my $port = ord($1) & 0x0F;
293 my ($lsb, $msb) = unpack "CC", $2;
294 my $value = (($msb & 0x7F) << 7) | ($lsb & 0x7F);
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
295 if (0) {
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
296 $self->emit(
297 event => "digital",
298 args => {
299 pin => $port,
300 value => $value,
301 },
302 );
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
303 }
3e5b371a »
2011-02-14 Initial commit.
304 next;
305 }
306
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
307 # TODO - These are Firmata commands. Stuff we send to the device.
308 # TODO - We could handle these if we wanted to emulate a device.
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
309 # if ($buffer =~ s/^([\xC0-\xCF])(..)//s) {
310 # my $port = ord($1) & 0x0F;
311 # my ($lsb, $msb) = unpack "CC", $2;
312 # my $value = $lsb & 0x01;
313 # print "<-- a($port) set $value\n";
314 # next;
315 # }
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
316 #
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
317 # if ($buffer =~ s/^([\xD0-\xDF])(..)//s) {
318 # my $port = ord($1) & 0x0F;
319 # my ($lsb, $msb) = unpack "CC", $2;
320 # my $value = $lsb & 0x01;
321 # print "<-- d($port) set $value\n";
322 # next;
323 # }
3e5b371a »
2011-02-14 Initial commit.
324
325 last;
326 }
327
53a9334c »
2011-02-27 Add commands to alter the Firmata device.
328 #print "<-- raw: ", $self->hexify($buffer), "\n" if length $buffer;
3e5b371a »
2011-02-14 Initial commit.
329 $self->buffer($buffer);
270559a2 »
2011-02-27 Properly parse Firmata strings.
330 }
3e5b371a »
2011-02-14 Initial commit.
331
270559a2 »
2011-02-27 Properly parse Firmata strings.
332 sub firmata_string_parse {
333 my ($self, $raw_string) = @_;
334
335 croak "string contains an odd number of octets" if length($raw_string) % 2;
336
337 # Some things are better left to C, eh?
338 my $cooked_string = "";
339 my (@raw_octets) = ($raw_string =~ /(.)/sg);
340 while (@raw_octets) {
341 my ($lsb, $msb) = splice @raw_octets, 0, 2;
342 $cooked_string .= chr( ((ord($msb) & 0x7f) << 7) | (ord($lsb) & 0x7F) );
3e5b371a »
2011-02-14 Initial commit.
343 }
270559a2 »
2011-02-27 Properly parse Firmata strings.
344
345 return $cooked_string;
346 }
347
348 sub hexify {
349 my ($self, $data) = @_;
350
351 $data =~ s/(.)/sprintf("<%02.2x>", ord($1))/seg;
352 $data =~ s/(<[89a-fA-F][0-9a-fA-F]>)/\e[1m$1\e[0m/g;
353
354 return $data;
3e5b371a »
2011-02-14 Initial commit.
355 }
356
57b4e32b »
2012-06-19 Do more with the device's advertised capabilities.
357 sub on_init_wait_done {
358 my ($self, $timeout) = @_;
359 $self->put_handle("\xFF");
360 $self->emit(event => "has_reset");
361 }
362
363 sub initialize_from_device {
364 my $self = shift;
365
366 ATTEMPT: while (1) {
367 warn "attempt";
368
369 # Wait for a protocol string.
370 $self->start_init_wait();
371 my $e = $self->next('protocol_string', 'has_reset');
372 next ATTEMPT if $e->{name} eq 'has_reset';
373 $self->stop_init_wait();
374
375 # Request capabilities.
376 $self->put_handle("\xF0\x6B\xF7");
377
378 # Wait for initialization.
379 $self->start_init_wait();
380 $self->next('initialized', 'has_reset');
381 next ATTEMPT if $e->{name} eq 'has_reset';
382 $self->stop_init_wait();
383
384 last ATTEMPT;
385 }
386
387 $self->stop_init_wait();
388 }
389
3e5b371a »
2011-02-14 Initial commit.
390 1;
Something went wrong with that request. Please try again.