# -*- coding: utf-8 -*- use feature ":5.10"; use strict; state $basea58 = [split // , '123456789abcdefghijkmnopqrstuvwxyzABCDEFGHJKLMNPQRSTUVWXYZ']; state $i; state $base58 = {map {$_ => $i++} @$basea58}; state $stack; package brickd; use Math::Int64 qw(uint64 uint64_to_hex hex_to_uint64 uint64_to_string); use IO::Socket::INET; use IO::Select; use Time::HiRes qw( sleep ); use threads; use threads::shared; use Thread::Queue; sub new { my $class = shift @_; my $ref = {}; if( ref($class) ) { if( $_[0]->isa('brick') ) { my ($class_name,$brick_uid,$para) = @_; $ref = $class_name->new($class,$brick_uid,$para); } else { die " $_[0] ist kein brick\n"; } } else { $ref = bless $ref,$class; ($ref->{Host},$ref->{Port}) = @_; $ref->{Stack} = 0; $ref->{IPCon} = IO::Socket::INET->new("$ref->{Host}:$ref->{Port}") || die "no connect to $ref->{Host}:$ref->{Port}\n"; $ref->{IPCon}->autoflush(1); $ref->{Queue} = Thread::Queue->new(); $ref->{Bricks} = undef; my %p :shared; $ref->{pending} = \%p; my %c :shared; $ref->{callback} = \%c; $ref->{Write} = threads->create(sub { print threads->tid()." startet\n"; while(1) { my ($stack,$buff,$func) = @{$ref->{Queue}->dequeue()}; $ref->{IPCon}->syswrite($buff) if $buff; threads->yield(); } }); $ref->{Read} = threads->create(sub { print threads->tid()." startet\n"; my $sel = IO::Select->new(); $sel->add($ref->{IPCon}); while(1) { my @read = $sel->can_read($^O =~ /Win/i ? 0.001 : ()); if( $read[0] ) { my ($stack_id,$func_id,$p_len,$buff) = $ref->next_packet; if( exists $ref->{pending}->{$stack_id} ) { $ref->{pending}->{$stack_id}->enqueue([$stack_id,$func_id,$p_len,$buff]); delete $ref->{pending}->{$stack_id}; } elsif ( exists $ref->{callback}->{"$stack_id $func_id"} ) { $ref->{callback}->{"$stack_id $func_id"}->enqueue([$stack_id,$func_id,$p_len,$buff]); } } threads->yield(); } }); $ref->{Write}->detach(); $ref->{Read}->detach(); } return $ref; } sub next_packet { my $class = shift @_; my ($stack_id,$func_id,$p_len,$buff); $class->{IPCon}->sysread($buff,4); ($stack_id,$func_id,$p_len ) = unpack("CCS",$buff); undef $buff; $class->{IPCon}->sysread($buff,$p_len - 4) if $p_len > 4; return ($stack_id,$func_id,$p_len,$buff); } package brick; use Math::Int64 qw(uint64 uint64_to_hex hex_to_uint64 uint64_to_string); use Time::HiRes qw( sleep ); use threads; use threads::shared; use Thread::Queue; my $typ = { uint8 => { len => 1, mask => 'C', }, bool => { len => 1, mask => 'C', }, uint16 => { len => 2, mask => 'S', }, int16 => { len => 2, mask => 's', }, uint64 => { len => 8, mask => 'H16', pack => \&uid_to_syswrite, unpack => \&uid_from_sysread }, uint32 => { len => 4, mask => 'L', }, int32 => { len => 4, mask => 'l', }, 'char' => { len => 1, mask => 'A', }, 'char[40]' => { len => 40, mask => 'A40', }, 'char[60]' => { len => 60, mask => 'A60', }, 'char[20]' => { len => 20, mask => 'A20', }, 'string[20]' => { len => 20, mask => 'A20', }, 'string[16]' => { len => 16, mask => 'A20', }, 'char[16]' => { len => 16, mask => 'A16', }, }; sub syswrite { my $class = shift @_; my( $buff, $func ) = @_; if( exists $func->{resp} ) { $class->{brickd}->{pending}->{$class->{Stack}} = $class->{Queue}; } $class->{brickd}->{Queue}->enqueue([$class->{Stack},$buff,$func->{id}]); } sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_stack_id => { id => 255, para => [qw/uint64/], resp => [qw/uint64 uint8 uint8 uint8 char[40] uint8/]}, enumerate => { id => 254,}, CALLBACK_ENUMERATE => { id => 253, resp => [qw/uint64 char[40] uint8 bool/]}, }; if( exists $f_list->{$funktion} ) { return $f_list->{$funktion}; } else { return; } } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 253 => 'CALLBACK_ENUMERATE', }; if( exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return ; } } sub new { my $class = shift; my ($v1,$v2,$v3,$brick_uid,$class_name,$ref,$para ) ; if( ref($class) ) { if( $_[0]->isa('brick') ) { ($class_name,$brick_uid,$para) = @_; $ref = {}; $ref = bless $ref,$class_name; $ref->{Stack} = 0; $ref->{Host} = $class->{Host}; $ref->{Port} = $class->{Port}; $ref->{brickd} = $class->{brickd}; } else { die " $_[0] ist kein brick\n"; } } elsif (ref($_[0]) eq 'brickd') { $ref = {}; $ref = bless $ref,$class; $ref->{Stack} = 0; ($ref->{brickd}, $brick_uid,$para) = @_; $ref->{Host} = $ref->{brickd}->{IPCon}->peerhost; $ref->{Port} = $ref->{brickd}->{IPCon}->peerport; } else { $ref = {}; $ref = bless $ref,$class; $ref->{Stack} = 0; ($ref->{Host},$ref->{Port}, $brick_uid,$para) = @_; $ref->{brickd} = brickd->new($ref->{Host},$ref->{Port}) || die "no connect to $ref->{Host}:$ref->{Port}\n"; } $ref->{Queue} = Thread::Queue->new(); if( $brick_uid ) { ($ref->{UID},$v1,$v2,$v3,$ref->{Name},$ref->{Stack}) = $ref->get_stack_id($brick_uid); die "kann ".ref($ref)." mit $brick_uid nicht finden\n" if !$ref->{Stack}; $ref->{Version} = "$v1.$v2.$v3"; if( $ref->{UID} ne $brick_uid ) { die "konnte ".ref($ref)." mit ID $brick_uid nicht finden\n"; } push @{$stack->{$ref->{brickd}}->{$ref->{Stack}}}, $ref; } if( ref($para) eq 'HASH' ) { for my $func ( keys %$para ) { if( $ref->meta( $func ) ) { $ref->$func( ref($para->{$func}) eq 'ARRAY' ? @{$para->{$func}} : $para->{$func}); } else { $ref->{$func} = $para->{$func}; } } } elsif( ref($para) eq 'ARRAY' ) { while ( @$para ) { my $func = shift @$para; my $p = shift @$para; if( $ref->meta( $func ) ) { $ref->$func( ref($p) eq 'ARRAY' ? @{$p} : $p); } else { $ref->{$func} = $p; } } } if( $ref->{debug} ) { warn "$ref->{Name}\t$ref->{Version}\t$ref->{Stack}\n"; } return $ref; } sub decode58 { my @val = split // , shift; my $ret = uint64(0); my $base = uint64(1); for my $c ( reverse @val ) { $ret += $base58->{$c} * $base; $base *= 58; } return $ret; } sub encode58 { my $val = shift; my $ret =''; while ( $val ) { my $rest = $val; $rest = $rest / 58 ; $ret = $basea58->[$val % 58].$ret; $val = $rest; } return $ret; } sub uid_to_syswrite { return join "" , reverse split /(..)/, uint64_to_hex(decode58( shift )); } sub uid_from_sysread { return encode58(hex_to_uint64(join( '', reverse( split (/(..)/ , shift ))))); } sub DESTROY { my $class = shift; if( $class->{IPCon} ) { delete $stack->{$class->{IPCon}}->{$class->{Stack}} if $class->{Stack}; if(!( keys %{$stack->{$class->{IPCon}}} )) { delete $stack->{$class->{IPCon}}; $class->{IPCon}->close if $class->{IPCon}; } } } sub AUTOLOAD { my $class = shift; my $name = $brick::AUTOLOAD; my ( $len,$buff,$func,$pack_mask, @pack, $unpack_mask, @unpack,$stack_id,$func_id,$p_len,@ret ) ; $name =~ s/.*://; # strip fully-qualified portion $func = $class->meta($name); if( $func ) { if( $class->callback($func->{id}) ) { my $ret = $class->{callback}->{$func->{id}}; $class->{callback}->{$func->{id}} = shift @_; return $ret; } $pack_mask = "CCS"; $len = 4; if( exists $func->{para} ) { for my $para ( @{$func->{para}} ) { if( exists $typ->{$para}->{pack} ) { push @pack, $typ->{$para}->{pack}(shift @_); } else { push @pack, shift @_; } $len += $typ->{$para}->{len}; $pack_mask .= $typ->{$para}->{mask}; } } unshift @pack, $len; unshift @pack, $func->{id}; unshift @pack, $class->{Stack}; $buff = pack($pack_mask,@pack); $class->syswrite($buff,$func); threads->yield(); if( exists $func->{resp}){ ($stack_id,$func_id,$p_len,$buff ) = @{$class->{Queue}->dequeue()}; return if !$func_id; for my $para ( @{$func->{resp}} ) { $unpack_mask .= $typ->{$para}->{mask}; $len += $typ->{$para}->{len}; } if( $len != $p_len-4 ) { warn " $name erwartet $len hat aber $p_len\n" if exists $class->{debug}; } @unpack = unpack $unpack_mask, $buff; for my $para ( @{$func->{resp}} ) { if( exists $typ->{$para}->{unpack} ) { push @ret, $typ->{$para}->{unpack}(shift @unpack); } else { push @ret, shift @unpack; } } return wantarray ? @ret : shift @ret; } } else { warn "unbekannte Funtion $name von $class->{Name}\n" if exists $class->{debug}; } } sub wait { my $class = shift @_; my $timeout = shift @_; my (%stack,$ret); my $queue = Thread::Queue->new(); for my $br ( $class, @_ ) { next if !$class->isa('brick'); $stack{$br->{Stack}} = $br; for my $c ( keys %{$br->{callback}} ) { $br->{brickd}->{callback}->{"$br->{Stack} $c"} = $queue; } } MAIN_LOOP: while(1){ my ($stack_id,$func_id,$p_len,$buff ) = @{$queue->dequeue()}; next if !$func_id; my $func = $stack{$stack_id}->callback($func_id); if( $func and exists $stack{$stack_id}->{callback}->{$func_id}) { my (@unpack,$len,$unpack_mask); if( $stack{$stack_id}->meta($func)->{resp} ) { for my $para ( @{$stack{$stack_id}->meta($func)->{resp}} ) { $unpack_mask .= $typ->{$para}->{mask}; $len += $typ->{$para}->{len}; } if( $len != $p_len-4 ) { warn " $func erwartet $len hat aber ".($p_len-4)."\n" if $stack{$stack_id}->{wait}; } @unpack = unpack $unpack_mask, $buff if $unpack_mask; } $ret = $stack{$stack_id}->{callback}->{$func_id}(@unpack); } else { if ( $stack{$stack_id}->{debug} ) { my (@unpack,$len,$unpack_mask); for my $para ( @{$stack{$stack_id}->meta($func)->{resp}} ) { $unpack_mask .= $typ->{$para}->{mask}; $len += $typ->{$para}->{len}; } @unpack = unpack $unpack_mask, $buff if $unpack_mask; warn "no callback $func_id for stack $stack_id (@unpack)\n" if $class->{wait}; } redo MAIN_LOOP; } last if $timeout != -1; } return $ret; } package dc; @dc::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { set_velocity => { id => 1, para => [qw/ int16/], }, get_velocity => { id => 2, resp => [qw/ int16/], }, get_current_velocity => { id => 3, resp => [qw/ int16/], }, set_acceleration => { id => 4, para => [qw/ uint16/], }, get_acceleration => { id => 5, resp => [qw/ uint16/], }, set_pwm_frequency => { id => 6, para => [qw/ uint16/], }, get_pwm_frequency => { id => 7, resp => [qw/ uint16/], }, full_brake => { id => 8, }, get_stack_input_voltage => { id => 9, resp => [qw/ uint16/], }, get_external_input_voltage => { id => 10, resp => [qw/ uint16/], }, get_current_consumption => { id => 11, resp => [qw/ uint16/], }, enable => { id => 12, }, disable => { id => 13, }, is_enabled => { id => 14, resp => [qw/ bool/], }, set_minimum_voltage => { id => 15, para => [qw/ uint16/], }, get_minimum_voltage => { id => 16, resp => [qw/ uint16/], }, set_drive_mode => { id => 17, para => [qw/ uint8/], }, get_drive_mode => { id => 18, resp => [qw/ uint8/], }, set_current_velocity_period => { id => 19, para => [qw/ uint16/], }, get_current_velocity_period => { id => 20, resp => [qw/ uint16/], }, CALLBACK_UNDER_VOLTAGE => { id => 21, resp => [qw/ uint16/], }, CALLBACK_EMERGENCY_SHUTDOWN => { id => 22, }, CALLBACK_VELOCITY_REACHED => { id => 23, resp => [qw/ int16/], }, CALLBACK_CURRENT_VELOCITY => { id => 24, resp => [qw/ int16/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 21 => 'CALLBACK_UNDER_VOLTAGE', 22 => 'CALLBACK_EMERGENCY_SHUTDOWN', 23 => 'CALLBACK_VELOCITY_REACHED', 24 => 'CALLBACK_CURRENT_VELOCITY', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package imu; @imu::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_acceleration => { id => 1, resp => [qw/ int16 int16 int16/], }, get_magnetic_field => { id => 2, resp => [qw/ int16 int16 int16/], }, get_angular_velocity => { id => 3, resp => [qw/ int16 int16 int16/], }, get_all_data => { id => 4, resp => [qw/ int16 int16 int16 int16 int16 int16 int16 int16 int16 int16/], }, get_orientation => { id => 5, resp => [qw/ int16 int16 int16/], }, get_quaternion => { id => 6, resp => [qw/ float float float float/], }, get_imu_temperature => { id => 7, resp => [qw/ int16/], }, leds_on => { id => 8, }, leds_off => { id => 9, }, are_leds_on => { id => 10, resp => [qw/ bool/], }, set_acceleration_range => { id => 11, para => [qw/ uint8/], }, get_acceleration_range => { id => 12, resp => [qw/ uint8/], }, set_magnetometer_range => { id => 13, para => [qw/ uint8/], }, get_magnetometer_range => { id => 14, resp => [qw/ uint8/], }, set_convergence_speed => { id => 15, para => [qw/ uint16/], }, get_convergence_speed => { id => 16, resp => [qw/ uint16/], }, set_calibration => { id => 17, para => [qw/ uint8 int16[10]/], }, get_calibration => { id => 18, para => [qw/ uint8/], resp => [qw/ int16[10]/], }, set_acceleration_period => { id => 19, para => [qw/ uint32/], }, get_acceleration_period => { id => 20, resp => [qw/ uint32/], }, set_magnetic_field_period => { id => 21, para => [qw/ uint32/], }, get_magnetic_field_period => { id => 22, resp => [qw/ uint32/], }, set_angular_velocity_period => { id => 23, para => [qw/ uint32/], }, get_angular_velocity_period => { id => 24, resp => [qw/ uint32/], }, set_all_data_period => { id => 25, para => [qw/ uint32/], }, get_all_data_period => { id => 26, resp => [qw/ uint32/], }, set_orientation_period => { id => 27, para => [qw/ uint32/], }, get_orientation_period => { id => 28, resp => [qw/ uint32/], }, set_quaternion_period => { id => 29, para => [qw/ uint32/], }, get_quaternion_period => { id => 30, resp => [qw/ uint32/], }, CALLBACK_ACCELERATION => { id => 31, resp => [qw/ int16 int16 int16/], }, CALLBACK_MAGNETIC_FIELD => { id => 32, resp => [qw/ int16 int16 int16/], }, CALLBACK_ANGULAR_VELOCITY => { id => 33, resp => [qw/ int16 int16 int16/], }, CALLBACK_ALL_DATA => { id => 34, resp => [qw/ int16 int16 int16 int16 int16 int16 int16 int16 int16 int16/], }, CALLBACK_ORIENTATION => { id => 35, resp => [qw/ int16 int16 int16/], }, CALLBACK_QUATERNION => { id => 36, resp => [qw/ float float float float/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 31 => 'CALLBACK_ACCELERATION', 32 => 'CALLBACK_MAGNETIC_FIELD', 33 => 'CALLBACK_ANGULAR_VELOCITY', 34 => 'CALLBACK_ALL_DATA', 35 => 'CALLBACK_ORIENTATION', 36 => 'CALLBACK_QUATERNION', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package master; @master::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_stack_voltage => { id => 1, resp => [qw/ uint16/], }, get_stack_current => { id => 2, resp => [qw/ uint16/], }, set_extension_type => { id => 3, para => [qw/ uint8 uint32/], }, get_extension_type => { id => 4, para => [qw/ uint8/], resp => [qw/ uint32/], }, is_chibi_present => { id => 5, resp => [qw/ bool/], }, set_chibi_address => { id => 6, para => [qw/ uint8/], }, get_chibi_address => { id => 7, resp => [qw/ uint8/], }, set_chibi_master_address => { id => 8, para => [qw/ uint8/], }, get_chibi_master_address => { id => 9, resp => [qw/ uint8/], }, set_chibi_slave_address => { id => 10, para => [qw/ uint8 uint8/], }, get_chibi_slave_address => { id => 11, para => [qw/ uint8/], resp => [qw/ uint8/], }, get_chibi_signal_strength => { id => 12, resp => [qw/ uint8/], }, get_chibi_error_log => { id => 13, resp => [qw/ uint16 uint16 uint16 uint16/], }, set_chibi_frequency => { id => 14, para => [qw/ uint8/], }, get_chibi_frequency => { id => 15, resp => [qw/ uint8/], }, set_chibi_channel => { id => 16, para => [qw/ uint8/], }, get_chibi_channel => { id => 17, resp => [qw/ uint8/], }, is_rs485_present => { id => 18, resp => [qw/ bool/], }, set_rs485_address => { id => 19, para => [qw/ uint8/], }, get_rs485_address => { id => 20, resp => [qw/ uint8/], }, set_rs485_slave_address => { id => 21, para => [qw/ uint8 uint8/], }, get_rs485_slave_address => { id => 22, para => [qw/ uint8/], resp => [qw/ uint8/], }, get_rs485_error_log => { id => 23, resp => [qw/ uint16/], }, set_rs485_configuration => { id => 24, para => [qw/ uint32 char uint8/], }, get_rs485_configuration => { id => 25, resp => [qw/ uint32 char uint8/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } package servo; @servo::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { enable => { id => 1, para => [qw/ uint8/], }, disable => { id => 2, para => [qw/ uint8/], }, is_enabled => { id => 3, para => [qw/ uint8/], resp => [qw/ bool/], }, set_position => { id => 4, para => [qw/ uint8 int16/], }, get_position => { id => 5, para => [qw/ uint8/], resp => [qw/ int16/], }, get_current_position => { id => 6, para => [qw/ uint8/], resp => [qw/ int16/], }, set_velocity => { id => 7, para => [qw/ uint8 uint16/], }, get_velocity => { id => 8, para => [qw/ uint8/], resp => [qw/ uint16/], }, get_current_velocity => { id => 9, para => [qw/ uint8/], resp => [qw/ uint16/], }, set_acceleration => { id => 10, para => [qw/ uint8 uint16/], }, get_acceleration => { id => 11, para => [qw/ uint8/], resp => [qw/ uint16/], }, set_output_voltage => { id => 12, para => [qw/ uint16/], }, get_output_voltage => { id => 13, resp => [qw/ uint16/], }, set_pulse_width => { id => 14, para => [qw/ uint8 uint16 uint16/], }, get_pulse_width => { id => 15, para => [qw/ uint8/], resp => [qw/ uint16 uint16/], }, set_degree => { id => 16, para => [qw/ uint8 int16 int16/], }, get_degree => { id => 17, para => [qw/ uint8/], resp => [qw/ int16 int16/], }, set_period => { id => 18, para => [qw/ uint8 uint16/], }, get_period => { id => 19, para => [qw/ uint8/], resp => [qw/ uint16/], }, get_servo_current => { id => 20, para => [qw/ uint8/], resp => [qw/ uint16/], }, get_overall_current => { id => 21, resp => [qw/ uint16/], }, get_stack_input_voltage => { id => 22, resp => [qw/ uint16/], }, get_external_input_voltage => { id => 23, resp => [qw/ uint16/], }, set_minimum_voltage => { id => 24, para => [qw/ uint16/], }, get_minimum_voltage => { id => 25, resp => [qw/ uint16/], }, CALLBACK_UNDER_VOLTAGE => { id => 26, resp => [qw/ uint16/], }, CALLBACK_POSITION_REACHED => { id => 27, resp => [qw/ uint8 int16/], }, CALLBACK_VELOCITY_REACHED => { id => 28, resp => [qw/ uint8 int16/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 26 => 'CALLBACK_UNDER_VOLTAGE', 27 => 'CALLBACK_POSITION_REACHED', 28 => 'CALLBACK_VELOCITY_REACHED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package stepper; @stepper::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { set_max_velocity => { id => 1, para => [qw/ uint16/], }, get_max_velocity => { id => 2, resp => [qw/ uint16/], }, get_current_velocity => { id => 3, resp => [qw/ uint16/], }, set_speed_ramping => { id => 4, para => [qw/ uint16 uint16/], }, get_speed_ramping => { id => 5, resp => [qw/ uint16 uint16/], }, full_brake => { id => 6, }, set_current_position => { id => 7, para => [qw/ int32/], }, get_current_position => { id => 8, resp => [qw/ int32/], }, set_target_position => { id => 9, para => [qw/ int32/], }, get_target_position => { id => 10, resp => [qw/ int32/], }, set_steps => { id => 11, para => [qw/ int32/], }, get_steps => { id => 12, resp => [qw/ int32/], }, get_remaining_steps => { id => 13, resp => [qw/ int32/], }, set_step_mode => { id => 14, para => [qw/ uint8/], }, get_step_mode => { id => 15, resp => [qw/ uint8/], }, drive_forward => { id => 16, }, drive_backward => { id => 17, }, stop => { id => 18, }, get_stack_input_voltage => { id => 19, resp => [qw/ uint16/], }, get_external_input_voltage => { id => 20, resp => [qw/ uint16/], }, get_current_consumption => { id => 21, resp => [qw/ uint16/], }, set_motor_current => { id => 22, para => [qw/ uint16/], }, get_motor_current => { id => 23, resp => [qw/ uint16/], }, enable => { id => 24, }, disable => { id => 25, }, is_enabled => { id => 26, resp => [qw/ bool/], }, set_decay => { id => 27, para => [qw/ uint16/], }, get_decay => { id => 28, resp => [qw/ uint16/], }, set_minimum_voltage => { id => 29, para => [qw/ uint16/], }, get_minimum_voltage => { id => 30, resp => [qw/ uint16/], }, CALLBACK_UNDER_VOLTAGE => { id => 31, resp => [qw/ uint16/], }, CALLBACK_POSITION_REACHED => { id => 32, resp => [qw/ int32/], }, set_sync_rect => { id => 33, para => [qw/ bool/], }, is_sync_rect => { id => 34, resp => [qw/ bool/], }, set_time_base => { id => 35, para => [qw/ uint32/], }, get_time_base => { id => 36, resp => [qw/ uint32/], }, get_all_data => { id => 37, resp => [qw/ uint16 int32 int32 uint16 uint16 uint16/], }, set_all_data_period => { id => 38, para => [qw/ uint32/], }, get_all_data_period => { id => 39, resp => [qw/ uint32/], }, CALLBACK_ALL_DATA => { id => 40, resp => [qw/ uint16 int32 int32 uint16 uint16 uint16/], }, CALLBACK_NEW_STATE => { id => 41, resp => [qw/ uint8 uint8/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 31 => 'CALLBACK_UNDER_VOLTAGE', 32 => 'CALLBACK_POSITION_REACHED', 40 => 'CALLBACK_ALL_DATA', 41 => 'CALLBACK_NEW_STATE', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package ambient_light; @ambient_light::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_illuminance => { id => 1, resp => [qw/ uint16/], }, get_analog_value => { id => 2, resp => [qw/ uint16/], }, set_illuminance_callback_period => { id => 3, para => [qw/ uint32/], }, get_illuminance_callback_period => { id => 4, resp => [qw/ uint32/], }, set_analog_value_callback_period => { id => 5, para => [qw/ uint32/], }, get_analog_value_callback_period => { id => 6, resp => [qw/ uint32/], }, set_illuminance_callback_threshold => { id => 7, para => [qw/ char int16 int16/], }, get_illuminance_callback_threshold => { id => 8, resp => [qw/ char int16 int16/], }, set_analog_value_callback_threshold => { id => 9, para => [qw/ char uint16 uint16/], }, get_analog_value_callback_threshold => { id => 10, resp => [qw/ char uint16 uint16/], }, set_debounce_period => { id => 11, para => [qw/ uint32/], }, get_debounce_period => { id => 12, resp => [qw/ uint32/], }, CALLBACK_ILLUMINANCE => { id => 13, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE => { id => 14, resp => [qw/ uint16/], }, CALLBACK_ILLUMINANCE_REACHED => { id => 15, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE_REACHED => { id => 16, resp => [qw/ uint16/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 13 => 'CALLBACK_ILLUMINANCE', 14 => 'CALLBACK_ANALOG_VALUE', 15 => 'CALLBACK_ILLUMINANCE_REACHED', 16 => 'CALLBACK_ANALOG_VALUE_REACHED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package analog_in; @analog_in::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_voltage => { id => 1, resp => [qw/ uint16/], }, get_analog_value => { id => 2, resp => [qw/ uint16/], }, set_voltage_callback_period => { id => 3, para => [qw/ uint32/], }, get_voltage_callback_period => { id => 4, resp => [qw/ uint32/], }, set_analog_value_callback_period => { id => 5, para => [qw/ uint32/], }, get_analog_value_callback_period => { id => 6, resp => [qw/ uint32/], }, set_voltage_callback_threshold => { id => 7, para => [qw/ char int16 int16/], }, get_voltage_callback_threshold => { id => 8, resp => [qw/ char int16 int16/], }, set_analog_value_callback_threshold => { id => 9, para => [qw/ char uint16 uint16/], }, get_analog_value_callback_threshold => { id => 10, resp => [qw/ char uint16 uint16/], }, set_debounce_period => { id => 11, para => [qw/ uint32/], }, get_debounce_period => { id => 12, resp => [qw/ uint32/], }, CALLBACK_VOLTAGE => { id => 13, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE => { id => 14, resp => [qw/ uint16/], }, CALLBACK_VOLTAGE_REACHED => { id => 15, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE_REACHED => { id => 16, resp => [qw/ uint16/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 13 => 'CALLBACK_VOLTAGE', 14 => 'CALLBACK_ANALOG_VALUE', 15 => 'CALLBACK_VOLTAGE_REACHED', 16 => 'CALLBACK_ANALOG_VALUE_REACHED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package analog_out; @analog_out::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { set_voltage => { id => 1, para => [qw/ uint16/], }, get_voltage => { id => 2, resp => [qw/ uint16/], }, set_mode => { id => 3, para => [qw/ uint8/], }, get_mode => { id => 4, resp => [qw/ uint8/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } package current12; @current12::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_current => { id => 1, resp => [qw/ int16/], }, calibrate => { id => 2, }, is_over_current => { id => 3, resp => [qw/ bool/], }, get_analog_value => { id => 4, resp => [qw/ uint16/], }, set_current_callback_period => { id => 5, para => [qw/ uint32/], }, get_current_callback_period => { id => 6, resp => [qw/ uint32/], }, set_analog_value_callback_period => { id => 7, para => [qw/ uint32/], }, get_analog_value_callback_period => { id => 8, resp => [qw/ uint32/], }, set_current_callback_threshold => { id => 9, para => [qw/ char int16 int16/], }, get_current_callback_threshold => { id => 10, resp => [qw/ char int16 int16/], }, set_analog_value_callback_threshold => { id => 11, para => [qw/ char uint16 uint16/], }, get_analog_value_callback_threshold => { id => 12, resp => [qw/ char uint16 uint16/], }, set_debounce_period => { id => 13, para => [qw/ uint32/], }, get_debounce_period => { id => 14, resp => [qw/ uint32/], }, CALLBACK_CURRENT => { id => 15, resp => [qw/ int16/], }, CALLBACK_ANALOG_VALUE => { id => 16, resp => [qw/ uint16/], }, CALLBACK_CURRENT_REACHED => { id => 17, resp => [qw/ int16/], }, CALLBACK_ANALOG_VALUE_REACHED => { id => 18, resp => [qw/ uint16/], }, CALLBACK_OVER_CURRENT => { id => 19, }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 15 => 'CALLBACK_CURRENT', 16 => 'CALLBACK_ANALOG_VALUE', 17 => 'CALLBACK_CURRENT_REACHED', 18 => 'CALLBACK_ANALOG_VALUE_REACHED', 19 => 'CALLBACK_OVER_CURRENT', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package current25; @current25::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_current => { id => 1, resp => [qw/ int16/], }, calibrate => { id => 2, }, is_over_current => { id => 3, resp => [qw/ bool/], }, get_analog_value => { id => 4, resp => [qw/ uint16/], }, set_current_callback_period => { id => 5, para => [qw/ uint32/], }, get_current_callback_period => { id => 6, resp => [qw/ uint32/], }, set_analog_value_callback_period => { id => 7, para => [qw/ uint32/], }, get_analog_value_callback_period => { id => 8, resp => [qw/ uint32/], }, set_current_callback_threshold => { id => 9, para => [qw/ char int16 int16/], }, get_current_callback_threshold => { id => 10, resp => [qw/ char int16 int16/], }, set_analog_value_callback_threshold => { id => 11, para => [qw/ char uint16 uint16/], }, get_analog_value_callback_threshold => { id => 12, resp => [qw/ char uint16 uint16/], }, set_debounce_period => { id => 13, para => [qw/ uint32/], }, get_debounce_period => { id => 14, resp => [qw/ uint32/], }, CALLBACK_CURRENT => { id => 15, resp => [qw/ int16/], }, CALLBACK_ANALOG_VALUE => { id => 16, resp => [qw/ uint16/], }, CALLBACK_CURRENT_REACHED => { id => 17, resp => [qw/ int16/], }, CALLBACK_ANALOG_VALUE_REACHED => { id => 18, resp => [qw/ uint16/], }, CALLBACK_OVER_CURRENT => { id => 19, }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 15 => 'CALLBACK_CURRENT', 16 => 'CALLBACK_ANALOG_VALUE', 17 => 'CALLBACK_CURRENT_REACHED', 18 => 'CALLBACK_ANALOG_VALUE_REACHED', 19 => 'CALLBACK_OVER_CURRENT', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package distance_ir; @distance_ir::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_distance => { id => 1, resp => [qw/ uint16/], }, get_analog_value => { id => 2, resp => [qw/ uint16/], }, set_sampling_point => { id => 3, para => [qw/ uint8 uint16/], }, get_sampling_point => { id => 4, para => [qw/ uint8/], resp => [qw/ uint16/], }, set_distance_callback_period => { id => 5, para => [qw/ uint32/], }, get_distance_callback_period => { id => 6, resp => [qw/ uint32/], }, set_analog_value_callback_period => { id => 7, para => [qw/ uint32/], }, get_analog_value_callback_period => { id => 8, resp => [qw/ uint32/], }, set_distance_callback_threshold => { id => 9, para => [qw/ char int16 int16/], }, get_distance_callback_threshold => { id => 10, resp => [qw/ char int16 int16/], }, set_analog_value_callback_threshold => { id => 11, para => [qw/ char uint16 uint16/], }, get_analog_value_callback_threshold => { id => 12, resp => [qw/ char uint16 uint16/], }, set_debounce_period => { id => 13, para => [qw/ uint32/], }, get_debounce_period => { id => 14, resp => [qw/ uint32/], }, CALLBACK_DISTANCE => { id => 15, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE => { id => 16, resp => [qw/ uint16/], }, CALLBACK_DISTANCE_REACHED => { id => 17, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE_REACHED => { id => 18, resp => [qw/ uint16/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 15 => 'CALLBACK_DISTANCE', 16 => 'CALLBACK_ANALOG_VALUE', 17 => 'CALLBACK_DISTANCE_REACHED', 18 => 'CALLBACK_ANALOG_VALUE_REACHED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package dual_relay; @dual_relay::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { set_state => { id => 1, para => [qw/ bool bool/], }, get_state => { id => 2, resp => [qw/ bool bool/], }, set_monoflop => { id => 3, para => [qw/ uint8 bool uint32/], }, get_monoflop => { id => 4, para => [qw/ uint8/], resp => [qw/ bool uint32 uint32/], }, CALLBACK_MONOFLOP_DONE => { id => 5, resp => [qw/ uint8 bool/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 5 => 'CALLBACK_MONOFLOP_DONE', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package humidity; @humidity::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_humidity => { id => 1, resp => [qw/ uint16/], }, get_analog_value => { id => 2, resp => [qw/ uint16/], }, set_humidity_callback_period => { id => 3, para => [qw/ uint32/], }, get_humidity_callback_period => { id => 4, resp => [qw/ uint32/], }, set_analog_value_callback_period => { id => 5, para => [qw/ uint32/], }, get_analog_value_callback_period => { id => 6, resp => [qw/ uint32/], }, set_humidity_callback_threshold => { id => 7, para => [qw/ char int16 int16/], }, get_humidity_callback_threshold => { id => 8, resp => [qw/ char int16 int16/], }, set_analog_value_callback_threshold => { id => 9, para => [qw/ char uint16 uint16/], }, get_analog_value_callback_threshold => { id => 10, resp => [qw/ char uint16 uint16/], }, set_debounce_period => { id => 11, para => [qw/ uint32/], }, get_debounce_period => { id => 12, resp => [qw/ uint32/], }, CALLBACK_HUMIDITY => { id => 13, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE => { id => 14, resp => [qw/ uint16/], }, CALLBACK_HUMIDITY_REACHED => { id => 15, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE_REACHED => { id => 16, resp => [qw/ uint16/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 13 => 'CALLBACK_HUMIDITY', 14 => 'CALLBACK_ANALOG_VALUE', 15 => 'CALLBACK_HUMIDITY_REACHED', 16 => 'CALLBACK_ANALOG_VALUE_REACHED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package io16; @io16::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { set_port => { id => 1, para => [qw/ char uint8/], }, get_port => { id => 2, para => [qw/ char/], resp => [qw/ uint8/], }, set_port_configuration => { id => 3, para => [qw/ char uint8 char bool/], }, get_port_configuration => { id => 4, para => [qw/ char/], resp => [qw/ uint8 uint8/], }, set_debounce_period => { id => 5, para => [qw/ uint32/], }, get_debounce_period => { id => 6, resp => [qw/ uint32/], }, set_port_interrupt => { id => 7, para => [qw/ char uint8/], }, get_port_interrupt => { id => 8, para => [qw/ char/], resp => [qw/ uint8/], }, CALLBACK_INTERRUPT => { id => 9, resp => [qw/ char uint8 uint8/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 9 => 'CALLBACK_INTERRUPT', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package io4; @io4::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { set_value => { id => 1, para => [qw/ uint8/], }, get_value => { id => 2, resp => [qw/ uint8/], }, set_configuration => { id => 3, para => [qw/ uint8 char bool/], }, get_configuration => { id => 4, resp => [qw/ uint8 uint8/], }, set_debounce_period => { id => 5, para => [qw/ uint32/], }, get_debounce_period => { id => 6, resp => [qw/ uint32/], }, set_interrupt => { id => 7, para => [qw/ uint8/], }, get_interrupt => { id => 8, resp => [qw/ uint8/], }, CALLBACK_INTERRUPT => { id => 9, resp => [qw/ uint8 uint8/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 9 => 'CALLBACK_INTERRUPT', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package joystick; @joystick::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_position => { id => 1, resp => [qw/ int16 int16/], }, is_pressed => { id => 2, resp => [qw/ bool/], }, get_analog_value => { id => 3, resp => [qw/ uint16 uint16/], }, calibrate => { id => 4, }, set_position_callback_period => { id => 5, para => [qw/ uint32/], }, get_position_callback_period => { id => 6, resp => [qw/ uint32/], }, set_analog_value_callback_period => { id => 7, para => [qw/ uint32/], }, get_analog_value_callback_period => { id => 8, resp => [qw/ uint32/], }, set_position_callback_threshold => { id => 9, para => [qw/ char int16 int16 int16 int16/], }, get_position_callback_threshold => { id => 10, resp => [qw/ char int16 int16 int16 int16/], }, set_analog_value_callback_threshold => { id => 11, para => [qw/ char uint16 uint16 uint16 uint16/], }, get_analog_value_callback_threshold => { id => 12, resp => [qw/ char uint16 uint16 uint16 uint16/], }, set_debounce_period => { id => 13, para => [qw/ uint32/], }, get_debounce_period => { id => 14, resp => [qw/ uint32/], }, CALLBACK_POSITION => { id => 15, resp => [qw/ int16 int16/], }, CALLBACK_ANALOG_VALUE => { id => 16, resp => [qw/ uint16 uint16/], }, CALLBACK_POSITION_REACHED => { id => 17, resp => [qw/ int16 int16/], }, CALLBACK_ANALOG_VALUE_REACHED => { id => 18, resp => [qw/ uint16 uint16/], }, CALLBACK_PRESSED => { id => 19, }, CALLBACK_RELEASED => { id => 20, }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 15 => 'CALLBACK_POSITION', 16 => 'CALLBACK_ANALOG_VALUE', 17 => 'CALLBACK_POSITION_REACHED', 18 => 'CALLBACK_ANALOG_VALUE_REACHED', 19 => 'CALLBACK_PRESSED', 20 => 'CALLBACK_RELEASED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package lcd_16x2; @lcd_16x2::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { write_line => { id => 1, para => [qw/ uint8 uint8 string[16]/], }, clear_display => { id => 2, }, backlight_on => { id => 3, }, backlight_off => { id => 4, }, is_backlight_on => { id => 5, resp => [qw/ bool/], }, set_config => { id => 6, para => [qw/ bool bool/], }, get_config => { id => 7, resp => [qw/ bool bool/], }, is_button_pressed => { id => 8, para => [qw/ uint8/], resp => [qw/ bool/], }, CALLBACK_BUTTON_PRESSED => { id => 9, resp => [qw/ uint8/], }, CALLBACK_BUTTON_RELEASED => { id => 10, resp => [qw/ uint8/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 9 => 'CALLBACK_BUTTON_PRESSED', 10 => 'CALLBACK_BUTTON_RELEASED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package lcd_20x4; @lcd_20x4::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { write_line => { id => 1, para => [qw/ uint8 uint8 string[20]/], }, clear_display => { id => 2, }, backlight_on => { id => 3, }, backlight_off => { id => 4, }, is_backlight_on => { id => 5, resp => [qw/ bool/], }, set_config => { id => 6, para => [qw/ bool bool/], }, get_config => { id => 7, resp => [qw/ bool bool/], }, is_button_pressed => { id => 8, para => [qw/ uint8/], resp => [qw/ bool/], }, CALLBACK_BUTTON_PRESSED => { id => 9, resp => [qw/ uint8/], }, CALLBACK_BUTTON_RELEASED => { id => 10, resp => [qw/ uint8/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 9 => 'CALLBACK_BUTTON_PRESSED', 10 => 'CALLBACK_BUTTON_RELEASED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package linear_poti; @linear_poti::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_position => { id => 1, resp => [qw/ uint16/], }, get_analog_value => { id => 2, resp => [qw/ uint16/], }, set_position_callback_period => { id => 3, para => [qw/ uint32/], }, get_position_callback_period => { id => 4, resp => [qw/ uint32/], }, set_analog_value_callback_period => { id => 5, para => [qw/ uint32/], }, get_analog_value_callback_period => { id => 6, resp => [qw/ uint32/], }, set_position_callback_threshold => { id => 7, para => [qw/ char int16 int16/], }, get_position_callback_threshold => { id => 8, resp => [qw/ char int16 int16/], }, set_analog_value_callback_threshold => { id => 9, para => [qw/ char uint16 uint16/], }, get_analog_value_callback_threshold => { id => 10, resp => [qw/ char uint16 uint16/], }, set_debounce_period => { id => 11, para => [qw/ uint32/], }, get_debounce_period => { id => 12, resp => [qw/ uint32/], }, CALLBACK_POSITION => { id => 13, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE => { id => 14, resp => [qw/ uint16/], }, CALLBACK_POSITION_REACHED => { id => 15, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE_REACHED => { id => 16, resp => [qw/ uint16/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 13 => 'CALLBACK_POSITION', 14 => 'CALLBACK_ANALOG_VALUE', 15 => 'CALLBACK_POSITION_REACHED', 16 => 'CALLBACK_ANALOG_VALUE_REACHED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package piezo_buzzer; @piezo_buzzer::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { beep => { id => 1, para => [qw/ uint32/], }, morse_code => { id => 2, para => [qw/ string[60]/], }, CALLBACK_BEEP_FINISHED => { id => 3, }, CALLBACK_MORSE_CODE_FINISHED => { id => 4, }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 3 => 'CALLBACK_BEEP_FINISHED', 4 => 'CALLBACK_MORSE_CODE_FINISHED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package rotary_poti; @rotary_poti::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_position => { id => 1, resp => [qw/ int16/], }, get_analog_value => { id => 2, resp => [qw/ uint16/], }, set_position_callback_period => { id => 3, para => [qw/ uint32/], }, get_position_callback_period => { id => 4, resp => [qw/ uint32/], }, set_analog_value_callback_period => { id => 5, para => [qw/ uint32/], }, get_analog_value_callback_period => { id => 6, resp => [qw/ uint32/], }, set_position_callback_threshold => { id => 7, para => [qw/ char int16 int16/], }, get_position_callback_threshold => { id => 8, resp => [qw/ char int16 int16/], }, set_analog_value_callback_threshold => { id => 9, para => [qw/ char uint16 uint16/], }, get_analog_value_callback_threshold => { id => 10, resp => [qw/ char uint16 uint16/], }, set_debounce_period => { id => 11, para => [qw/ uint32/], }, get_debounce_period => { id => 12, resp => [qw/ uint32/], }, CALLBACK_POSITION => { id => 13, resp => [qw/ int16/], }, CALLBACK_ANALOG_VALUE => { id => 14, resp => [qw/ uint16/], }, CALLBACK_POSITION_REACHED => { id => 15, resp => [qw/ int16/], }, CALLBACK_ANALOG_VALUE_REACHED => { id => 16, resp => [qw/ uint16/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 13 => 'CALLBACK_POSITION', 14 => 'CALLBACK_ANALOG_VALUE', 15 => 'CALLBACK_POSITION_REACHED', 16 => 'CALLBACK_ANALOG_VALUE_REACHED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package temperature; @temperature::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_temperature => { id => 1, resp => [qw/ int16/], }, set_temperature_callback_period => { id => 2, para => [qw/ uint32/], }, get_temperature_callback_period => { id => 3, resp => [qw/ uint32/], }, set_temperature_callback_threshold => { id => 4, para => [qw/ char int16 int16/], }, get_temperature_callback_threshold => { id => 5, resp => [qw/ char int16 int16/], }, set_debounce_period => { id => 6, para => [qw/ uint32/], }, get_debounce_period => { id => 7, resp => [qw/ uint32/], }, CALLBACK_TEMPERATURE => { id => 8, resp => [qw/ int16/], }, CALLBACK_TEMPERATURE_REACHED => { id => 9, resp => [qw/ int16/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 8 => 'CALLBACK_TEMPERATURE', 9 => 'CALLBACK_TEMPERATURE_REACHED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package temperature_ir; @temperature_ir::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_ambient_temperature => { id => 1, resp => [qw/ int16/], }, get_object_temperature => { id => 2, resp => [qw/ int16/], }, set_emissivity => { id => 3, para => [qw/ uint16/], }, get_emissivity => { id => 4, resp => [qw/ uint16/], }, set_ambient_temperature_callback_period => { id => 5, para => [qw/ uint32/], }, get_ambient_temperature_callback_period => { id => 6, resp => [qw/ uint32/], }, set_object_temperature_callback_period => { id => 7, para => [qw/ uint32/], }, get_object_temperature_callback_period => { id => 8, resp => [qw/ uint32/], }, set_ambient_temperature_callback_threshold => { id => 9, para => [qw/ char int16 int16/], }, get_ambient_temperature_callback_threshold => { id => 10, resp => [qw/ char int16 int16/], }, set_object_temperature_callback_threshold => { id => 11, para => [qw/ char int16 int16/], }, get_object_temperature_callback_threshold => { id => 12, resp => [qw/ char int16 int16/], }, set_debounce_period => { id => 13, para => [qw/ uint32/], }, get_debounce_period => { id => 14, resp => [qw/ uint32/], }, CALLBACK_AMBIENT_TEMPERATURE => { id => 15, resp => [qw/ int16/], }, CALLBACK_OBJECT_TEMPERATURE => { id => 16, resp => [qw/ int16/], }, CALLBACK_AMBIENT_TEMPERATURE_REACHED => { id => 17, resp => [qw/ int16/], }, CALLBACK_OBJECT_TEMPERATURE_REACHED => { id => 18, resp => [qw/ int16/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 15 => 'CALLBACK_AMBIENT_TEMPERATURE', 16 => 'CALLBACK_OBJECT_TEMPERATURE', 17 => 'CALLBACK_AMBIENT_TEMPERATURE_REACHED', 18 => 'CALLBACK_OBJECT_TEMPERATURE_REACHED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } package voltage; @voltage::ISA = qw/brick/; sub meta { my $class = shift; my ( $funktion ) = @_; my $f_list = { get_voltage => { id => 1, resp => [qw/ uint16/], }, get_analog_value => { id => 2, resp => [qw/ uint16/], }, set_voltage_callback_period => { id => 3, para => [qw/ uint32/], }, get_voltage_callback_period => { id => 4, resp => [qw/ uint32/], }, set_analog_value_callback_period => { id => 5, para => [qw/ uint32/], }, get_analog_value_callback_period => { id => 6, resp => [qw/ uint32/], }, set_voltage_callback_threshold => { id => 7, para => [qw/ char int16 int16/], }, get_voltage_callback_threshold => { id => 8, resp => [qw/ char int16 int16/], }, set_analog_value_callback_threshold => { id => 9, para => [qw/ char uint16 uint16/], }, get_analog_value_callback_threshold => { id => 10, resp => [qw/ char uint16 uint16/], }, set_debounce_period => { id => 11, para => [qw/ uint32/], }, get_debounce_period => { id => 12, resp => [qw/ uint32/], }, CALLBACK_VOLTAGE => { id => 13, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE => { id => 14, resp => [qw/ uint16/], }, CALLBACK_VOLTAGE_REACHED => { id => 15, resp => [qw/ uint16/], }, CALLBACK_ANALOG_VALUE_REACHED => { id => 16, resp => [qw/ uint16/], }, reset => { id => 243, }, get_chip_temperature => { id => 242, resp => [qw/ int16/],}, }; return return exists $f_list->{$funktion} ? $f_list->{$funktion} : $class->SUPER::meta(@_); } sub callback { my $class = shift; my ( $id ) = @_; my $cb_list = { 13 => 'CALLBACK_VOLTAGE', 14 => 'CALLBACK_ANALOG_VALUE', 15 => 'CALLBACK_VOLTAGE_REACHED', 16 => 'CALLBACK_ANALOG_VALUE_REACHED', }; if( $id and exists $cb_list->{$id}) { return $cb_list->{$id}; } else { return $class->SUPER::callback(@_); } } 1;