############################################## package main; use strict; use warnings; use Device::Firmata::Constants qw/ :all /; use Device::Firmata::IO; use Device::Firmata::Protocol; use Device::Firmata::Platform; sub FRM_Set($@); sub FRM_Attr(@); sub Log($$); ##################################### sub FRM_Initialize($) { my ($hash) = @_; require "$main::attr{global}{modpath}/FHEM/DevIo.pm"; # Provider $hash->{Clients} = ":FRM_IN:FRM_OUT:FRM_AD:FRM_PWM:FRM_I2C:FRM_SERVO:OWX:"; $hash->{ReadyFn} = "FRM_Ready"; $hash->{ReadFn} = "FRM_Read"; # Consumer $hash->{DefFn} = "FRM_Define"; $hash->{UndefFn} = "FRM_Undef"; $hash->{GetFn} = "FRM_Get"; $hash->{SetFn} = "FRM_Set"; $hash->{AttrFn} = "FRM_Attr"; $hash->{AttrList} = "model:nano dummy:1,0 loglevel:0,1,2,3,4,5 sampling-interval i2c-config $main::readingFnAttributes"; } ##################################### sub FRM_Define($$) { my ( $hash, $def ) = @_; my @a = split( "[ \t][ \t]*", $def ); my $po; DevIo_CloseDev($hash); my $name = $a[0]; my $dev = $a[2]; if ( $dev eq "none" ) { Log 1, "FRM device is none, commands will be echoed only"; $main::attr{$name}{dummy} = 1; return undef; } $hash->{DeviceName} = $dev; my $ret = DevIo_OpenDev($hash, 0, "FRM_DoInit"); main::readingsSingleUpdate($hash,"state","Initialized", 1); return $ret; } ##################################### sub FRM_Undef($) { my $hash = @_; FRM_forall_clients($hash,\&FRM_Client_Unassign,undef); DevIo_CloseDev($hash); my $device = $hash->{FirmataDevice}; if (defined $device) { if (defined $device->{io}) { delete $hash->{FirmataDevice}->{io}->{handle} if defined $hash->{FirmataDevice}->{io}->{handle}; delete $hash->{FirmataDevice}->{io}; } delete $device->{protocol} if defined $device->{protocol}; delete $hash->{FirmataDevice}; } return undef; } ##################################### sub FRM_Set($@) { my ( $hash, @a ) = @_; my $u1 = "Usage: set reset/reinit\n"; return $u1 if ( int(@a) < 2 ); my $name = $hash->{DeviceName}; if ( $a[1] eq 'reset' ) { DevIo_CloseDev($hash); my $ret = DevIo_OpenDev($hash, 0, "FRM_DoInit"); return $ret; } elsif ( $a[1] eq 'reinit' ) { FRM_forall_clients($hash,\&FRM_Init_Client,undef); } else { return "Unknown argument $a[1], supported arguments are 'reset', 'reinit'"; } return undef; } ##################################### sub FRM_Get($@) { my ( $hash, @a ) = @_; return "\"get FRM\" needs only one parameter" if ( @a != 2 ); shift @a; my $spec = shift @a; if ( $spec eq "firmware" ) { if (defined $hash->{FirmataDevice}) { return $hash->{FirmataDevice}->{metadata}->{firmware}; } else { return "not connected to FirmataDevice"; } } elsif ( $spec eq "version" ) { if (defined $hash->{FirmataDevice}) { return $hash->{FirmataDevice}->{metadata}->{firmware_version}; } else { return "not connected to FirmataDevice"; } } } ##################################### # called from the global loop, when the select for hash->{FD} reports data sub FRM_Read($) { my ( $hash ) = @_; my $device = $hash->{FirmataDevice} or return; $device->poll(); } sub FRM_Ready($) { my ($hash) = @_; return DevIo_OpenDev($hash, 1, "FRM_DoInit") if($hash->{READINGS}{state} eq "disconnected"); } sub FRM_Attr(@) { my ($command,$name,$attribute,$value) = @_; if ($command eq "set") { $main::attr{$name}{$attribute}=$value; if ($attribute eq "sampling-interval" or $attribute eq "i2c-config" ) { FRM_apply_attribute($main::defs{$name},$attribute); } } } sub FRM_apply_attribute { my ($hash,$attribute) = @_; my $firmata = $hash->{FirmataDevice}; my $name = $hash->{NAME}; if (defined $firmata) { if ($attribute eq "sampling-interval") { $firmata->sampling_interval(main::AttrVal($name,$attribute,"1000")); } elsif ($attribute eq "i2c-config") { my $i2cattr = main::AttrVal($name,$attribute,undef); if (defined $i2cattr) { my @a = split(" ", $i2cattr); my $i2cpins = $firmata->{metadata}{i2c_pins}; if (defined $i2cpins and scalar @$i2cpins) { foreach my $i2cpin (@$i2cpins) { $firmata->pin_mode($i2cpin,PIN_I2C); } $firmata->i2c_config(@a); $firmata->observe_i2c(\&FRM_i2c_observer,$hash); } else { Log 1,"Error, arduino doesn't support I2C"; } } } } } sub FRM_DoInit($) { my ($hash) = @_; my $name = $hash->{NAME}; $hash->{loglevel} = main::GetLogLevel($name); my $firmata_io = Firmata_IO->new($hash); my $device = Device::Firmata::Platform->attach($firmata_io) or return 1; $hash->{FirmataDevice} = $device; $device->observe_string(\&FRM_string_observer,$hash); my $found; # we cannot call $device->probe() here, as it doesn't select bevore read, so it would likely cause IODev to close the connection on the first attempt to read from empty stream do { $device->system_reset(); $device->firmware_version_query(); for (my $i=0;$i<50;$i++) { if (FRM_poll($hash)) { if ($device->{metadata}{firmware} && $device->{metadata}{firmware_version}){ $device->{protocol}->{protocol_version} = $device->{metadata}{firmware_version}; $main::defs{$name}{firmware} = $device->{metadata}{firmware}; $main::defs{$name}{firmware_version} = $device->{metadata}{firmware_version}; $device->analog_mapping_query(); $device->capability_query(); for (my $j=0;$j<100;$j++) { if (FRM_poll($hash)) { if (($device->{metadata}{analog_mappings}) and ($device->{metadata}{capabilities})) { my $inputpins = $device->{metadata}{input_pins}; $main::defs{$name}{input_pins} = join(",", sort{$a<=>$b}(@$inputpins)); my $outputpins = $device->{metadata}{output_pins}; $main::defs{$name}{output_pins} = join(",", sort{$a<=>$b}(@$outputpins)); my $analogpins = $device->{metadata}{analog_pins}; $main::defs{$name}{analog_pins} = join(",", sort{$a<=>$b}(@$analogpins)); my $pwmpins = $device->{metadata}{pwm_pins}; $main::defs{$name}{pwm_pins} = join(",", sort{$a<=>$b}(@$pwmpins)); my $servopins = $device->{metadata}{servo_pins}; $main::defs{$name}{servo_pins} = join(",", sort{$a<=>$b}(@$servopins)); my $i2cpins = $device->{metadata}{i2c_pins}; $main::defs{$name}{i2c_pins} = join(",", sort{$a<=>$b}(@$i2cpins)); my $onewirepins = $device->{metadata}{onewire_pins}; $main::defs{$name}{onewire_pins} = join(",", sort{$a<=>$b}(@$onewirepins)); my @analog_resolutions; foreach my $pin (sort{$a<=>$b}(keys $device->{metadata}{analog_resolutions})) { push @analog_resolutions,$pin.":".$device->{metadata}{analog_resolutions}{$pin}; } $main::defs{$name}{analog_resolutions} = join(",",@analog_resolutions); my @pwm_resolutions; foreach my $pin (sort{$a<=>$b}(keys $device->{metadata}{pwm_resolutions})) { push @pwm_resolutions,$pin.":".$device->{metadata}{pwm_resolutions}{$pin}; } $main::defs{$name}{pwm_resolutions} = join(",",@pwm_resolutions); my @servo_resolutions; foreach my $pin (sort{$a<=>$b}(keys $device->{metadata}{servo_resolutions})) { push @servo_resolutions,$pin.":".$device->{metadata}{servo_resolutions}{$pin}; } $main::defs{$name}{servo_resolutions} = join(",",@servo_resolutions); $found = 1; last; } } else { select (undef,undef,undef,0.1); } } $found = 1; last; } } else { select (undef,undef,undef,0.1); } } } while (!$found); FRM_apply_attribute($hash,"sampling-interval"); FRM_apply_attribute($hash,"i2c-config"); FRM_forall_clients($hash,\&FRM_Init_Client,undef); return undef; } sub FRM_forall_clients($$$) { my ($hash,$fn,$args) = @_; foreach my $d ( sort keys %main::defs ) { if ( defined( $main::defs{$d} ) && defined( $main::defs{$d}{IODev} ) && $main::defs{$d}{IODev} == $hash ) { &$fn($main::defs{$d},$args); } } return undef; } sub FRM_Init_Client($$) { my ($hash,$args) = @_; $hash->{loglevel} = main::GetLogLevel($hash->{NAME}); main::CallFn($hash->{NAME},"InitFn",$hash,$args); } sub FRM_Init_Pin_Client($$$) { my ($hash,$args,$mode) = @_; my $u = "wrong syntax: define FRM_XXX pin"; return $u if(int(@$args) < 3); my $pin = @$args[2]; $hash->{PIN} = $pin; if (defined $hash->{IODev} and defined $hash->{IODev}->{FirmataDevice}) { $hash->{IODev}->{FirmataDevice}->pin_mode($pin,$mode); return 1; } return undef; } sub FRM_Client_Define($$) { my ($hash, $def) = @_; my @a = split("[ \t][ \t]*", $def); main::readingsSingleUpdate($hash,"state","defined",0); main::AssignIoPort($hash); FRM_Init_Client($hash,\@a); return undef; } sub FRM_Client_Undef($$) { my ($hash, $name) = @_; } sub FRM_Client_Unassign($) { my ($dev) = @_; delete $dev->{IODev} if defined $dev->{IODev}; main::readingsSingleUpdate($dev,"state","defined",0); } package Firmata_IO { sub new { my ($class,$hash) = @_; return bless { hash => $hash, }, $class; } sub data_write { my ( $self, $buf ) = @_; main::Log 5, ">".join(",",map{sprintf"%02x",ord$_}split//,$buf); main::DevIo_SimpleWrite($self->{hash},$buf,undef); } sub data_read { my ( $self, $bytes ) = @_; my $string = main::DevIo_SimpleRead($self->{hash}); if (defined $string ) { main::Log 5,"<".join(",",map{sprintf"%02x",ord$_}split//,$string); } return $string; } } sub FRM_i2c_observer { my ($data,$hash) = @_; main::Log 5,"onI2CMessage address: '".$data->{address}."', register: '".$data->{register}."' data: '".$data->{data}."'"; FRM_forall_clients($hash,\&FRM_i2c_update_device,$data); } sub FRM_i2c_update_device { my ($hash,$data) = @_; if (defined $hash->{"i2c-address"} && $hash->{"i2c-address"}==$data->{address}) { my $replydata = $data->{data}; my @values = split(" ",main::ReadingsVal($hash->{NAME},"values","")); splice(@values,$data->{register},@$replydata, @$replydata); main::readingsBeginUpdate($hash); main::readingsBulkUpdate($hash,"state","active",0); main::readingsBulkUpdate($hash,"values",join (" ",@values),1); main::readingsEndUpdate($hash,undef); } } sub FRM_string_observer { my ($string,$hash) = @_; main::Log 4, "received String_data: ".$string; main::readingsSingleUpdate($hash,"error",$string,1); } sub FRM_poll { my ($hash) = @_; my ($rout, $rin) = ('', ''); vec($rin, $hash->{FD}, 1) = 1; my $nfound = select($rout=$rin, undef, undef, 0.1); my $mfound = vec($rout, $hash->{FD}, 1); if($mfound) { $hash->{FirmataDevice}->poll(); } return $mfound; } ######### following is code to be called from OWX: ########## sub FRM_OWX_Init($$) { my ($hash,$args) = @_; if (FRM_Init_Pin_Client($hash,$args,PIN_ONEWIRE)) { $hash->{INTERFACE} = "firmata"; my $firmata = $hash->{IODev}->{FirmataDevice}; my $pin = $hash->{PIN}; $firmata->observe_onewire($pin,\&FRM_OWX_observer,$hash); $hash->{FRM_OWX_REPLIES} = {}; $hash->{DEVS} = []; if ( main::AttrVal($hash->{NAME},"buspower","") eq "parasitic" ) { $firmata->onewire_config($pin,1); } main::readingsSingleUpdate($hash,"state","Initialized",1); $firmata->onewire_search($pin); return undef; } return 1; } sub FRM_OWX_observer { my ( $data,$hash ) = @_; my $command = $data->{command}; COMMAND_HANDLER: { $command eq "READ_REPLY" and do { my $owx_device = FRM_OWX_firmata_to_device($data->{device}); my $owx_data = pack "C*",@{$data->{data}}; $hash->{FRM_OWX_REPLIES}->{$owx_device} = $owx_data; last; }; ($command eq "SEARCH_REPLY" or $command eq "SEARCH_ALARMS_REPLY") and do { my @owx_devices = (); foreach my $device (@{$data->{devices}}) { push @owx_devices, FRM_OWX_firmata_to_device($device); } if ($command eq "SEARCH_REPLY") { $hash->{DEVS} = \@owx_devices; $main::attr{$hash->{NAME}}{"ow-devices"} = join " ",@owx_devices; } else { $hash->{ALARMDEVS} = \@owx_devices; } last; }; } } ########### functions implementing interface to OWX ########## sub FRM_OWX_device_to_firmata { my @device; foreach my $hbyte (unpack "A2xA2A2A2A2A2A2xA2", shift) { push @device, hex $hbyte; } return { family => shift @device, crc => pop @device, identity => \@device, } } sub FRM_OWX_firmata_to_device { my $device = shift; return sprintf ("%02X.%02X%02X%02X%02X%02X%02X.%02X",$device->{family},@{$device->{identity}},$device->{crc}); } sub FRM_OWX_Verify { my ($hash,$dev) = @_; foreach my $found ($hash->{DEVS}) { if ($dev eq $found) { return 1; } } return 0; } sub FRM_OWX_Alarms { my ($hash) = @_; #-- get the interface my $frm = $hash->{IODev}; return 0 unless defined $frm; my $firmata = $frm->{FirmataDevice}; my $pin = $hash->{PIN}; return 0 unless ( defined $firmata and defined $pin ); $hash->{ALARMDEVS} = undef; $firmata->onewire_search_alarms($hash->{PIN}); my $times = AttrVal($hash,"ow-read-timeout",1000) / 50; #timeout in ms, defaults to 1 sec for (my $i=0;$i<$times;$i++) { if (FRM_poll($hash->{IODev})) { if (defined $hash->{ALARMDEVS}) { return 1; } } else { select (undef,undef,undef,0.05); } } $hash->{ALARMDEVS} = []; return 1; } sub FRM_OWX_Reset { my ($hash) = @_; #-- get the interface my $frm = $hash->{IODev}; return undef unless defined $frm; my $firmata = $frm->{FirmataDevice}; my $pin = $hash->{PIN}; return undef unless ( defined $firmata and defined $pin ); $firmata->onewire_reset($pin); return 1; } sub FRM_OWX_Complex ($$$$) { my ( $hash, $owx_dev, $data, $numread ) = @_; my $res = ""; #-- get the interface my $frm = $hash->{IODev}; return undef unless defined $frm; my $firmata = $frm->{FirmataDevice}; my $pin = $hash->{PIN}; return undef unless ( defined $firmata and defined $pin ); my $ow_command = {}; #-- has match ROM part if ($owx_dev) { $ow_command->{"select"} = FRM_OWX_device_to_firmata($owx_dev); #-- padding first 9 bytes into result string, since we have this # in the serial interfaces as well $res .= "000000000"; } #-- has data part if ($data) { my @data = unpack "C*", $data; $ow_command->{"write"} = \@data; $res.=$data; } #-- has receive part if ( $numread > 0 ) { $ow_command->{"read"} = $numread; #Firmata sends 0-address on read after skip $owx_dev = '00.000000000000.00' unless defined $owx_dev; $hash->{FRM_OWX_REPLIES}->{$owx_dev} = undef; } $firmata->onewire_command_series( $pin, $ow_command ); if ($numread) { my $times = main::AttrVal($hash,"ow-read-timeout",1000) / 50; #timeout in ms, defaults to 1 sec for (my $i=0;$i<$times;$i++) { if (FRM_poll($hash->{IODev})) { if (defined $hash->{FRM_OWX_REPLIES}->{$owx_dev}) { $res .= $hash->{FRM_OWX_REPLIES}->{$owx_dev}; return $res; } } else { select (undef,undef,undef,0.05); } } } return $res; } ######################################################################################## # # OWX_Discover_FRM - Discover devices on the 1-Wire bus via internal firmware # # Parameter hash = hash of bus master # # Return 0 : error # 1 : OK # ######################################################################################## sub FRM_OWX_Discover ($) { my ($hash) = @_; #-- get the interface my $frm = $hash->{IODev}; return 0 unless defined $frm; my $firmata = $frm->{FirmataDevice}; my $pin = $hash->{PIN}; return 0 unless ( defined $firmata and defined $pin ); my $old_devices = $hash->{DEVS}; $hash->{DEVS} = undef; $firmata->onewire_search($hash->{PIN}); my $times = AttrVal($hash,"ow-read-timeout",1000) / 50; #timeout in ms, defaults to 1 sec for (my $i=0;$i<$times;$i++) { if (FRM_poll($hash->{IODev})) { if (defined $hash->{DEVS}) { return 1; } } else { select (undef,undef,undef,0.05); } } $hash->{DEVS} = $old_devices; return 1; } 1; =pod =begin html

FRM


=end html =cut