diff --git a/fhem/FHEM/lib/Device/Firmata.pm b/fhem/FHEM/lib/Device/Firmata.pm new file mode 100644 index 000000000..1f7b36813 --- /dev/null +++ b/fhem/FHEM/lib/Device/Firmata.pm @@ -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; diff --git a/fhem/FHEM/lib/Device/Firmata/Base.pm b/fhem/FHEM/lib/Device/Firmata/Base.pm new file mode 100644 index 000000000..766b4014e --- /dev/null +++ b/fhem/FHEM/lib/Device/Firmata/Base.pm @@ -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; + diff --git a/fhem/FHEM/lib/Device/Firmata/Constants.pm b/fhem/FHEM/lib/Device/Firmata/Constants.pm new file mode 100644 index 000000000..8e9732776 --- /dev/null +++ b/fhem/FHEM/lib/Device/Firmata/Constants.pm @@ -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; diff --git a/fhem/FHEM/lib/Device/Firmata/Error.pm b/fhem/FHEM/lib/Device/Firmata/Error.pm new file mode 100644 index 000000000..3c509d5fb --- /dev/null +++ b/fhem/FHEM/lib/Device/Firmata/Error.pm @@ -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; + + diff --git a/fhem/FHEM/lib/Device/Firmata/IO.pm b/fhem/FHEM/lib/Device/Firmata/IO.pm new file mode 100644 index 000000000..dc2a6a602 --- /dev/null +++ b/fhem/FHEM/lib/Device/Firmata/IO.pm @@ -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; diff --git a/fhem/FHEM/lib/Device/Firmata/Language.pm b/fhem/FHEM/lib/Device/Firmata/Language.pm new file mode 100644 index 000000000..00425cb30 --- /dev/null +++ b/fhem/FHEM/lib/Device/Firmata/Language.pm @@ -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 , + diff --git a/fhem/FHEM/lib/Device/Firmata/Platform.pm b/fhem/FHEM/lib/Device/Firmata/Platform.pm new file mode 100644 index 000000000..016a8a727 --- /dev/null +++ b/fhem/FHEM/lib/Device/Firmata/Platform.pm @@ -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; diff --git a/fhem/FHEM/lib/Device/Firmata/Platform/Arduino.pm b/fhem/FHEM/lib/Device/Firmata/Platform/Arduino.pm new file mode 100644 index 000000000..2d0a3c6cd --- /dev/null +++ b/fhem/FHEM/lib/Device/Firmata/Platform/Arduino.pm @@ -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; diff --git a/fhem/FHEM/lib/Device/Firmata/Protocol.pm b/fhem/FHEM/lib/Device/Firmata/Protocol.pm new file mode 100644 index 000000000..21638a132 --- /dev/null +++ b/fhem/FHEM/lib/Device/Firmata/Protocol.pm @@ -0,0 +1,1018 @@ +package Device::Firmata::Protocol; + +=head1 NAME + +Device::Firmata::Protocol - details of the actual firmata protocol + +=cut + +use strict; +use warnings; +use vars qw/ $MIDI_DATA_SIZES /; + +use constant { + MIDI_COMMAND => 0x80, + MIDI_PARSE_NORMAL => 0, + MIDI_PARSE_SYSEX => 1, + MIDI_START_SYSEX => 0xf0, + MIDI_END_SYSEX => 0xf7, +}; + +use Device::Firmata::Constants qw/ :all /; +use Device::Firmata::Base + ISA => 'Device::Firmata::Base', + FIRMATA_ATTRIBS => { + buffer => [], + parse_status => MIDI_PARSE_NORMAL, + protocol_version => 'V_2_04', # We are starting with the highest protocol + }; + +$MIDI_DATA_SIZES = { + 0x80 => 2, + 0x90 => 2, + 0xA0 => 2, + 0xB0 => 2, + 0xC0 => 1, + 0xD0 => 1, + 0xE0 => 2, + 0xF0 => 0, # note that this requires special handling + + # Special for version queries + 0xF4 => 2, + 0xF9 => 2, + 0x71 => 0, + 0xFF => 0, +}; + +our $ONE_WIRE_COMMANDS = { + SEARCH_REQUEST => 0x40, + CONFIG_REQUEST => 0x41, + SEARCH_REPLY => 0x42, + READ_REPLY => 0x43, + SEARCH_ALARMS_REQUEST => 0x44, + SEARCH_ALARMS_REPLY => 0x45, + RESET_REQUEST_BIT => 0x01, + SKIP_REQUEST_BIT => 0x02, + SELECT_REQUEST_BIT => 0x04, + READ_REQUEST_BIT => 0x08, + DELAY_REQUEST_BIT => 0x10, + WRITE_REQUEST_BIT => 0x20, +}; + +our $SCHEDULER_COMMANDS = { + CREATE_FIRMATA_TASK => 0, + DELETE_FIRMATA_TASK => 1, + ADD_TO_FIRMATA_TASK => 2, + DELAY_FIRMATA_TASK => 3, + SCHEDULE_FIRMATA_TASK => 4, + QUERY_ALL_FIRMATA_TASKS => 5, + QUERY_FIRMATA_TASK => 6, + RESET_FIRMATA_TASKS => 7, + ERROR_TASK_REPLY => 8, + QUERY_ALL_TASKS_REPLY => 9, + QUERY_TASK_REPLY => 10, +}; + +our $MODENAMES = { + 0 => 'INPUT', + 1 => 'OUTPUT', + 2 => 'ANALOG', + 3 => 'PWM', + 4 => 'SERVO', + 5 => 'SHIFT', + 6 => 'I2C', + 7 => 'ONEWIRE', +}; + +=head1 DESCRIPTION + +Because we're dealing with a permutation of the +MIDI protocol, certain commands are one bytes, +others 2 or even 3. We do this part to figure out +how many bytes we're actually looking at + +One of the first things to know is that that while +MIDI is packet based, the bytes have specialized +construction (where the top-most bit has been +reserved to differentiate if it's a command or a +data bit) + +So on any byte being transferred in a MIDI stream, it +will look like the following + + BIT# | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 | + DATA | X | ? | ? | ? | ? | ? | ? | ? | + +If X is a "1" this byte is considered a command byte +If X is a "0" this byte is considered a data bte + +We figure out how many bytes a packet is by looking at the +command byte and of that byte, only the high nybble. +This nybble tells us the requisite information via a lookup +table... + +See: http://www.midi.org/techspecs/midimessages.php +And +http://www.ccarh.org/courses/253/handout/midiprotocol/ +For more information + +Basically, however: + +command +nibble bytes +8 2 +9 2 +A 2 +B 2 +C 1 +D 1 +E 2 +F 0 or variable + +=cut + +=head2 message_data_receive + +Receive a string of data. Normally, only one byte +is passed due to the code but you can also pass as +many bytes in a string as you'd like + +=cut + +sub message_data_receive { + + # -------------------------------------------------- + my ( $self, $data ) = @_; + + defined $data and length $data or return; + + my $protocol_version = $self->{protocol_version}; + my $protocol_commands = $COMMANDS->{$protocol_version}; + my $protocol_lookup = $COMMAND_LOOKUP->{$protocol_version}; + + # Add the new data to the buffer + my $buffer = $self->{buffer} ||= []; + push @$buffer, unpack "C*", $data; + + my @packets; + + # Loop until we're finished parsing all available packets + while (@$buffer) { + + # Not in SYSEX mode, we can proceed normally + if ( $self->{parse_status} == MIDI_PARSE_NORMAL + and $buffer->[0] == MIDI_START_SYSEX ) + { + my $command = shift @$buffer; + push @packets, + { + command => $command, + command_str => $protocol_lookup->{$command} || 'START_SYSEX', + }; + $self->{parse_status} = MIDI_PARSE_SYSEX; + next; + } + + # If in sysex mode, we will check for the end of the sysex message here + elsif ( $self->{parse_status} == MIDI_PARSE_SYSEX + and $buffer->[0] == MIDI_END_SYSEX ) + { + $self->{parse_status} = MIDI_PARSE_NORMAL; + my $command = shift @$buffer; + push @packets, + { + command => $command, + command_str => $protocol_lookup->{$command} || 'END_SYSEX', + }; + } + +# Regardless of the SYSEX mode we are in, we will allow commands to interrupt the flowthrough + elsif ( $buffer->[0] & MIDI_COMMAND ) { + my $command = $buffer->[0] & 0xf0; + my $bytes = + ( $MIDI_DATA_SIZES->{$command} + || $MIDI_DATA_SIZES->{ $buffer->[0] } ) + 1; + if ( @$buffer < $bytes ) { + last; + } + my @data = splice @$buffer, 0, $bytes; + $command = shift @data; + push @packets, + { + command => $command, + command_str => $protocol_lookup->{$command} + || $protocol_lookup->{ $command & 0xf0 } + || 'UNKNOWN', + data => \@data + }; + } + +# We have a data byte, if we're in SYSEX mode, we'll just add that to the data stream +# packet + elsif ( $self->{parse_status} == MIDI_PARSE_SYSEX ) { + + my $data = shift @$buffer; + if ( @packets and $packets[-1]{command_str} eq 'DATA_SYSEX' ) { + push @{ $packets[-1]{data} }, $data; + } + else { + push @packets, + { + command => 0x0, + command_str => 'DATA_SYSEX', + data => [$data] + }; + } + + } + + # No idea what to do with this one, eject it and skip to the next + else { + shift @$buffer; + if ( not @$buffer ) { + last; + } + } + + } + + return if not @packets; + return \@packets; +} + +=head2 sysex_parse + +Takes the sysex data buffer and parses it into +something useful + +=cut + +sub sysex_parse { + + # -------------------------------------------------- + my ( $self, $sysex_data ) = @_; + + my $protocol_version = $self->{protocol_version}; + my $protocol_commands = $COMMANDS->{$protocol_version}; + my $protocol_lookup = $COMMAND_LOOKUP->{$protocol_version}; + + my $command = shift @$sysex_data; + if ( defined $command ) { + my $command_str = $protocol_lookup->{$command}; + + if ($command_str) { + my $return_data; + + COMMAND_HANDLER: { + + $command == $protocol_commands->{STRING_DATA} and do { + $return_data = $self->handle_string_data($sysex_data); + last; + }; + + $command == $protocol_commands->{REPORT_FIRMWARE} and do { + $return_data = $self->handle_report_firmware($sysex_data); + last; + }; + + $command == $protocol_commands->{CAPABILITY_RESPONSE} and do { + $return_data = $self->handle_capability_response($sysex_data); + last; + }; + + $command == $protocol_commands->{ANALOG_MAPPING_RESPONSE} and do { + $return_data = + $self->handle_analog_mapping_response($sysex_data); + last; + }; + + $command == $protocol_commands->{PIN_STATE_RESPONSE} and do { + $return_data = $self->handle_pin_state_response($sysex_data); + last; + }; + + $command == $protocol_commands->{I2C_REPLY} and do { + $return_data = $self->handle_i2c_reply($sysex_data); + last; + }; + + $command == $protocol_commands->{ONEWIRE_REPLY} and do { + $return_data = $self->handle_onewire_reply($sysex_data); + last; + }; + + $command == $protocol_commands->{SCHEDULER_REPLY} and do { + $return_data = $self->handle_scheduler_reply($sysex_data); + last; + }; + + } + + return { + command => $command, + command_str => $command_str, + data => $return_data + }; + } + } + return undef; +} + +=head2 message_prepare + +Using the midi protocol, create a binary packet +that can be transmitted to the serial output + +=cut + +sub message_prepare { + + # -------------------------------------------------- + my ( $self, $command_name, $channel, @data ) = @_; + + my $protocol_version = $self->{protocol_version}; + my $protocol_commands = $COMMANDS->{$protocol_version}; + my $command = $protocol_commands->{$command_name} or return; + + my $bytes = 1 + + ( $MIDI_DATA_SIZES->{ $command & 0xf0 } || $MIDI_DATA_SIZES->{$command} ); + my $packet = pack "C" x $bytes, $command | $channel, @data; + return $packet; +} + +=head2 packet_sysex_command + +create a binary packet containing a sysex-command + +=cut + +sub packet_sysex_command { + + my ( $self, $command_name, @data ) = @_; + + my $protocol_version = $self->{protocol_version}; + my $protocol_commands = $COMMANDS->{$protocol_version}; + my $command = $protocol_commands->{$command_name} or return; + +# my $bytes = 3+($MIDI_DATA_SIZES->{$command & 0xf0}||$MIDI_DATA_SIZES->{$command}); + my $bytes = @data + 3; + my $packet = pack "C" x $bytes, $protocol_commands->{START_SYSEX}, + $command, + @data, + $protocol_commands->{END_SYSEX}; + return $packet; +} + +=head2 packet_query_version + +Craft a firmware version query packet to be sent + +=cut + +sub packet_query_version { + + my $self = shift; + return $self->message_prepare( REPORT_VERSION => 0 ); + +} + +sub handle_query_version_response { + +} + +sub handle_string_data { + my ( $self, $sysex_data ) = @_; + return { + string => double_7bit_to_string($sysex_data) + }; +} + +=head2 packet_query_firmware + +Craft a firmware variant query packet to be sent + +=cut + +sub packet_query_firmware { + + my $self = shift; + + return $self->packet_sysex_command(REPORT_FIRMWARE); +} + +sub handle_report_firmware { + + my ( $self, $sysex_data ) = @_; + + return { + major_version => shift @$sysex_data, + minor_version => shift @$sysex_data, + firmware => double_7bit_to_string($sysex_data) + }; +} + +sub packet_query_capability { + + my $self = shift; + + return $self->packet_sysex_command(CAPABILITY_QUERY); +} + +#/* capabilities response +# * ------------------------------- +# * 0 START_SYSEX (0xF0) (MIDI System Exclusive) +# * 1 capabilities response (0x6C) +# * 2 1st mode supported of pin 0 +# * 3 1st mode's resolution of pin 0 +# * 4 2nd mode supported of pin 0 +# * 5 2nd mode's resolution of pin 0 +# ... additional modes/resolutions, followed by a single 127 to mark the +# end of the first pin's modes. Each pin follows with its mode and +# 127, until all pins implemented. +# * N END_SYSEX (0xF7) +# */ + +sub handle_capability_response { + + my ( $self, $sysex_data ) = @_; + + my %capabilities; + + my $byte = shift @$sysex_data; + my $i=0; + while ( defined $byte ) { + + my %pinmodes; + while ( defined $byte && $byte != 127 ) { + $pinmodes{$byte} = { + mode_str => $MODENAMES->{$byte}, + resolution => shift @$sysex_data # /secondbyte + }; + $byte = shift @$sysex_data; + } + $capabilities{$i}=\%pinmodes; + $i++; + $byte = shift @$sysex_data; + } + + return { capabilities => \%capabilities }; + +} + +sub packet_query_analog_mapping { + + my $self = shift; + + return $self->packet_sysex_command(ANALOG_MAPPING_QUERY); +} + +#/* analog mapping response +# * ------------------------------- +# * 0 START_SYSEX (0xF0) (MIDI System Exclusive) +# * 1 analog mapping response (0x6A) +# * 2 analog channel corresponding to pin 0, or 127 if pin 0 does not support analog +# * 3 analog channel corresponding to pin 1, or 127 if pin 1 does not support analog +# * 4 analog channel corresponding to pin 2, or 127 if pin 2 does not support analog +# ... etc, one byte for each pin +# * N END_SYSEX (0xF7) +# */ + +sub handle_analog_mapping_response { + + my ( $self, $sysex_data ) = @_; + + my %pins; + my $pin_mapping = shift @$sysex_data; + my $i=0; + + while ( defined $pin_mapping ) { + if ($pin_mapping!=127) { + $pins{$pin_mapping}=$i; + } + $pin_mapping = shift @$sysex_data; + $i++; + } + + return { mappings => \%pins }; +} + +#/* pin state query +# * ------------------------------- +# * 0 START_SYSEX (0xF0) (MIDI System Exclusive) +# * 1 pin state query (0x6D) +# * 2 pin (0 to 127) +# * 3 END_SYSEX (0xF7) (MIDI End of SysEx - EOX) +# */ + +sub packet_query_pin_state { + + my ( $self, $pin ) = @_; + + return $self->packet_sysex_command( PIN_STATE_QUERY, $pin ); +} + +#/* pin state response +# * ------------------------------- +# * 0 START_SYSEX (0xF0) (MIDI System Exclusive) +# * 1 pin state response (0x6E) +# * 2 pin (0 to 127) +# * 3 pin mode (the currently configured mode) +# * 4 pin state, bits 0-6 +# * 5 (optional) pin state, bits 7-13 +# * 6 (optional) pin state, bits 14-20 +# ... additional optional bytes, as many as needed +# * N END_SYSEX (0xF7) +# */ + +sub handle_pin_state_response { + + my ( $self, $sysex_data ) = @_; + + my $pin = shift @$sysex_data; + my $mode = shift @$sysex_data; + my $state = shift @$sysex_data & 0x7f; + + my $nibble = shift @$sysex_data; + for ( my $i = 1 ; defined $nibble ; $nibble = shift @$sysex_data ) { + $state += ( $nibble & 0x7f ) << ( 7 * $i ); + } + + return { + pin => $pin, + mode => $mode, + moden_str => $MODENAMES->{$mode}, + state => $state + }; + +} + +sub packet_sampling_interval { + + my ( $self, $interval ) = @_; + + return $self->packet_sysex_command( SAMPLING_INTERVAL, + $interval & 0x7f, + $interval >> 7 + ); +} + +#/* I2C read/write request +# * ------------------------------- +# * 0 START_SYSEX (0xF0) (MIDI System Exclusive) +# * 1 I2C_REQUEST (0x76) +# * 2 slave address (LSB) +# * 3 slave address (MSB) + read/write and address mode bits +# {7: always 0} + {6: reserved} + {5: address mode, 1 means 10-bit mode} + +# {4-3: read/write, 00 => write, 01 => read once, 10 => read continuously, 11 => stop reading} + +# {2-0: slave address MSB in 10-bit mode, not used in 7-bit mode} +# * 4 data 0 (LSB) +# * 5 data 0 (MSB) +# * 6 data 1 (LSB) +# * 7 data 1 (MSB) +# * ... +# * n END_SYSEX (0xF7) +# */ + +sub packet_i2c_request { + + my ( $self, $address, $command, @i2cdata ) = @_; + + if (($address & 0x380) > 0) { + $command |= (0x20 | (($address >> 7) & 0x7)); + } + + if (scalar @i2cdata) { + my @data; + push_array_as_two_7bit(\@i2cdata,\@data); + return $self->packet_sysex_command( I2C_REQUEST, + $address & 0x7f, + $command, + @data, + ); + } else { + return $self->packet_sysex_command( I2C_REQUEST, + $address & 0x7f, + $command, + ); + } +} + +#/* I2C reply +# * ------------------------------- +# * 0 START_SYSEX (0xF0) (MIDI System Exclusive) +# * 1 I2C_REPLY (0x77) +# * 2 slave address (LSB) +# * 3 slave address (MSB) +# * 4 register (LSB) +# * 5 register (MSB) +# * 6 data 0 LSB +# * 7 data 0 MSB +# * ... +# * n END_SYSEX (0xF7) +# */ + +sub handle_i2c_reply { + + my ( $self, $sysex_data ) = @_; + + my $address = shift14bit($sysex_data); + my $register = shift14bit($sysex_data); + my @data = double_7bit_to_array($sysex_data); + return { + address => $address, + register => $register, + data => \@data, + }; +} + +#/* I2C config +# * ------------------------------- +# * 0 START_SYSEX (0xF0) (MIDI System Exclusive) +# * 1 I2C_CONFIG (0x78) +# * 2 Delay in microseconds (LSB) +# * 3 Delay in microseconds (MSB) +# * ... user defined for special cases, etc +# * n END_SYSEX (0xF7) +# */ + +sub packet_i2c_config { + + my ( $self, $delay, @data ) = @_; + + return $self->packet_sysex_command( I2C_CONFIG, + $delay & 0x7f, + $delay >> 7, @data + ); +} + +#/* servo config +# * -------------------- +# * 0 START_SYSEX (0xF0) +# * 1 SERVO_CONFIG (0x70) +# * 2 pin number (0-127) +# * 3 minPulse LSB (0-6) +# * 4 minPulse MSB (7-13) +# * 5 maxPulse LSB (0-6) +# * 6 maxPulse MSB (7-13) +# * 7 END_SYSEX (0xF7) +# */ + +sub packet_servo_config { + + my ( $self, $data ) = @_; + + my $min_pulse = $data->{min_pulse}; + my $max_pulse = $data->{max_pulse}; + + return $self->packet_sysex_command( SERVO_CONFIG, + $data->{pin} & 0x7f, + $min_pulse & 0x7f, + $min_pulse >> 7, + $max_pulse & 0x7f, + $max_pulse >> 7 + ); +} + +#This is just the standard SET_PIN_MODE message: + +#/* set digital pin mode +# * -------------------- +# * 1 set digital pin mode (0xF4) (MIDI Undefined) +# * 2 pin number (0-127) +# * 3 state (INPUT/OUTPUT/ANALOG/PWM/SERVO, 0/1/2/3/4) +# */ + +#Then the normal ANALOG_MESSAGE data format is used to send data. + +#/* write to servo, servo write is performed if the pins mode is SERVO +# * ------------------------------ +# * 0 ANALOG_MESSAGE (0xE0-0xEF) +# * 1 value lsb +# * 2 value msb +# */ + +sub packet_onewire_search_request { + my ( $self, $pin ) = @_; + return $self->packet_sysex_command( ONEWIRE_REQUEST,$ONE_WIRE_COMMANDS->{SEARCH_REQUEST},$pin); +}; + +sub packet_onewire_search_alarms_request { + my ( $self, $pin ) = @_; + return $self->packet_sysex_command( ONEWIRE_REQUEST,$ONE_WIRE_COMMANDS->{SEARCH_ALARMS_REQUEST},$pin); +}; + +sub packet_onewire_config_request { + my ( $self, $pin, $power ) = @_; + return $self->packet_sysex_command( ONEWIRE_REQUEST, $ONE_WIRE_COMMANDS->{CONFIG_REQUEST},$pin, + ( defined $power ) ? $power : 1 + ); +}; + +#$args = { +# reset => undef | 1, +# skip => undef | 1, +# select => undef | device, +# read => undef | short int, +# delay => undef | long int, +# write => undef | bytes[], +#} + +sub packet_onewire_request { + my ( $self, $pin, $args ) = @_; + my $subcommand = 0; + my @data; + if (defined $args->{reset}) { + $subcommand |= $ONE_WIRE_COMMANDS->{RESET_REQUEST_BIT}; + } + if (defined $args->{skip}) { + $subcommand |= $ONE_WIRE_COMMANDS->{SKIP_REQUEST_BIT}; + } + if (defined $args->{select}) { + $subcommand |= $ONE_WIRE_COMMANDS->{SELECT_REQUEST_BIT}; + push_onewire_device_to_byte_array($args->{select},\@data); + } + if (defined $args->{read}) { + $subcommand |= $ONE_WIRE_COMMANDS->{READ_REQUEST_BIT}; + push @data,$args->{read} & 0xFF; + push @data,($args->{read}>>8) & 0xFF; + } + if (defined $args->{delay}) { + $subcommand |= $ONE_WIRE_COMMANDS->{DELAY_REQUEST_BIT}; + push @data,$args->{delay} & 0xFF; + push @data,($args->{delay}>>8) & 0xFF; + push @data,($args->{delay}>>16) & 0xFF; + push @data,($args->{delay}>>24) & 0xFF; + } + if (defined $args->{write}) { + $subcommand |= $ONE_WIRE_COMMANDS->{WRITE_REQUEST_BIT}; + my $writeBytes=$args->{write}; + push @data,@$writeBytes; + } + return $self->packet_sysex_command( ONEWIRE_REQUEST, $subcommand, $pin, pack_as_7bit(@data)); +}; + +sub handle_onewire_reply { + + my ( $self, $sysex_data ) = @_; + + my $command = shift @$sysex_data; + my $pin = shift @$sysex_data; + + if ( defined $command ) { + COMMAND_HANDLER: { + + $command == $ONE_WIRE_COMMANDS->{READ_REPLY} + and do { #PIN,COMMAND,ADDRESS,DATA + + my @data = unpack_from_7bit(@$sysex_data); + my $device = shift_onewire_device_from_byte_array(\@data); + + return { + pin => $pin, + command => 'READ_REPLY', + device => $device, + data => \@data + }; + }; + + ($command == $ONE_WIRE_COMMANDS->{SEARCH_REPLY} or $command == $ONE_WIRE_COMMANDS->{SEARCH_ALARMS_REPLY}) + and do { #PIN,COMMAND,ADDRESS... + + my @devices; + my @data = unpack_from_7bit(@$sysex_data); + my $device = shift_onewire_device_from_byte_array(\@data); + while ( defined $device ) { + push @devices, $device; + $device = shift_onewire_device_from_byte_array(\@data); + } + return { + pin => $pin, + command => $command == $ONE_WIRE_COMMANDS->{SEARCH_REPLY} ? 'SEARCH_REPLY' : 'SEARCH_ALARMS_REPLY', + devices => \@devices, + }; + }; + } + } +} + +sub packet_create_task { + my ($self,$id,$len) = @_; + my $packet = $self->packet_sysex_command('SCHEDULER_REQUEST', $SCHEDULER_COMMANDS->{CREATE_FIRMATA_TASK}, $id, $len & 0x7F, $len>>7); + return $packet; +} + +sub packet_delete_task { + my ($self,$id) = @_; + return $self->packet_sysex_command('SCHEDULER_REQUEST', $SCHEDULER_COMMANDS->{DELETE_FIRMATA_TASK}, $id); +} + +sub packet_add_to_task { + my ($self,$id,@data) = @_; + my $packet = $self->packet_sysex_command('SCHEDULER_REQUEST', $SCHEDULER_COMMANDS->{ADD_TO_FIRMATA_TASK}, $id, pack_as_7bit(@data)); + return $packet; +} + +sub packet_delay_task { + my ($self,$time_ms) = @_; + my $packet = $self->packet_sysex_command('SCHEDULER_REQUEST', $SCHEDULER_COMMANDS->{DELAY_FIRMATA_TASK}, pack_as_7bit($time_ms & 0xFF, ($time_ms & 0xFF00)>>8, ($time_ms & 0xFF0000)>>16,($time_ms & 0xFF000000)>>24)); + return $packet; +} + +sub packet_schedule_task { + my ($self,$id,$time_ms) = @_; + my $packet = $self->packet_sysex_command('SCHEDULER_REQUEST', $SCHEDULER_COMMANDS->{SCHEDULE_FIRMATA_TASK}, $id, pack_as_7bit($time_ms & 0xFF, ($time_ms & 0xFF00)>>8, ($time_ms & 0xFF0000)>>16,($time_ms & 0xFF000000)>>24)); + return $packet; +} + +sub packet_query_all_tasks { + my $self = shift; + return $self->packet_sysex_command('SCHEDULER_REQUEST', $SCHEDULER_COMMANDS->{QUERY_ALL_FIRMATA_TASKS}); +} + +sub packet_query_task { + my ($self,$id) = @_; + return $self->packet_sysex_command('SCHEDULER_REQUEST', $SCHEDULER_COMMANDS->{QUERY_FIRMATA_TASK},$id); +} + +sub packet_reset_scheduler { + my $self = shift; + return $self->packet_sysex_command('SCHEDULER_REQUEST', $SCHEDULER_COMMANDS->{RESET_FIRMATA_TASKS}); +} + +sub handle_scheduler_reply { + my ( $self, $sysex_data ) = @_; + + my $command = shift @$sysex_data; + + if ( defined $command ) { + COMMAND_HANDLER: { + + $command == $SCHEDULER_COMMANDS->{QUERY_ALL_TASKS_REPLY} and do { + return { + command => 'QUERY_ALL_TASKS_REPLY', + ids => $sysex_data, + } + }; + + ($command == $SCHEDULER_COMMANDS->{QUERY_TASK_REPLY} or $command == $SCHEDULER_COMMANDS->{ERROR_TASK_REPLY}) and do { + + my $error = ($command == $SCHEDULER_COMMANDS->{ERROR_TASK_REPLY}); + if (scalar @$sysex_data == 1) { + return { + command => ($error ? 'ERROR_TASK_REPLY' : 'QUERY_TASK_REPLY'), + id => shift @$sysex_data, + } + } + if (scalar @$sysex_data >= 11) { + my $id = shift @$sysex_data; + my @data = unpack_from_7bit(@$sysex_data); + return { + command => ($error ? 'ERROR_TASK_REPLY' : 'QUERY_TASK_REPLY'), + id => $id, + time_ms => shift @data | (shift @data)<<8 | (shift @data)<<16 | (shift @data)<<24, + len => shift @data | (shift @data)<<8, + position => shift @data | (shift @data)<<8, + messages => \@data, + } + } + }; + } + } +} + + +sub shift14bit { + + my $data = shift; + + my $lsb = shift @$data; + my $msb = shift @$data; + return + defined $lsb + ? defined $msb + ? ( $msb << 7 ) + ( $lsb & 0x7f ) + : $lsb + : undef; +} + +sub double_7bit_to_string { + my ( $data, $numbytes ) = @_; + my $ret; + if ( defined $numbytes ) { + for ( my $i = 0 ; $i < $numbytes ; $i++ ) { + my $value = shift14bit($data); + $ret .= chr($value); + } + } + else { + while (@$data) { + my $value = shift14bit($data); + $ret .= chr($value); + } + } + return $ret; +} + +sub double_7bit_to_array { + my ( $data, $numbytes ) = @_; + my @ret; + if ( defined $numbytes ) { + for ( my $i = 0 ; $i < $numbytes ; $i++ ) { + push @ret, shift14bit($data); + } + } + else { + while (@$data) { + my $value = shift14bit($data); + push @ret, $value; + } + } + return @ret; +} + +sub shift_onewire_device_from_byte_array { + my $buffer = shift; + + my $family = shift @$buffer; + if ( defined $family ) { + my @address; + for (my $i=0;$i<6;$i++) { + push @address,shift @$buffer; + } + my $crc = shift @$buffer; + return { + family => $family, + identity => \@address, + crc => $crc + }; + } + else { + return undef; + } + +} + +sub push_value_as_two_7bit { + my ( $value, $buffer ) = @_; + push @$buffer, $value & 0x7f; #LSB + push @$buffer, ( $value >> 7 ) & 0x7f; #MSB +} + +sub push_onewire_device_to_byte_array { + my ( $device, $buffer ) = @_; + push @$buffer, $device->{family}; + for ( my $i = 0 ; $i < 6 ; $i++ ) { + push @$buffer, $device->{identity}[$i]; + } + push @$buffer, $device->{crc}; +} + +sub push_array_as_two_7bit { + my ( $data, $buffer ) = @_; + my $byte = shift @$data; + while ( defined $byte ) { + push_value_as_two_7bit( $byte, $buffer ); + $byte = shift @$data; + } +} + +sub pack_as_7bit { + my @data = @_; + my @outdata; + my $numBytes = @data; + my $messageSize = ( $numBytes << 3 ) / 7; + for ( my $i = 0 ; $i < $messageSize ; $i++ ) { + my $j = $i * 7; + my $pos = $j >> 3; + my $shift = $j & 7; + my $out = $data[$pos] >> $shift & 0x7F; + + if ($out >> 7 > 0) { + printf "%b, %b, %d\n",$data[$pos],$out,$shift; + } + + if ( $shift > 1 && $pos < $numBytes-1 ) { + $out |= ( $data[ $pos + 1 ] << ( 8 - $shift ) ) & 0x7F; + } + push( @outdata, $out ); + } + return @outdata; +} + +sub unpack_from_7bit { + my @data = @_; + my @outdata; + my $numBytes = @data; + my $outBytes = ( $numBytes * 7 ) >> 3; + for ( my $i = 0 ; $i < $outBytes ; $i++ ) { + my $j = $i << 3; + my $pos = $j / 7; + my $shift = $j % 7; + push( @outdata, + ( $data[$pos] >> $shift ) | + ( ( $data[ $pos + 1 ] << ( 7 - $shift ) ) & 0xFF ) ); + } + return @outdata; +} + +1; diff --git a/fhem/FHEM/lib/README.perl-firmata b/fhem/FHEM/lib/README.perl-firmata new file mode 100644 index 000000000..dd43dceca --- /dev/null +++ b/fhem/FHEM/lib/README.perl-firmata @@ -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. +