mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-04-22 08:11:44 +00:00
incorporate perl-firmata (Device::Firmata)
git-svn-id: https://svn.fhem.de/fhem/trunk@2596 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
ntruchsess
parent
f610aa060b
commit
3d20b4a6d4
72
fhem/FHEM/lib/Device/Firmata.pm
Normal file
72
fhem/FHEM/lib/Device/Firmata.pm
Normal file
@ -0,0 +1,72 @@
|
||||
package Device::Firmata;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Device::Firmata::Constants;
|
||||
use Device::Firmata::Base
|
||||
ISA => 'Device::Firmata::Base',
|
||||
FIRMATA_ATTRIBS => {
|
||||
};
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Device::Firmata - A host interface to Firmata for the arduino platform.
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Version 0.50
|
||||
|
||||
=cut
|
||||
|
||||
our $VERSION = '0.50';
|
||||
our $DEBUG = 0;
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Device::Firmata::Constants qw/ :all /;
|
||||
use Device::Firmata;
|
||||
$|++;
|
||||
use Time::HiRes 'sleep';
|
||||
|
||||
my $led_pin = 13;
|
||||
|
||||
my $device = Device::Firmata->open('/dev/ttyUSB0') or die "Could not connect to Firmata Server";
|
||||
$device->pin_mode($led_pin=>PIN_OUTPUT);
|
||||
my $iteration = 0;
|
||||
while (1) {
|
||||
my $strobe_state = $iteration++%2;
|
||||
$device->digital_write($led_pin=>$strobe_state);
|
||||
sleep 0.5;
|
||||
}
|
||||
|
||||
=head1 SUBROUTINES/METHODS
|
||||
|
||||
=head2 open
|
||||
|
||||
establish communication to the device. Single argument is the name of the device file mapped to the arduino. Typicaly '/dev/ttyUSB0'
|
||||
|
||||
=cut
|
||||
|
||||
sub open {
|
||||
# --------------------------------------------------
|
||||
# Establish a connection with the serial port
|
||||
#
|
||||
my ( $self, $serial_port, $opts ) = @_;
|
||||
|
||||
# We're going to try and create the device connection first...
|
||||
my $package = "Device::Firmata::Platform";
|
||||
eval "require $package";
|
||||
my $device = $package->open($serial_port,$opts);
|
||||
|
||||
# Figure out what platform we're running on
|
||||
$device->probe;
|
||||
|
||||
return $device;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
398
fhem/FHEM/lib/Device/Firmata/Base.pm
Normal file
398
fhem/FHEM/lib/Device/Firmata/Base.pm
Normal file
@ -0,0 +1,398 @@
|
||||
package Device::Firmata::Base;
|
||||
|
||||
use strict 'vars', 'subs';
|
||||
use vars qw/
|
||||
$AUTOLOAD
|
||||
|
||||
$FIRMATA_DEBUG_LEVEL
|
||||
$FIRMATA_ERROR_CLASS
|
||||
$FIRMATA_ERROR
|
||||
|
||||
$FIRMATA_ATTRIBS
|
||||
$FIRMATA_DEBUGGING
|
||||
|
||||
$FIRMATA_LOCALE
|
||||
$FIRMATA_LOCALE_PATH
|
||||
$FIRMATA_LOCALE_MESSAGES
|
||||
/;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Device::Firmata::Base -- Abstract baseclass for Device::Firmata modules
|
||||
|
||||
=cut
|
||||
|
||||
$FIRMATA_DEBUGGING = 1;
|
||||
|
||||
$FIRMATA_ATTRIBS = {
|
||||
};
|
||||
$FIRMATA_LOCALE = 'en';
|
||||
$FIRMATA_LOCALE_PATH = '.';
|
||||
|
||||
$FIRMATA_DEBUG_LEVEL = 0;
|
||||
$FIRMATA_ERROR_CLASS = 'Device::Firmata::Error';
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 import
|
||||
|
||||
Ease the use of setting up configuration options
|
||||
|
||||
=cut
|
||||
|
||||
sub import {
|
||||
my $self = shift;
|
||||
my $pkg = caller;
|
||||
|
||||
my $config_opts = {
|
||||
debugging => $FIRMATA_DEBUGGING,
|
||||
};
|
||||
|
||||
if ( @_ ) {
|
||||
my $opts = $self->parameters( @_ );
|
||||
|
||||
if ( my $attrs = $opts->{FIRMATA_ATTRIBS} ) {
|
||||
*{$pkg.'::FIRMATA_ATTRIBS'} = \$attrs;
|
||||
}
|
||||
|
||||
unless ( ref *{$pkg.'::ISA'} eq 'ARRAY' and @${$pkg.'::ISA'}) {
|
||||
my @ISA = ref $opts->{ISA} ? @{$opts->{ISA}} :
|
||||
$opts->{ISA} ? $opts->{ISA} :
|
||||
__PACKAGE__;
|
||||
*{$pkg.'::ISA'} = \@ISA;
|
||||
}
|
||||
|
||||
use strict;
|
||||
|
||||
$self->SUPER::import( @_ );
|
||||
}
|
||||
}
|
||||
|
||||
=head2 new
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my $pkg = shift;
|
||||
my $basis = copy_struct( $pkg->init_class_attribs );
|
||||
my $self = bless $basis, $pkg;
|
||||
|
||||
@_ = $self->pre_init( @_ ) if $self->{_biofunc_pre_init};
|
||||
|
||||
if ( $self->{_biofunc_init} ) {
|
||||
$self->init( @_ );
|
||||
}
|
||||
else {
|
||||
$self->init_instance_attribs( @_ );
|
||||
}
|
||||
|
||||
return $self->post_init if $self->{_biofunc_post_init};
|
||||
return $self;
|
||||
}
|
||||
|
||||
=head2 create
|
||||
|
||||
A soft new as some objects will override new and
|
||||
we don't want to cause problems but still want
|
||||
to invoice our creation code
|
||||
|
||||
=cut
|
||||
|
||||
sub create {
|
||||
my $self = shift;
|
||||
my $basis = copy_struct( $self->init_class_attribs );
|
||||
|
||||
@$self{ keys %$basis } = values %$basis;
|
||||
|
||||
@_ = $self->pre_init( @_ ) if $self->{_biofunc_pre_init};
|
||||
|
||||
if ( $self->{_biofunc_init} ) {
|
||||
$self->init( @_ );
|
||||
}
|
||||
else {
|
||||
$self->init_instance_attribs( @_ );
|
||||
}
|
||||
|
||||
return $self->post_init if $self->{_biofunc_post_init};
|
||||
return $self;
|
||||
}
|
||||
|
||||
=head2 init_instance_attribs
|
||||
|
||||
=cut
|
||||
|
||||
sub init_instance_attribs {
|
||||
# --------------------------------------------------
|
||||
my $self = shift;
|
||||
my $opts = $self->parameters( @_ );
|
||||
|
||||
foreach my $k ( keys %$self ) {
|
||||
next unless exists $opts->{$k};
|
||||
next if $k =~ /^_biofunc/;
|
||||
$self->{$k} = $opts->{$k};
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
=head2 init_class_attribs
|
||||
|
||||
=cut
|
||||
|
||||
sub init_class_attribs {
|
||||
# --------------------------------------------------
|
||||
my $class = ref $_[0] || shift;
|
||||
my $track = { $class => 1, @_ ? %{$_[0]} : () };
|
||||
|
||||
return ${"${class}::ABSOLUTE_ATTRIBS"} if ${"${class}::ABSOLUTE_ATTRIBS"};
|
||||
|
||||
my $u = ${"${class}::FIRMATA_ATTRIBS"} || {};
|
||||
|
||||
for my $c ( @{"${class}::ISA"} ) {
|
||||
next unless ${"${c}::FIRMATA_ATTRIBS"};
|
||||
|
||||
my $h;
|
||||
if ( ${"${c}::ABSOLUTE_ATTRIBS"} ) {
|
||||
$h = ${"${c}::ABSOLUTE_ATTRIBS"};
|
||||
}
|
||||
else {
|
||||
$c->fatal( "Cyclic dependancy!" ) if $track->{$c};
|
||||
$h = $c->init_class_attribs( $c, $track );
|
||||
}
|
||||
|
||||
foreach my $k ( keys %$h ) {
|
||||
next if exists $u->{$k};
|
||||
$u->{$k} = copy_struct( $h->{$k} );
|
||||
}
|
||||
}
|
||||
|
||||
foreach my $f ( qw( pre_init init post_init ) ) {
|
||||
$u->{"_biofunc_" . $f} = $class->can( $f ) ? 1 : 0;
|
||||
}
|
||||
|
||||
${"${class}::ABSOLUTE_ATTRIBS"} = $u;
|
||||
|
||||
return $u;
|
||||
}
|
||||
|
||||
# logging/exception functions
|
||||
|
||||
|
||||
|
||||
# Utilty functions
|
||||
|
||||
=head2 parameters
|
||||
|
||||
=cut
|
||||
|
||||
sub parameters {
|
||||
# --------------------------------------------------
|
||||
return {} unless @_ > 1;
|
||||
|
||||
if ( @_ == 2 ) {
|
||||
return $_[1] if ref $_[1];
|
||||
return; # something wierd happened
|
||||
}
|
||||
|
||||
@_ % 2 or $_[0]->warn( "Even number of elements were not passed to call.", join( " ", caller() ) );
|
||||
|
||||
shift;
|
||||
|
||||
return {@_};
|
||||
}
|
||||
|
||||
=head2 copy_struct
|
||||
|
||||
=cut
|
||||
|
||||
sub copy_struct {
|
||||
# --------------------------------------------------
|
||||
my $s = shift;
|
||||
|
||||
if ( ref $s ) {
|
||||
if ( UNIVERSAL::isa( $s, 'HASH' ) ) {
|
||||
return {
|
||||
map { my $v = $s->{$_}; (
|
||||
$_ => ref $v ? copy_struct( $v ) : $v
|
||||
)} keys %$s
|
||||
};
|
||||
}
|
||||
elsif ( UNIVERSAL::isa( $s, 'ARRAY' ) ) {
|
||||
return [
|
||||
map { ref $_ ? copy_struct($_) : $_ } @$s
|
||||
];
|
||||
}
|
||||
die "Cannot copy struct! : ".ref($s);
|
||||
}
|
||||
|
||||
return $s;
|
||||
}
|
||||
|
||||
=head2 locale
|
||||
|
||||
=cut
|
||||
|
||||
sub locale {
|
||||
# --------------------------------------------------
|
||||
@_ >= 2 and shift;
|
||||
$FIRMATA_LOCALE = shift;
|
||||
}
|
||||
|
||||
=head2 locale_path
|
||||
|
||||
=cut
|
||||
|
||||
sub locale_path {
|
||||
# --------------------------------------------------
|
||||
@_ >= 2 and shift;
|
||||
$FIRMATA_LOCALE_PATH = shift;
|
||||
}
|
||||
|
||||
=head2 language
|
||||
|
||||
=cut
|
||||
|
||||
sub language {
|
||||
# --------------------------------------------------
|
||||
my $self = shift;
|
||||
require Device::Firmata::Language;
|
||||
return Device::Firmata::Language->language(@_);
|
||||
}
|
||||
|
||||
=head2 error
|
||||
|
||||
=cut
|
||||
|
||||
sub error {
|
||||
# --------------------------------------------------
|
||||
# Handle any error messages
|
||||
#
|
||||
my $self = shift;
|
||||
|
||||
if ( @_ ) {
|
||||
my $err_msg = $self->init_error->error(@_);
|
||||
$self->{error} = $err_msg;
|
||||
return;
|
||||
}
|
||||
|
||||
my $err_msg = $self->{error};
|
||||
$self->{error} = '';
|
||||
return $err_msg;
|
||||
}
|
||||
|
||||
=head2 init_error
|
||||
|
||||
Creates the global error object that will collect
|
||||
all error messages generated on the system. This
|
||||
function can be called as many times as desired.
|
||||
|
||||
=cut
|
||||
|
||||
sub init_error {
|
||||
# --------------------------------------------------
|
||||
#
|
||||
$FIRMATA_ERROR and return $FIRMATA_ERROR;
|
||||
|
||||
if ( $FIRMATA_ERROR_CLASS eq 'Device::Firmata::Error' ) {
|
||||
require Device::Firmata::Error;
|
||||
return $FIRMATA_ERROR = $FIRMATA_ERROR_CLASS;
|
||||
}
|
||||
|
||||
# Try and load the file. Use default if fails
|
||||
eval "require $FIRMATA_ERROR_CLASS";
|
||||
$@ and return $FIRMATA_ERROR = $FIRMATA_ERROR_CLASS;
|
||||
|
||||
# Try and init the error object. Use default if fails
|
||||
eval { $FIRMATA_ERROR = $FIRMATA_ERROR_CLASS->new(); };
|
||||
$@ and return $FIRMATA_ERROR = $FIRMATA_ERROR_CLASS;
|
||||
return $FIRMATA_ERROR;
|
||||
}
|
||||
|
||||
=head2 fatal
|
||||
|
||||
Handle tragic and unrecoverable messages
|
||||
|
||||
=cut
|
||||
|
||||
sub fatal {
|
||||
# --------------------------------------------------
|
||||
#
|
||||
my $self = shift;
|
||||
return $self->error( -1, @_ );
|
||||
}
|
||||
|
||||
=head2 warn
|
||||
|
||||
Handle tragic and unrecoverable messages
|
||||
|
||||
=cut
|
||||
|
||||
sub warn {
|
||||
# --------------------------------------------------
|
||||
#
|
||||
my $self = shift;
|
||||
return $self->error( 0, @_ );
|
||||
}
|
||||
|
||||
=head2 debug
|
||||
|
||||
=cut
|
||||
|
||||
sub debug {
|
||||
# --------------------------------------------------
|
||||
my ( $self, $debug ) = @_;
|
||||
$FIRMATA_DEBUG_LEVEL = $debug;
|
||||
}
|
||||
|
||||
=head2 DESTROY
|
||||
|
||||
=cut
|
||||
|
||||
sub DESTROY {
|
||||
# --------------------------------------------------
|
||||
my $self = shift;
|
||||
}
|
||||
|
||||
=head2 AUTOLOAD
|
||||
|
||||
=cut
|
||||
|
||||
sub AUTOLOAD {
|
||||
# --------------------------------------------------
|
||||
my $self = shift;
|
||||
my ($attrib) = $AUTOLOAD =~ /::([^:]+)$/;
|
||||
|
||||
if ( $self and UNIVERSAL::isa( $self, 'Device::Firmata::Base' ) ) {
|
||||
$self->error( FIRMATA__unhandled => $attrib, join( " ", caller() ) );
|
||||
die $self->error;
|
||||
}
|
||||
else {
|
||||
die "Tried to call function '$attrib' via object '$self' @ ", join( " ", caller(1) ), "\n";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
####################################################
|
||||
# Object instantiation code
|
||||
####################################################
|
||||
|
||||
=head2 object_load
|
||||
|
||||
Load the appropriate package and attempt to initialize
|
||||
the object as well
|
||||
|
||||
=cut
|
||||
|
||||
sub object_load {
|
||||
# --------------------------------------------------
|
||||
my $self = shift;
|
||||
my $object_class = shift;
|
||||
return unless $object_class =~ /^\w+(?:::\w+)*$/; # TODO ERROR MESSAGE
|
||||
eval "require $object_class; 1" or die $@;
|
||||
my $object = $object_class->new(@_);
|
||||
return $object;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
291
fhem/FHEM/lib/Device/Firmata/Constants.pm
Normal file
291
fhem/FHEM/lib/Device/Firmata/Constants.pm
Normal file
@ -0,0 +1,291 @@
|
||||
package Device::Firmata::Constants;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Device::Firmata::Constants - constants used in the system
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use Exporter;
|
||||
use vars qw/
|
||||
@ISA @EXPORT_OK %EXPORT_TAGS
|
||||
$BASE
|
||||
$DEVICES
|
||||
$COMMANDS $COMMAND_NAMES
|
||||
$COMMAND_LOOKUP
|
||||
/;
|
||||
@ISA = 'Exporter';
|
||||
|
||||
# Basic commands and constants
|
||||
use constant (
|
||||
$BASE = {
|
||||
PIN_INPUT => 0,
|
||||
PIN_OUTPUT => 1,
|
||||
PIN_ANALOG => 2,
|
||||
PIN_PWM => 3,
|
||||
PIN_SERVO => 4,
|
||||
PIN_SHIFT => 5,
|
||||
PIN_I2C => 6,
|
||||
PIN_ONEWIRE => 7,
|
||||
|
||||
PIN_LOW => 0,
|
||||
PIN_HIGH => 1,
|
||||
}
|
||||
);
|
||||
|
||||
$DEVICES = { 'arduino_dumilanove' => {}, };
|
||||
|
||||
# We need to apply all the available protocols
|
||||
use constant (
|
||||
$COMMANDS = {
|
||||
|
||||
V_2_01 => {
|
||||
|
||||
MAX_DATA_BYTES =>
|
||||
32, # max number of data bytes in non-Sysex messages
|
||||
|
||||
# message command bytes (128-255/0x80-0xFF)
|
||||
DIGITAL_MESSAGE => 0x90, # send data for a digital pin
|
||||
ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM)
|
||||
REPORT_ANALOG => 0xC0, # enable analog input by pin #
|
||||
REPORT_DIGITAL => 0xD0, # enable digital input by port pair
|
||||
SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc
|
||||
REPORT_VERSION => 0xF9, # report protocol version
|
||||
SYSTEM_RESET => 0xFF, # reset from MIDI
|
||||
START_SYSEX => 0xF0, # start a MIDI Sysex message
|
||||
END_SYSEX => 0xF7, # end a MIDI Sysex message
|
||||
|
||||
# extended command set using sysex (0-127/0x00-0x7F)
|
||||
SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq
|
||||
STRING_DATA => 0x71, # a string message with 14-bits per char
|
||||
SHIFT_DATA => 0x75, # a bitstream to/from a shift register
|
||||
I2C_REQUEST => 0x76, # send an I2C read/write request
|
||||
I2C_REPLY => 0x77, # a reply to an I2C read request
|
||||
I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins
|
||||
REPORT_FIRMWARE => 0x79, # report name and version of the firmware
|
||||
SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop
|
||||
SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages
|
||||
SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages
|
||||
|
||||
# these are DEPRECATED to make the naming more consistent
|
||||
FIRMATA_STRING => 0x71, # same as STRING_DATA
|
||||
SYSEX_I2C_REQUEST => 0x76, # same as I2C_REQUEST
|
||||
SYSEX_I2C_REPLY => 0x77, # same as I2C_REPLY
|
||||
SYSEX_SAMPLING_INTERVAL => 0x7A, # same as SAMPLING_INTERVAL
|
||||
|
||||
# pin modes
|
||||
INPUT => 0x00, # digital pin in digitalOut mode
|
||||
OUTPUT => 0x01, # digital pin in digitalInput mode
|
||||
ANALOG => 0x02, # analog pin in analogInput mode
|
||||
PWM => 0x03, # digital pin in PWM output mode
|
||||
SERVO => 0x04, # digital pin in Servo output mode
|
||||
SHIFT => 0x05, # shiftIn/shiftOut mode
|
||||
I2C => 0x06, # pin included in I2C setup
|
||||
|
||||
# Deprecated entries
|
||||
deprecated => [
|
||||
qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL )
|
||||
],
|
||||
|
||||
}, # /Constants for Version 2.1
|
||||
|
||||
V_2_02 => {
|
||||
|
||||
MAX_DATA_BYTES =>
|
||||
32, # max number of data bytes in non-Sysex messages
|
||||
|
||||
# message command bytes (128-255/0x80-0xFF)
|
||||
DIGITAL_MESSAGE => 0x90, # send data for a digital pin
|
||||
ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM)
|
||||
REPORT_ANALOG => 0xC0, # enable analog input by pin #
|
||||
REPORT_DIGITAL => 0xD0, # enable digital input by port pair
|
||||
SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc
|
||||
REPORT_VERSION => 0xF9, # report protocol version
|
||||
SYSTEM_RESET => 0xFF, # reset from MIDI
|
||||
START_SYSEX => 0xF0, # start a MIDI Sysex message
|
||||
END_SYSEX => 0xF7, # end a MIDI Sysex message
|
||||
|
||||
# extended command set using sysex (0-127/0x00-0x7F)
|
||||
RESERVED_COMMAND => 0x00, # 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc).
|
||||
ANALOG_MAPPING_QUERY => 0x69, # ask for mapping of analog to pin numbers
|
||||
ANALOG_MAPPING_RESPONSE => 0x6A, # reply with mapping info
|
||||
CAPABILITY_QUERY => 0x6B, # ask for supported modes and resolution of all pins
|
||||
CAPABILITY_RESPONSE => 0x6C, # reply with supported modes and resolution
|
||||
PIN_STATE_QUERY => 0x6D, # ask for a pin's current mode and value
|
||||
PIN_STATE_RESPONSE => 0x6E, # reply with a pin's current mode and value
|
||||
EXTENDED_ANALOG => 0x6F, # analog write (PWM, Servo, etc) to any pin
|
||||
SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq
|
||||
STRING_DATA => 0x71, # a string message with 14-bits per char
|
||||
SHIFT_DATA => 0x75, # shiftOut config/data message (34 bits)
|
||||
I2C_REQUEST => 0x76, # send an I2C read/write request
|
||||
I2C_REPLY => 0x77, # a reply to an I2C read request
|
||||
I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins
|
||||
REPORT_FIRMWARE => 0x79, # report name and version of the firmware
|
||||
SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop
|
||||
SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages
|
||||
SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages
|
||||
|
||||
# pin modes
|
||||
INPUT => 0x00, # digital pin in digitalOut mode
|
||||
OUTPUT => 0x01, # digital pin in digitalInput mode
|
||||
ANALOG => 0x02, # analog pin in analogInput mode
|
||||
PWM => 0x03, # digital pin in PWM output mode
|
||||
SERVO => 0x04, # digital pin in Servo output mode
|
||||
SHIFT => 0x05, # shiftIn/shiftOut mode
|
||||
I2C => 0x06, # pin included in I2C setup
|
||||
|
||||
# Deprecated entries
|
||||
deprecated => [
|
||||
qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL )
|
||||
],
|
||||
|
||||
}, # /Constants for Version 2.2
|
||||
|
||||
V_2_03 => {
|
||||
|
||||
MAX_DATA_BYTES =>
|
||||
32, # max number of data bytes in non-Sysex messages
|
||||
|
||||
# message command bytes (128-255/0x80-0xFF)
|
||||
DIGITAL_MESSAGE => 0x90, # send data for a digital pin
|
||||
ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM)
|
||||
REPORT_ANALOG => 0xC0, # enable analog input by pin #
|
||||
REPORT_DIGITAL => 0xD0, # enable digital input by port pair
|
||||
SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc
|
||||
REPORT_VERSION => 0xF9, # report protocol version
|
||||
SYSTEM_RESET => 0xFF, # reset from MIDI
|
||||
START_SYSEX => 0xF0, # start a MIDI Sysex message
|
||||
END_SYSEX => 0xF7, # end a MIDI Sysex message
|
||||
|
||||
# extended command set using sysex (0-127/0x00-0x7F)
|
||||
RESERVED_COMMAND => 0x00, # 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc).
|
||||
ANALOG_MAPPING_QUERY => 0x69, # ask for mapping of analog to pin numbers
|
||||
ANALOG_MAPPING_RESPONSE => 0x6A, # reply with mapping info
|
||||
CAPABILITY_QUERY => 0x6B, # ask for supported modes and resolution of all pins
|
||||
CAPABILITY_RESPONSE => 0x6C, # reply with supported modes and resolution
|
||||
PIN_STATE_QUERY => 0x6D, # ask for a pin's current mode and value
|
||||
PIN_STATE_RESPONSE => 0x6E, # reply with a pin's current mode and value
|
||||
EXTENDED_ANALOG => 0x6F, # analog write (PWM, Servo, etc) to any pin
|
||||
SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq
|
||||
STRING_DATA => 0x71, # a string message with 14-bits per char
|
||||
SHIFT_DATA => 0x75, # shiftOut config/data message (34 bits)
|
||||
I2C_REQUEST => 0x76, # send an I2C read/write request
|
||||
I2C_REPLY => 0x77, # a reply to an I2C read request
|
||||
I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins
|
||||
REPORT_FIRMWARE => 0x79, # report name and version of the firmware
|
||||
SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop
|
||||
SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages
|
||||
SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages
|
||||
|
||||
# pin modes
|
||||
INPUT => 0x00, # digital pin in digitalOut mode
|
||||
OUTPUT => 0x01, # digital pin in digitalInput mode
|
||||
ANALOG => 0x02, # analog pin in analogInput mode
|
||||
PWM => 0x03, # digital pin in PWM output mode
|
||||
SERVO => 0x04, # digital pin in Servo output mode
|
||||
SHIFT => 0x05, # shiftIn/shiftOut mode
|
||||
I2C => 0x06, # pin included in I2C setup
|
||||
|
||||
# Deprecated entries
|
||||
deprecated => [
|
||||
qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL )
|
||||
],
|
||||
|
||||
}, # /Constants for Version 2.3 (same as V_2_02)
|
||||
|
||||
V_2_04 => {
|
||||
|
||||
MAX_DATA_BYTES => 64, # max number of data bytes in non-Sysex messages
|
||||
|
||||
# message command bytes (128-255/0x80-0xFF)
|
||||
DIGITAL_MESSAGE => 0x90, # send data for a digital pin
|
||||
ANALOG_MESSAGE => 0xE0, # send data for an analog pin (or PWM)
|
||||
REPORT_ANALOG => 0xC0, # enable analog input by pin #
|
||||
REPORT_DIGITAL => 0xD0, # enable digital input by port pair
|
||||
SET_PIN_MODE => 0xF4, # set a pin to INPUT/OUTPUT/PWM/etc
|
||||
REPORT_VERSION => 0xF9, # report protocol version
|
||||
SYSTEM_RESET => 0xFF, # reset from MIDI
|
||||
START_SYSEX => 0xF0, # start a MIDI Sysex message
|
||||
END_SYSEX => 0xF7, # end a MIDI Sysex message
|
||||
|
||||
# extended command set using sysex (0-127/0x00-0x7F)
|
||||
RESERVED_COMMAND => 0x00, # 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc).
|
||||
ANALOG_MAPPING_QUERY => 0x69, # ask for mapping of analog to pin numbers
|
||||
ANALOG_MAPPING_RESPONSE => 0x6A, # reply with mapping info
|
||||
CAPABILITY_QUERY => 0x6B, # ask for supported modes and resolution of all pins
|
||||
CAPABILITY_RESPONSE => 0x6C, # reply with supported modes and resolution
|
||||
PIN_STATE_QUERY => 0x6D, # ask for a pin's current mode and value
|
||||
PIN_STATE_RESPONSE => 0x6E, # reply with a pin's current mode and value
|
||||
EXTENDED_ANALOG => 0x6F, # analog write (PWM, Servo, etc) to any pin
|
||||
SERVO_CONFIG => 0x70, # set max angle, minPulse, maxPulse, freq
|
||||
STRING_DATA => 0x71, # a string message with 14-bits per char
|
||||
ONEWIRE_REQUEST => 0x73, # send an OneWire read/write/reset/select/skip/search request
|
||||
ONEWIRE_REPLY => 0x7D, # reply to a OneWire read/search request
|
||||
SHIFT_DATA => 0x75, # shiftOut config/data message (34 bits)
|
||||
I2C_REQUEST => 0x76, # send an I2C read/write request
|
||||
I2C_REPLY => 0x77, # a reply to an I2C read request
|
||||
I2C_CONFIG => 0x78, # config I2C settings such as delay times and power pins
|
||||
REPORT_FIRMWARE => 0x79, # report name and version of the firmware
|
||||
SAMPLING_INTERVAL => 0x7A, # set the poll rate of the main loop
|
||||
SCHEDULER_REQUEST => 0x7B, # send a createtask/deletetask/addtotask/schedule/querytasks/querytask request to the scheduler
|
||||
SCHEDULER_REPLY => 0x7C, # a reply to a querytasks/querytask-request from the scheduler
|
||||
SYSEX_NON_REALTIME => 0x7E, # MIDI Reserved for non-realtime messages
|
||||
SYSEX_REALTIME => 0x7F, # MIDI Reserved for realtime messages
|
||||
|
||||
# pin modes
|
||||
INPUT => 0x00, # digital pin in digitalOut mode
|
||||
OUTPUT => 0x01, # digital pin in digitalInput mode
|
||||
ANALOG => 0x02, # analog pin in analogInput mode
|
||||
PWM => 0x03, # digital pin in PWM output mode
|
||||
SERVO => 0x04, # digital pin in Servo output mode
|
||||
SHIFT => 0x05, # shiftIn/shiftOut mode
|
||||
I2C => 0x06, # pin included in I2C setup
|
||||
ONEWIRE => 0x07,
|
||||
|
||||
# Deprecated entries
|
||||
deprecated => [
|
||||
qw( FIRMATA_STRING SYSEX_I2C_REQUEST SYSEX_I2C_REPLY SYSEX_SAMPLING_INTERVAL )
|
||||
],
|
||||
|
||||
}, # /Constants for Version 2.4
|
||||
|
||||
}
|
||||
);
|
||||
|
||||
# Handle the reverse lookups of the protocol
|
||||
$COMMAND_LOOKUP = {};
|
||||
while ( my ( $protocol_version, $protocol_commands ) = each %$COMMANDS ) {
|
||||
my $protocol_lookup = $COMMAND_LOOKUP->{$protocol_version} = {};
|
||||
my $deprecated = $protocol_lookup->{deprecated} || [];
|
||||
my $deprecated_lookup = { map { ( $_ => 1 ) } @$deprecated };
|
||||
while ( my ( $protocol_command, $command_value ) =
|
||||
each %$protocol_commands )
|
||||
{
|
||||
next if $protocol_command eq 'deprecated';
|
||||
next if $deprecated_lookup->{$protocol_command};
|
||||
$protocol_lookup->{$command_value} = $protocol_command;
|
||||
}
|
||||
}
|
||||
|
||||
# Now we consolidate all the string keynames into a single master list.
|
||||
use constant (
|
||||
$COMMAND_NAMES = {
|
||||
map {
|
||||
map { ( $_ => $_ ) }
|
||||
keys %$_
|
||||
} values %$COMMANDS
|
||||
}
|
||||
);
|
||||
|
||||
use constant { COMMAND_NAMES => [ $COMMAND_NAMES = [ keys %$COMMAND_NAMES ] ] };
|
||||
|
||||
@EXPORT_OK = (
|
||||
@$COMMAND_NAMES, keys %$BASE,
|
||||
keys %$COMMANDS,
|
||||
qw( $COMMANDS $COMMAND_NAMES $COMMAND_LOOKUP )
|
||||
);
|
||||
|
||||
%EXPORT_TAGS = ( all => \@EXPORT_OK );
|
||||
|
||||
1;
|
||||
94
fhem/FHEM/lib/Device/Firmata/Error.pm
Normal file
94
fhem/FHEM/lib/Device/Firmata/Error.pm
Normal file
@ -0,0 +1,94 @@
|
||||
package Device::Firmata::Error;
|
||||
# ==================================================================
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Device::Firmata::Error - Error handlers
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use Exporter;
|
||||
use vars qw/
|
||||
@ISA
|
||||
%ERRORS
|
||||
@EXPORT
|
||||
$FIRMATA_ERROR_DEFAULT
|
||||
@ERROR_STACK
|
||||
/;
|
||||
use Device::Firmata::Base;
|
||||
|
||||
@ISA = 'Exporter';
|
||||
|
||||
@EXPORT = qw();
|
||||
|
||||
$FIRMATA_ERROR_DEFAULT = -1;
|
||||
|
||||
|
||||
=head2 error
|
||||
|
||||
The base error reporting system. All errors will be
|
||||
stored in this object until the errors flush code is called.
|
||||
This will allow the system to collect all errors that occur
|
||||
in various parts of the system in one place. Very useful
|
||||
for error reporting since it's a simple call to find
|
||||
out the last error.
|
||||
|
||||
Invocation of this function
|
||||
|
||||
$err->error( [numerical error level], ErrorMessage, ... parameters ... );
|
||||
|
||||
ErrorMessage can be in the format "KEY" that will be referenced by
|
||||
Device::Firmata::Base->language or "KEY:Message" where if ->language does
|
||||
not map to anything, the error will default to Message
|
||||
|
||||
=cut
|
||||
|
||||
sub error {
|
||||
# --------------------------------------------------
|
||||
#
|
||||
my $self = shift;
|
||||
my $error_level = $_[0] =~ /^\-?\d+$/ ? shift : $FIRMATA_ERROR_DEFAULT;
|
||||
my $message = shift;
|
||||
my $error_code;
|
||||
if ( $message =~ /^([A-Z0-9_]+)\s*:\s*/ ) {
|
||||
$error_code = $1;
|
||||
}
|
||||
else {
|
||||
$error_code = $message;
|
||||
};
|
||||
my $text = Device::Firmata::Base->language($message,@_);
|
||||
push @ERROR_STACK, [ $text, $error_level, $text ];
|
||||
|
||||
if ( $error_level < 1 ) {
|
||||
my $i = 1;
|
||||
my ( $pkg, $fn, $line );
|
||||
|
||||
# Proceed up the call stack until we find out where the error likely occured (ie. Not in Device::Firmata::Base)
|
||||
do { ( $pkg, $fn, $line ) = caller($i); $i++; } while ( $pkg eq 'Device::Firmata::Base' );
|
||||
|
||||
$error_level < 0 ? die "\@$fn:$pkg:$line". ' : ' . $text . "\n"
|
||||
: warn "\@$fn:$pkg:$line". ' : ' . $text . "\n";
|
||||
};
|
||||
|
||||
# warn "Error called wih args: @_ from " . join( " ", caller() ) . "\n";
|
||||
# require Carp;
|
||||
# Carp::cluck();
|
||||
|
||||
return $text;
|
||||
}
|
||||
|
||||
|
||||
=head2 errors_flush
|
||||
|
||||
=cut
|
||||
|
||||
sub errors_flush {
|
||||
# --------------------------------------------------
|
||||
@ERROR_STACK = ();
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
||||
85
fhem/FHEM/lib/Device/Firmata/IO.pm
Normal file
85
fhem/FHEM/lib/Device/Firmata/IO.pm
Normal file
@ -0,0 +1,85 @@
|
||||
package Device::Firmata::IO;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Device::Firmata::IO - implement the low level serial IO
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use vars qw/ $SERIAL_CLASS /;
|
||||
use Device::Firmata::Base
|
||||
ISA => 'Device::Firmata::Base',
|
||||
FIRMATA_ATTRIBS => {
|
||||
handle => undef,
|
||||
baudrate => 57600,
|
||||
};
|
||||
|
||||
$SERIAL_CLASS = $^O eq 'MSWin32' ? 'Win32::Serialport'
|
||||
: 'Device::SerialPort';
|
||||
eval "require $SERIAL_CLASS";
|
||||
|
||||
|
||||
=head2 open
|
||||
|
||||
=cut
|
||||
|
||||
sub open {
|
||||
# --------------------------------------------------
|
||||
my ( $pkg, $serial_port, $opts ) = @_;
|
||||
|
||||
my $self = ref $pkg ? $pkg : $pkg->new($opts);
|
||||
|
||||
my $serial_obj = $SERIAL_CLASS->new( $serial_port, 1, 0 ) or return;
|
||||
$self->attach($serial_obj,$opts);
|
||||
$self->{handle}->baudrate($self->{baudrate});
|
||||
$self->{handle}->databits(8);
|
||||
$self->{handle}->stopbits(1);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub attach {
|
||||
my ( $pkg, $serial_obj, $opts ) = @_;
|
||||
|
||||
my $self = ref $pkg ? $pkg : $pkg->new($opts);
|
||||
|
||||
$self->{handle} = $serial_obj;
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
=head2 data_write
|
||||
|
||||
Dump a bunch of data into the comm port
|
||||
|
||||
=cut
|
||||
|
||||
sub data_write {
|
||||
# --------------------------------------------------
|
||||
my ( $self, $buf ) = @_;
|
||||
$Device::Firmata::DEBUG and print ">".join(",",map{sprintf"%02x",ord$_}split//,$buf)."\n";
|
||||
return $self->{handle}->write( $buf );
|
||||
}
|
||||
|
||||
|
||||
=head2 data_read
|
||||
|
||||
We fetch up to $bytes from the comm port
|
||||
This function is non-blocking
|
||||
|
||||
=cut
|
||||
|
||||
sub data_read {
|
||||
# --------------------------------------------------
|
||||
my ( $self, $bytes ) = @_;
|
||||
my ( $count, $string ) = $self->{handle}->read($bytes);
|
||||
if ( $Device::Firmata::DEBUG and $string ) {
|
||||
print "<".join(",",map{sprintf"%02x",ord$_}split//,$string)."\n";
|
||||
}
|
||||
return $string;
|
||||
}
|
||||
|
||||
1;
|
||||
108
fhem/FHEM/lib/Device/Firmata/Language.pm
Normal file
108
fhem/FHEM/lib/Device/Firmata/Language.pm
Normal file
@ -0,0 +1,108 @@
|
||||
package Device::Firmata::Language;
|
||||
# ==================================================================
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Device::Firmata::Language - Localization
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use vars qw/
|
||||
$FIRMATA_LOCALE
|
||||
$FIRMATA_LOCALE_PATH
|
||||
$FIRMATA_LOCALE_MESSAGES
|
||||
/;
|
||||
use Device::Firmata::Base
|
||||
ISA => 'Device::Firmata::Base',
|
||||
FIRMATA_ATTRIBS => {
|
||||
messages => {},
|
||||
};
|
||||
|
||||
$FIRMATA_LOCALE_MESSAGES = {
|
||||
};
|
||||
$FIRMATA_LOCALE = 'en';
|
||||
$FIRMATA_LOCALE_PATH = '.';
|
||||
|
||||
|
||||
=head2 numbers
|
||||
|
||||
=cut
|
||||
|
||||
sub numbers {
|
||||
# --------------------------------------------------
|
||||
}
|
||||
|
||||
|
||||
=head2 date
|
||||
|
||||
=cut
|
||||
|
||||
sub date {
|
||||
# --------------------------------------------------
|
||||
}
|
||||
|
||||
|
||||
=head2 language
|
||||
|
||||
=cut
|
||||
|
||||
sub language {
|
||||
# --------------------------------------------------
|
||||
my $self = shift;
|
||||
|
||||
my $messages = $FIRMATA_LOCALE_MESSAGES->{$FIRMATA_LOCALE} ||= do {
|
||||
my $target_fpath = "$FIRMATA_LOCALE_PATH/$FIRMATA_LOCALE.txt";
|
||||
|
||||
my $m;
|
||||
require Symbol;
|
||||
my $fh = Symbol::gensym();
|
||||
|
||||
if ( -f $target_fpath ) {
|
||||
open $fh, "<$target_fpath" or die $!;
|
||||
}
|
||||
else {
|
||||
$fh = \*DATA;
|
||||
}
|
||||
|
||||
while ( my $l = <$fh> ) {
|
||||
next if $l =~ /^\s*$/;
|
||||
$l =~ /([^\s]*)\s+(.*)/;
|
||||
( $m ||= {} )->{$1} = $2;
|
||||
}
|
||||
close $fh;
|
||||
|
||||
$m;
|
||||
};
|
||||
|
||||
# This will parse messages coming through such that it will
|
||||
# be possible to encode a language string with a code in the
|
||||
# following formats:
|
||||
#
|
||||
# ->language( "CODE", $parametrs ... )
|
||||
# ->language( "CODE:Default Message %s", $parametrs ... )
|
||||
#
|
||||
my $message = shift or return;
|
||||
$message =~ s/^([\w_]+)\s*:?\s*//;
|
||||
my $key = $1;
|
||||
my $message_template;
|
||||
|
||||
# Get the message template in the following order:
|
||||
# 1. The local object if available
|
||||
# 2. The global message object
|
||||
# 3. The provided default message
|
||||
#
|
||||
ref $self and $message_template = $self->{messages}{$key};
|
||||
$message_template ||= $messages->{$key} || $message;
|
||||
|
||||
return sprintf( $message_template, @_ );
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__DATA__
|
||||
FIRMATA__unhandled Unhandled attribute '%s' called
|
||||
FIRMATA__unknown Unknown/Unhandled error encountered: %s
|
||||
|
||||
FIRMATA__separator ,
|
||||
|
||||
834
fhem/FHEM/lib/Device/Firmata/Platform.pm
Normal file
834
fhem/FHEM/lib/Device/Firmata/Platform.pm
Normal file
@ -0,0 +1,834 @@
|
||||
package Device::Firmata::Platform;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Device::Firmata::Platform - platform specifics
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use Time::HiRes qw/time/;
|
||||
use Device::Firmata::Constants qw/ :all /;
|
||||
use Device::Firmata::IO;
|
||||
use Device::Firmata::Protocol;
|
||||
use Device::Firmata::Base
|
||||
ISA => 'Device::Firmata::Base',
|
||||
FIRMATA_ATTRIBS => {
|
||||
|
||||
# Object handlers
|
||||
io => undef,
|
||||
protocol => undef,
|
||||
|
||||
# Used for internal tracking of events/parameters
|
||||
#protocol_version => undef,
|
||||
#sysex_mode => undef,
|
||||
sysex_data => [],
|
||||
|
||||
# To track internal status
|
||||
analog_pins => [],
|
||||
ports => [],
|
||||
pins => {},
|
||||
pin_modes => {},
|
||||
|
||||
# To notify on events
|
||||
digital_observer => [],
|
||||
analog_observer => [],
|
||||
sysex_observer => undef,
|
||||
i2c_observer => undef,
|
||||
onewire_observer => [],
|
||||
scheduler_observer => undef,
|
||||
string_observer => undef,
|
||||
|
||||
# To track scheduled tasks
|
||||
tasks => [],
|
||||
|
||||
# For information about the device. eg: firmware version
|
||||
metadata => {},
|
||||
|
||||
# latest STRING_DATA response:
|
||||
stringresponse => {},
|
||||
};
|
||||
|
||||
=head2 open
|
||||
|
||||
Connect to the IO port and do some basic operations
|
||||
to find out how to connect to the device
|
||||
|
||||
=cut
|
||||
|
||||
sub open {
|
||||
|
||||
# --------------------------------------------------
|
||||
my ( $pkg, $port, $opts ) = @_;
|
||||
|
||||
my $self = ref $pkg ? $pkg : $pkg->new($opts);
|
||||
|
||||
my $ioport = Device::Firmata::IO->open( $port, $opts ) or return;
|
||||
|
||||
return $self->attach( $ioport, $opts );
|
||||
}
|
||||
|
||||
sub attach {
|
||||
|
||||
# --------------------------------------------------
|
||||
# Attach to an open IO port and do some basic operations
|
||||
# to find out how to connect to the device
|
||||
#
|
||||
my ( $pkg, $port, $opts ) = @_;
|
||||
|
||||
my $self = ref $pkg ? $pkg : $pkg->new($opts);
|
||||
|
||||
$self->{io} = $port or return;
|
||||
$self->{protocol} = Device::Firmata::Protocol->new($opts) or return;
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub detach {
|
||||
|
||||
my $self = shift;
|
||||
|
||||
delete $self->{io};
|
||||
}
|
||||
|
||||
sub system_reset {
|
||||
my $self = shift;
|
||||
$self->{io}->data_write($self->{protocol}->message_prepare( SYSTEM_RESET => 0 ));
|
||||
$self->{sysex_data} = [];
|
||||
$self->{analog_pins} = [];
|
||||
$self->{ports} = [];
|
||||
$self->{pins} = {};
|
||||
$self->{pin_modes} = {};
|
||||
$self->{digital_observer} = [];
|
||||
$self->{analog_observer} = [];
|
||||
$self->{sysex_observer} = undef;
|
||||
$self->{i2c_observer} = undef;
|
||||
$self->{onewire_observer} = [];
|
||||
$self->{scheduler_observer} = undef;
|
||||
$self->{tasks} = [];
|
||||
$self->{metadata} = {};
|
||||
}
|
||||
|
||||
=head2 messages_handle
|
||||
|
||||
Receive identified message packets and convert them
|
||||
into their appropriate structures and parse
|
||||
them as required
|
||||
|
||||
=cut
|
||||
|
||||
sub messages_handle {
|
||||
|
||||
# --------------------------------------------------
|
||||
my ( $self, $messages ) = @_;
|
||||
|
||||
return unless $messages;
|
||||
return unless @$messages;
|
||||
|
||||
# Now, handle the messages
|
||||
my $proto = $self->{protocol};
|
||||
for my $message (@$messages) {
|
||||
my $command = $message->{command_str};
|
||||
my $data = $message->{data};
|
||||
|
||||
COMMAND_HANDLE: {
|
||||
#* digital I/O message 0x90 port LSB(bits 0-6) MSB(bits 7-13)
|
||||
# Handle pin messages
|
||||
$command eq 'DIGITAL_MESSAGE' and do {
|
||||
my $port_number = $message->{command} & 0x0f;
|
||||
my $port_state = $data->[0] | ( $data->[1] << 7 );
|
||||
my $old_state = $self->{ports}[$port_number];
|
||||
my $changed_state =
|
||||
defined $old_state ? $old_state ^ $port_state : 0xFF;
|
||||
my $observers = $self->{digital_observer};
|
||||
my $pinbase = $port_number << 3;
|
||||
for ( my $i = 0 ; $i < 8 ; $i++ ) {
|
||||
my $pin = $pinbase + $i;
|
||||
my $observer = $observers->[$pin];
|
||||
if ($observer) {
|
||||
my $pin_mask = 1 << $i;
|
||||
if ( $changed_state & $pin_mask ) {
|
||||
$observer->{method}(
|
||||
$pin,
|
||||
defined $old_state
|
||||
? ( $old_state & $pin_mask ) > 0
|
||||
? 1
|
||||
: 0
|
||||
: undef,
|
||||
( $port_state & $pin_mask ) > 0 ? 1 : 0,
|
||||
$observer->{context}
|
||||
);
|
||||
}
|
||||
}
|
||||
}
|
||||
$self->{ports}[$port_number] = $port_state;
|
||||
};
|
||||
|
||||
# Handle analog pin messages
|
||||
$command eq 'ANALOG_MESSAGE' and do {
|
||||
my $pin_number = $message->{command} & 0x0f;
|
||||
my $pin_value = ( $data->[0] | ( $data->[1] << 7 ) ) / 1023;
|
||||
if (defined $self->{metadata}{analog_mappings}) {
|
||||
$pin_number = $self->{metadata}{analog_mappings}{$pin_number};
|
||||
}
|
||||
my $observer = $self->{analog_observer}[$pin_number];
|
||||
if ($observer) {
|
||||
my $old_value = $self->{analog_pins}[$pin_number];
|
||||
if ( !defined $old_value or !($old_value eq $pin_value) ) {
|
||||
$observer->{method}( $pin_number, $old_value, $pin_value, $observer->{context} );
|
||||
}
|
||||
}
|
||||
$self->{analog_pins}[$pin_number] = $pin_value;
|
||||
};
|
||||
|
||||
# Handle metadata information
|
||||
$command eq 'REPORT_VERSION' and do {
|
||||
$self->{metadata}{firmware_version} = sprintf "V_%i_%02i",
|
||||
@$data;
|
||||
last;
|
||||
};
|
||||
|
||||
# SYSEX handling
|
||||
$command eq 'START_SYSEX' and do {
|
||||
last;
|
||||
};
|
||||
$command eq 'DATA_SYSEX' and do {
|
||||
my $sysex_data = $self->{sysex_data};
|
||||
push @$sysex_data, @$data;
|
||||
last;
|
||||
};
|
||||
$command eq 'END_SYSEX' and do {
|
||||
my $sysex_data = $self->{sysex_data};
|
||||
my $sysex_message = $proto->sysex_parse($sysex_data);
|
||||
if ( defined $sysex_message ) {
|
||||
my $observer = $self->{sysex_observer};
|
||||
if (defined $observer) {
|
||||
$observer->{method} ($sysex_message, $observer->{context});
|
||||
}
|
||||
$self->sysex_handle($sysex_message);
|
||||
}
|
||||
$self->{sysex_data} = [];
|
||||
last;
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
$Device::Firmata::DEBUG and print " < $command\n";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
=head2 sysex_handle
|
||||
|
||||
Receive identified sysex packets and convert them
|
||||
into their appropriate structures and parse
|
||||
them as required
|
||||
|
||||
=cut
|
||||
|
||||
sub sysex_handle {
|
||||
|
||||
# --------------------------------------------------
|
||||
my ( $self, $sysex_message ) = @_;
|
||||
|
||||
my $data = $sysex_message->{data};
|
||||
|
||||
COMMAND_HANDLER: {
|
||||
$sysex_message->{command_str} eq 'REPORT_FIRMWARE' and do {
|
||||
$self->{metadata}{firmware_version} = sprintf "V_%i_%02i",
|
||||
$data->{major_version}, $data->{minor_version};
|
||||
$self->{metadata}{firmware} = $data->{firmware};
|
||||
last;
|
||||
};
|
||||
|
||||
$sysex_message->{command_str} eq 'CAPABILITY_RESPONSE' and do {
|
||||
my $capabilities = $data->{capabilities};
|
||||
$self->{metadata}{capabilities} = $capabilities;
|
||||
my @analogpins;
|
||||
my @inputpins;
|
||||
my @outputpins;
|
||||
my @i2cpins;
|
||||
my @onewirepins;
|
||||
foreach my $pin (keys %$capabilities) {
|
||||
if (defined $capabilities->{$pin}) {
|
||||
if ($capabilities->{$pin}->{PIN_INPUT+0}) {
|
||||
push @inputpins, $pin;
|
||||
}
|
||||
if ($capabilities->{$pin}->{PIN_OUTPUT+0}) {
|
||||
push @outputpins, $pin;
|
||||
}
|
||||
if ($capabilities->{$pin}->{PIN_ANALOG+0}) {
|
||||
push @analogpins, $pin;
|
||||
}
|
||||
if ($capabilities->{$pin}->{PIN_I2C+0}) {
|
||||
push @i2cpins, $pin;
|
||||
}
|
||||
if ($capabilities->{$pin}->{PIN_OUTPUT+0}) {
|
||||
push @onewirepins, $pin;
|
||||
}
|
||||
}
|
||||
}
|
||||
$self->{metadata}{input_pins} = \@inputpins;
|
||||
$self->{metadata}{output_pins} = \@outputpins;
|
||||
$self->{metadata}{analog_pins} = \@analogpins;
|
||||
$self->{metadata}{i2c_pins} = \@i2cpins;
|
||||
$self->{metadata}{onewire_pins} = \@onewirepins;
|
||||
last;
|
||||
};
|
||||
|
||||
$sysex_message->{command_str} eq 'ANALOG_MAPPING_RESPONSE' and do {
|
||||
$self->{metadata}{analog_mappings} = $data->{mappings};
|
||||
last;
|
||||
};
|
||||
|
||||
$sysex_message->{command_str} eq 'PIN_STATE_RESPONSE' and do {
|
||||
if (!defined $self->{metadata}{pinstates}) {
|
||||
$self->{metadata}{pinstates} = {};
|
||||
};
|
||||
$self->{metadata}{pinstates}{ $data->{pin} } = {
|
||||
mode => $data->{mode},
|
||||
state => $data->{state},
|
||||
};
|
||||
last;
|
||||
};
|
||||
|
||||
$sysex_message->{command_str} eq 'I2C_REPLY' and do {
|
||||
my $observer = $self->{i2c_observer};
|
||||
if (defined $observer) {
|
||||
$observer->{method}( $data, $observer->{context} );
|
||||
}
|
||||
last;
|
||||
};
|
||||
|
||||
$sysex_message->{command_str} eq 'ONEWIRE_REPLY' and do {
|
||||
my $pin = $data->{pin};
|
||||
my $observer = $self->{onewire_observer}[$pin];
|
||||
if (defined $observer) {
|
||||
$observer->{method}( $data, $observer->{context} );
|
||||
}
|
||||
last;
|
||||
};
|
||||
|
||||
$sysex_message->{command_str} eq 'SCHEDULER_REPLY' and do {
|
||||
my $observer = $self->{scheduler_observer};
|
||||
if (defined $observer) {
|
||||
$observer->{method}( $data, $observer->{context} );
|
||||
}
|
||||
last;
|
||||
};
|
||||
|
||||
$sysex_message->{command_str} eq 'STRING_DATA' and do {
|
||||
my $observer = $self->{string_observer};
|
||||
$self->{stringresponse} = $data->{string};
|
||||
if (defined $observer) {
|
||||
$observer->{method}( $data->{string}, $observer->{context} );
|
||||
}
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
=head2 probe
|
||||
|
||||
Request the version of the protocol that the
|
||||
target device is using. Sometimes, we'll have to
|
||||
wait a couple of seconds for the response so we'll
|
||||
try for 2 seconds and rapidly fire requests if
|
||||
we don't get a response quickly enough ;)
|
||||
|
||||
=cut
|
||||
|
||||
sub probe {
|
||||
|
||||
# --------------------------------------------------
|
||||
my ($self) = @_;
|
||||
|
||||
my $proto = $self->{protocol};
|
||||
my $io = $self->{io};
|
||||
$self->{metadata}{firmware_version} = '';
|
||||
|
||||
# Wait for 10 seconds only
|
||||
my $end_tics = time + 10;
|
||||
|
||||
# Query every .5 seconds
|
||||
my $query_tics = time;
|
||||
while ( $end_tics >= time ) {
|
||||
|
||||
if ( $query_tics <= time ) {
|
||||
|
||||
# Query the device for information on the firmata firmware_version
|
||||
$self->firmware_version_query();
|
||||
select (undef,undef,undef,0.1);
|
||||
|
||||
# Try to get a response
|
||||
$self->poll;
|
||||
|
||||
if ( $self->{metadata}{firmware}
|
||||
&& $self->{metadata}{firmware_version} )
|
||||
{
|
||||
$self->{protocol}->{protocol_version} = $self->{metadata}{firmware_version};
|
||||
|
||||
$self->analog_mapping_query();
|
||||
$self->capability_query();
|
||||
while ($end_tics >= time) {
|
||||
if (($self->{metadata}{analog_mappings}) and ($self->{metadata}{capabilities})) {
|
||||
return 1;
|
||||
}
|
||||
$self->poll();
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
$query_tics = time + 0.5;
|
||||
}
|
||||
select (undef,undef,undef,0.1);
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
=head2 pin_mode
|
||||
|
||||
Similar to the pinMode function on the
|
||||
arduino
|
||||
|
||||
=cut
|
||||
|
||||
sub pin_mode {
|
||||
|
||||
# --------------------------------------------------
|
||||
my ( $self, $pin, $mode ) = @_;
|
||||
|
||||
return undef unless $self->is_supported_mode($pin,$mode);
|
||||
|
||||
PIN_MODE_HANDLER: {
|
||||
|
||||
( $mode == PIN_INPUT or $mode == PIN_OUTPUT ) and do {
|
||||
my $port_number = $pin >> 3;
|
||||
$self->{io}->data_write($self->{protocol}->message_prepare( REPORT_DIGITAL => $port_number, 1 ));
|
||||
$self->{io}->data_write($self->{protocol}->message_prepare( SET_PIN_MODE => 0, $pin, $mode ));
|
||||
last;
|
||||
};
|
||||
|
||||
$mode == PIN_ANALOG and do {
|
||||
my $port_number = $pin >> 3;
|
||||
$self->{io}->data_write($self->{protocol}->message_prepare( REPORT_ANALOG => $port_number, 1 ));
|
||||
$self->{io}->data_write($self->{protocol}->message_prepare( SET_PIN_MODE => 0, $pin, $mode ));
|
||||
last;
|
||||
};
|
||||
|
||||
( $mode == PIN_PWM || $mode == PIN_I2C || $mode == PIN_ONEWIRE ) and do {
|
||||
$self->{io}->data_write($self->{protocol}->message_prepare( SET_PIN_MODE => 0, $pin, $mode ));
|
||||
last;
|
||||
};
|
||||
};
|
||||
$self->{pin_modes}->{$pin} = $mode;
|
||||
return 1;
|
||||
}
|
||||
|
||||
=head2 digital_write
|
||||
|
||||
Analogous to the digitalWrite function on the
|
||||
arduino
|
||||
|
||||
=cut
|
||||
|
||||
sub digital_write {
|
||||
|
||||
# --------------------------------------------------
|
||||
my ( $self, $pin, $state ) = @_;
|
||||
return undef unless $self->is_configured_mode($pin,PIN_OUTPUT);
|
||||
my $port_number = $pin >> 3;
|
||||
|
||||
my $pin_offset = $pin % 8;
|
||||
my $pin_mask = 1 << $pin_offset;
|
||||
|
||||
my $port_state = $self->{ports}[$port_number] ||= 0;
|
||||
if ($state) {
|
||||
$port_state |= $pin_mask;
|
||||
}
|
||||
else {
|
||||
$port_state &= $pin_mask ^ 0xff;
|
||||
}
|
||||
$self->{ports}[$port_number] = $port_state;
|
||||
$self->{io}->data_write($self->{protocol}->message_prepare( DIGITAL_MESSAGE => $port_number, $port_state ));
|
||||
return 1;
|
||||
}
|
||||
|
||||
=head2 digital_read
|
||||
|
||||
Analogous to the digitalRead function on the
|
||||
arduino
|
||||
|
||||
=cut
|
||||
|
||||
sub digital_read {
|
||||
|
||||
# --------------------------------------------------
|
||||
my ( $self, $pin ) = @_;
|
||||
return undef unless $self->is_configured_mode($pin,PIN_INPUT);
|
||||
my $port_number = $pin >> 3;
|
||||
my $pin_offset = $pin % 8;
|
||||
my $pin_mask = 1 << $pin_offset;
|
||||
my $port_state = $self->{ports}[$port_number] ||= 0;
|
||||
return ( $port_state & $pin_mask ? 1 : 0 );
|
||||
}
|
||||
|
||||
=head2 analog_read
|
||||
|
||||
Fetches the analog value of a pin
|
||||
|
||||
=cut
|
||||
|
||||
sub analog_read {
|
||||
|
||||
# --------------------------------------------------
|
||||
#
|
||||
my ( $self, $pin ) = @_;
|
||||
return undef unless $self->is_configured_mode($pin,PIN_ANALOG);
|
||||
return $self->{analog_pins}[$pin];
|
||||
}
|
||||
|
||||
=head2 analog_write
|
||||
|
||||
=cut
|
||||
|
||||
sub analog_write {
|
||||
|
||||
# --------------------------------------------------
|
||||
# Sets the PWM value on an arduino
|
||||
#
|
||||
my ( $self, $pin, $value ) = @_;
|
||||
return undef unless $self->is_configured_mode($pin,PIN_PWM);
|
||||
|
||||
# FIXME: 8 -> 7 bit translation should be done in the protocol module
|
||||
my $byte_0 = $value & 0x7f;
|
||||
my $byte_1 = $value >> 7;
|
||||
return $self->{io}->data_write($self->{protocol}->message_prepare( ANALOG_MESSAGE => $pin, $byte_0, $byte_1 ));
|
||||
}
|
||||
|
||||
=head2 pwm_write
|
||||
|
||||
pmw_write is an alias for analog_write
|
||||
|
||||
=cut
|
||||
|
||||
*pwm_write = *analog_write;
|
||||
|
||||
sub firmware_version_query {
|
||||
my $self = shift;
|
||||
my $firmware_version_query_packet = $self->{protocol}->packet_query_firmware;
|
||||
return $self->{io}->data_write($firmware_version_query_packet);
|
||||
}
|
||||
|
||||
sub capability_query {
|
||||
my $self = shift;
|
||||
my $capability_query_packet = $self->{protocol}->packet_query_capability();
|
||||
return $self->{io}->data_write($capability_query_packet);
|
||||
}
|
||||
|
||||
sub analog_mapping_query {
|
||||
my $self = shift;
|
||||
my $analog_mapping_query_packet = $self->{protocol}->packet_query_analog_mapping();
|
||||
return $self->{io}->data_write($analog_mapping_query_packet);
|
||||
}
|
||||
|
||||
sub pin_state_query {
|
||||
my ($self,$pin) = @_;
|
||||
my $pin_state_query_packet = $self->{protocol}->packet_query_pin_state($pin);
|
||||
return $self->{io}->data_write($pin_state_query_packet);
|
||||
}
|
||||
|
||||
sub sampling_interval {
|
||||
my ( $self, $sampling_interval ) = @_;
|
||||
my $sampling_interval_packet =
|
||||
$self->{protocol}->packet_sampling_interval($sampling_interval);
|
||||
return $self->{io}->data_write($sampling_interval_packet);
|
||||
}
|
||||
|
||||
sub i2c_write {
|
||||
my ($self,$address,@data) = @_;
|
||||
return $self->{io}->data_write($self->{protocol}->packet_i2c_request($address,0x0,@data));
|
||||
}
|
||||
|
||||
sub i2c_readonce {
|
||||
my ($self,$address,$register,$numbytes) = @_;
|
||||
my $packet = (defined $numbytes)
|
||||
? $self->{protocol}->packet_i2c_request($address,0x8,$register,$numbytes)
|
||||
: $self->{protocol}->packet_i2c_request($address,0x8,$register);
|
||||
return $self->{io}->data_write($packet);
|
||||
}
|
||||
|
||||
sub i2c_read {
|
||||
my ($self,$address,$register,$numbytes) = @_;
|
||||
return $self->{io}->data_write($self->{protocol}->packet_i2c_request($address,0x10,$register,$numbytes));
|
||||
}
|
||||
|
||||
sub i2c_stopreading {
|
||||
my ($self,$address) = @_;
|
||||
return $self->{io}->data_write($self->{protocol}->packet_i2c_request($address,0x18));
|
||||
}
|
||||
|
||||
sub i2c_config {
|
||||
my ( $self, $delay, @data ) = @_;
|
||||
return $self->{io}->data_write($self->{protocol}->packet_i2c_config($delay,@data));
|
||||
}
|
||||
|
||||
sub scheduler_create_task {
|
||||
my $self = shift;
|
||||
my $id=-1;
|
||||
my $tasks = $self->{tasks};
|
||||
for my $task (@$tasks) {
|
||||
if ($id < $task->{id}) {
|
||||
$id = $task->{id};
|
||||
}
|
||||
}
|
||||
$id++;
|
||||
my $newtask = {
|
||||
id => $id,
|
||||
data => [],
|
||||
time_ms => undef,
|
||||
};
|
||||
push @$tasks,$newtask;
|
||||
return $id;
|
||||
}
|
||||
|
||||
sub scheduler_delete_task {
|
||||
my ($self,$id) = @_;
|
||||
my $tasks = $self->{tasks};
|
||||
for my $task (@$tasks) {
|
||||
if ($id == $task->{id}) {
|
||||
if (defined $task->{time_ms}) {
|
||||
my $packet = $self->{protocol}->packet_delete_task($id);
|
||||
$self->{io}->data_write($packet);
|
||||
}
|
||||
delete $self->{tasks}[$id]; # delete $array[index]; (not delete @array[index];)
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub scheduler_add_to_task {
|
||||
my ($self,$id,$packet) = @_;
|
||||
my $tasks = $self->{tasks};
|
||||
for my $task (@$tasks) {
|
||||
if ($id == $task->{id}) {
|
||||
my $data = $task->{data};
|
||||
push @$data,unpack "C*", $packet;
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub scheduler_schedule_task {
|
||||
my ($self,$id,$time_ms) = @_;
|
||||
my $tasks = $self->{tasks};
|
||||
for my $task (@$tasks) {
|
||||
if ($id == $task->{id}) {
|
||||
if (!(defined $task->{time_ms})) { # TODO - a bit unclear why I put this test here in the first place. -> TODO: investigate and remove this check if not nessesary
|
||||
my $data = $task->{data};
|
||||
my $len = @$data;
|
||||
my $packet = $self->{protocol}->packet_create_task($id,$len);
|
||||
$self->{io}->data_write($packet);
|
||||
my $bytesPerPacket = 53; # (64-1)*7/8-2 (1 byte command, 1 byte for subcommand, 1 byte taskid)
|
||||
my $j=0;
|
||||
my @packetdata;
|
||||
for (my $i=0;$i<$len;$i++) {
|
||||
push @packetdata,@$data[$i];
|
||||
$j++;
|
||||
if ($j==$bytesPerPacket) {
|
||||
$j=0;
|
||||
$packet = $self->{protocol}->packet_add_to_task($id,@packetdata);
|
||||
$self->{io}->data_write($packet);
|
||||
@packetdata = ();
|
||||
}
|
||||
}
|
||||
if ($j>0) {
|
||||
$packet = $self->{protocol}->packet_add_to_task($id,@packetdata);
|
||||
$self->{io}->data_write($packet);
|
||||
}
|
||||
}
|
||||
my $packet = $self->{protocol}->packet_schedule_task($id,$time_ms);
|
||||
$self->{io}->data_write($packet);
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub scheduler_reset {
|
||||
my $self = shift;
|
||||
my $packet = $self->{protocol}->packet_reset_scheduler;
|
||||
$self->{io}->data_write($packet);
|
||||
$self->{tasks} = [];
|
||||
}
|
||||
|
||||
sub scheduler_query_all_tasks {
|
||||
my $self = shift;
|
||||
my $packet = $self->{protocol}->packet_query_all_tasks;
|
||||
$self->{io}->data_write($packet);
|
||||
}
|
||||
|
||||
sub scheduler_query_task {
|
||||
my ($self,$id) = @_;
|
||||
my $packet = $self->{protocol}->packet_query_task($id);
|
||||
$self->{io}->data_write($packet);
|
||||
}
|
||||
|
||||
# SEARCH_REQUEST,
|
||||
# CONFIG_REQUEST,
|
||||
|
||||
#$args = {
|
||||
# reset => undef | 1,
|
||||
# skip => undef | 1,
|
||||
# select => undef | device,
|
||||
# read => undef | short int,
|
||||
# delay => undef | long int,
|
||||
# write => undef | bytes[],
|
||||
#}
|
||||
|
||||
sub onewire_search {
|
||||
my ( $self, $pin ) = @_;
|
||||
return undef unless $self->is_configured_mode($pin,PIN_ONEWIRE);
|
||||
return $self->{io}->data_write($self->{protocol}->packet_onewire_search_request( $pin ));
|
||||
}
|
||||
|
||||
sub onewire_search_alarms {
|
||||
my ( $self, $pin ) = @_;
|
||||
return undef unless $self->is_configured_mode($pin,PIN_ONEWIRE);
|
||||
return $self->{io}->data_write($self->{protocol}->packet_onewire_search_alarms_request( $pin ));
|
||||
}
|
||||
|
||||
sub onewire_config {
|
||||
my ( $self, $pin, $power ) = @_;
|
||||
return undef unless $self->is_configured_mode($pin,PIN_ONEWIRE);
|
||||
return $self->{io}->data_write($self->{protocol}->packet_onewire_config_request( $pin, $power ));
|
||||
}
|
||||
|
||||
sub onewire_reset {
|
||||
my ( $self, $pin ) = @_;
|
||||
return $self->onewire_command_series( $pin, {reset => 1} );
|
||||
}
|
||||
|
||||
sub onewire_skip {
|
||||
my ( $self, $pin ) = @_;
|
||||
return $self->onewire_command_series( $pin, {skip => 1} );
|
||||
}
|
||||
|
||||
sub onewire_select {
|
||||
my ( $self, $pin, $device ) = @_;
|
||||
return $self->onewire_command_series( $pin, {select => $device} );
|
||||
}
|
||||
|
||||
sub onewire_read {
|
||||
my ( $self, $pin, $numBytes ) = @_;
|
||||
return $self->onewire_command_series( $pin, {read => $numBytes} );
|
||||
}
|
||||
|
||||
sub onewire_write {
|
||||
my ( $self, $pin, @data ) = @_;
|
||||
return $self->onewire_command_series( $pin, {write => \@data} );
|
||||
}
|
||||
|
||||
sub onewire_command_series {
|
||||
my ( $self, $pin, $args ) = @_;
|
||||
return undef unless $self->is_configured_mode($pin,PIN_ONEWIRE);
|
||||
return $self->{io}->data_write($self->{protocol}->packet_onewire_request( $pin, $args ));
|
||||
}
|
||||
|
||||
=head2 poll
|
||||
|
||||
Call this function every once in a while to
|
||||
check up on the status of the comm port, receive
|
||||
and process data from the arduino
|
||||
|
||||
=cut
|
||||
|
||||
sub poll {
|
||||
|
||||
# --------------------------------------------------
|
||||
my $self = shift;
|
||||
my $buf = $self->{io}->data_read(100) or return;
|
||||
my $messages = $self->{protocol}->message_data_receive($buf);
|
||||
$self->messages_handle($messages);
|
||||
return $messages;
|
||||
}
|
||||
|
||||
sub observe_digital {
|
||||
my ( $self, $pin, $observer, $context ) = @_;
|
||||
return undef unless ($self->is_supported_mode($pin,PIN_INPUT));
|
||||
$self->{digital_observer}[$pin] = {
|
||||
method => $observer,
|
||||
context => $context,
|
||||
};
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub observe_analog {
|
||||
my ( $self, $pin, $observer, $context ) = @_;
|
||||
return undef unless ($self->is_supported_mode($pin,PIN_ANALOG));
|
||||
$self->{analog_observer}[$pin] = {
|
||||
method => $observer,
|
||||
context => $context,
|
||||
};
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub observe_sysex {
|
||||
my ( $self, $observer, $context ) = @_;
|
||||
$self->{sysex_observer} = {
|
||||
method => $observer,
|
||||
context => $context,
|
||||
};
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub observe_i2c {
|
||||
my ( $self, $observer, $context ) = @_;
|
||||
return undef if (defined $self->{metadata}->{i2cpins} && @$self->{metadata}->{i2cpins} == 0 );
|
||||
$self->{i2c_observer} = {
|
||||
method => $observer,
|
||||
context => $context,
|
||||
};
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub observe_onewire {
|
||||
my ( $self, $pin, $observer, $context ) = @_;
|
||||
return undef unless ($self->is_supported_mode($pin,PIN_INPUT));
|
||||
return undef unless ($self->is_supported_mode($pin,PIN_OUTPUT));
|
||||
$self->{onewire_observer}[$pin] = {
|
||||
method => $observer,
|
||||
context => $context,
|
||||
};
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub observe_scheduler {
|
||||
my ( $self, $observer, $context ) = @_;
|
||||
$self->{scheduler_observer} = {
|
||||
method => $observer,
|
||||
context => $context,
|
||||
};
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub observe_string {
|
||||
my ( $self, $observer, $context ) = @_;
|
||||
$self->{string_observer} = {
|
||||
method => $observer,
|
||||
context => $context,
|
||||
};
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub is_supported_mode {
|
||||
my ($self,$pin,$mode) = @_;
|
||||
die "unsupported mode '".$mode."' for pin '".$pin."'" if (defined $self->{metadata}->{capabilities} and (!(defined $self->{metadata}->{capabilities}->{$pin}) or !(defined $self->{metadata}->{capabilities}->{$pin}->{$mode})));
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub is_configured_mode {
|
||||
my ($self,$pin,$mode) = @_;
|
||||
die "pin '".$pin."' is not configured for mode '".$mode."'" if (!defined $self->{pin_modes}->{$pin} or $self->{pin_modes}->{$pin} != $mode);
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
19
fhem/FHEM/lib/Device/Firmata/Platform/Arduino.pm
Normal file
19
fhem/FHEM/lib/Device/Firmata/Platform/Arduino.pm
Normal file
@ -0,0 +1,19 @@
|
||||
package Device::Firmata::Platform::Arduino;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Device::Firmata::Platform::Arduino - subclass for the arduino itself
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
No customization requried at this time so this is just a specification of the
|
||||
Device::Firmata::Platform class
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use Device::Firmata::Platform;
|
||||
use Device::Firmata::Base
|
||||
ISA => 'Device::Firmata::Platform';
|
||||
|
||||
1;
|
||||
1018
fhem/FHEM/lib/Device/Firmata/Protocol.pm
Normal file
1018
fhem/FHEM/lib/Device/Firmata/Protocol.pm
Normal file
File diff suppressed because it is too large
Load Diff
46
fhem/FHEM/lib/README.perl-firmata
Normal file
46
fhem/FHEM/lib/README.perl-firmata
Normal file
@ -0,0 +1,46 @@
|
||||
Device-Firmata
|
||||
|
||||
Device::Firmata provides an host side interface to the Firmata protocol for talking to arduino microcontroler platform. See http://firmata.org/wiki/Main_Page for some details.
|
||||
|
||||
INSTALLATION
|
||||
|
||||
To install this module, run the following commands:
|
||||
|
||||
perl Makefile.PL
|
||||
make
|
||||
make test
|
||||
make install
|
||||
|
||||
SUPPORT AND DOCUMENTATION
|
||||
|
||||
After installing, you can find documentation for this module with the
|
||||
perldoc command.
|
||||
|
||||
perldoc Device::Firmata
|
||||
|
||||
You can also look for information at:
|
||||
|
||||
RT, CPAN's request tracker
|
||||
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Device-Firmata
|
||||
|
||||
AnnoCPAN, Annotated CPAN documentation
|
||||
http://annocpan.org/dist/Device-Firmata
|
||||
|
||||
CPAN Ratings
|
||||
http://cpanratings.perl.org/d/Device-Firmata
|
||||
|
||||
Search CPAN
|
||||
http://search.cpan.org/dist/Device-Firmata/
|
||||
|
||||
|
||||
LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright (C) 2011 amimato
|
||||
Copyright (C) 2012 ntruchsess
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the terms of either: the GNU General Public License as published
|
||||
by the Free Software Foundation; or the Artistic License.
|
||||
|
||||
See http://dev.perl.org/licenses/ for more information.
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user