| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | ######################################################################################### | 
| 2 |  |  |  |  |  |  | # Package        HiPi::Interface::PCA9685 | 
| 3 |  |  |  |  |  |  | # Description  : Control NXP PCA9685 16-channel, 12-bit PWM Fm+ I2C-bus controller | 
| 4 |  |  |  |  |  |  | # Copyright    : Copyright (c) 2013-2017 Mark Dootson | 
| 5 |  |  |  |  |  |  | # License      : This is free software; you can redistribute it and/or modify it under | 
| 6 |  |  |  |  |  |  | #                the same terms as the Perl 5 programming language system itself. | 
| 7 |  |  |  |  |  |  | ######################################################################################### | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | package HiPi::Interface::PCA9685; | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | ######################################################################################### | 
| 12 |  |  |  |  |  |  |  | 
| 13 | 1 |  |  | 1 |  | 1002 | use strict; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 29 |  | 
| 14 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 27 |  | 
| 15 | 1 |  |  | 1 |  | 5 | use parent qw( HiPi::Interface ); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 7 |  | 
| 16 | 1 |  |  | 1 |  | 57 | use HiPi qw( :i2c :rpi :pca9685 ); | 
|  | 1 |  |  |  |  | 11 |  | 
|  | 1 |  |  |  |  | 350 |  | 
| 17 | 1 |  |  | 1 |  | 9 | use Carp; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 136 |  | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | __PACKAGE__->create_ro_accessors( qw( | 
| 20 |  |  |  |  |  |  | devicename clock frequency _servo_position _servo_types | 
| 21 |  |  |  |  |  |  | external_clock internal_clock debug allcall | 
| 22 |  |  |  |  |  |  | backend | 
| 23 |  |  |  |  |  |  | ) ); | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | our $VERSION ='0.81'; | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | use constant { | 
| 28 | 1 |  |  |  |  | 2396 | MODE1      => 0x00, | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | RESTART    => 0x80, | 
| 31 |  |  |  |  |  |  | EXTCLK     => 0x40, | 
| 32 |  |  |  |  |  |  | AI         => 0x20, | 
| 33 |  |  |  |  |  |  | SLEEP      => 0x10, | 
| 34 |  |  |  |  |  |  | SUB1       => 0x08, | 
| 35 |  |  |  |  |  |  | SUB2       => 0x04, | 
| 36 |  |  |  |  |  |  | SUB3       => 0x02, | 
| 37 |  |  |  |  |  |  | ALLCALL    => 0x01, | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | MODE2      => 0x01, | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | INVRT      => 0x10, | 
| 42 |  |  |  |  |  |  | OCH        => 0x08, | 
| 43 |  |  |  |  |  |  | OUTDRV     => 0x04, | 
| 44 |  |  |  |  |  |  | OUTNE_HIMP => 0x02, | 
| 45 |  |  |  |  |  |  | OUTNE_ODRAIN_HIMP  => 0x01, | 
| 46 |  |  |  |  |  |  | OUTNE_TOPOLE_ON    => 0x01, | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | SUBADR1     => 0x02, | 
| 49 |  |  |  |  |  |  | SUBADR2     => 0x03, | 
| 50 |  |  |  |  |  |  | SUBADR3     => 0x04, | 
| 51 |  |  |  |  |  |  | ALLCALLADR  => 0x05, | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | CHAN_BASE   => 0x06, | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | ALL_CHAN    => 0xFA, | 
| 56 |  |  |  |  |  |  | PRE_SCALE   => 0xFE, | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | INTERNAL_CLOCK_MHZ => 25, | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | CLEAR_REG   => 0x00, | 
| 61 | 1 |  |  | 1 |  | 15 | }; | 
|  | 1 |  |  |  |  | 3 |  | 
| 62 |  |  |  |  |  |  |  | 
| 63 |  |  |  |  |  |  | sub new { | 
| 64 | 0 |  |  | 0 | 0 |  | my ($class, %userparams) = @_; | 
| 65 |  |  |  |  |  |  |  | 
| 66 | 0 |  |  |  |  |  | my $pi = HiPi::RaspberryPi->new(); | 
| 67 |  |  |  |  |  |  |  | 
| 68 | 0 | 0 |  |  |  |  | my %params = ( | 
| 69 |  |  |  |  |  |  | devicename      => ( $pi->board_type == RPI_BOARD_TYPE_1 ) ? '/dev/i2c-0' : '/dev/i2c-1', | 
| 70 |  |  |  |  |  |  | address         => 0x40, | 
| 71 |  |  |  |  |  |  | device          => undef, | 
| 72 |  |  |  |  |  |  | backend         => 'smbus', | 
| 73 |  |  |  |  |  |  | frequency       => 50, | 
| 74 |  |  |  |  |  |  | external_clock  => 0, | 
| 75 |  |  |  |  |  |  | internal_clock  => INTERNAL_CLOCK_MHZ, | 
| 76 |  |  |  |  |  |  | allcall         => 0, | 
| 77 |  |  |  |  |  |  | ); | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | # get user params | 
| 80 | 0 |  |  |  |  |  | foreach my $key( keys (%userparams) ) { | 
| 81 | 0 |  |  |  |  |  | $params{$key} = $userparams{$key}; | 
| 82 |  |  |  |  |  |  | } | 
| 83 |  |  |  |  |  |  |  | 
| 84 | 0 | 0 |  |  |  |  | if( $params{clock} ) { | 
| 85 | 0 |  |  |  |  |  | print q(you cannot set the clock param directly. If your board uses an external clock then pass its MHz frequency in the constructor: | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | my $pwm = HiPi::Interface::PCA9685->new( external_clock => 16 ); | 
| 88 |  |  |  |  |  |  |  | 
| 89 |  |  |  |  |  |  | ); | 
| 90 | 0 |  |  |  |  |  | exit(1); | 
| 91 |  |  |  |  |  |  | } | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | # set internal params | 
| 94 | 0 |  |  |  |  |  | $params{_servo_position} = []; | 
| 95 |  |  |  |  |  |  |  | 
| 96 | 0 |  |  |  |  |  | $params{_servo_types} = []; | 
| 97 |  |  |  |  |  |  |  | 
| 98 | 0 | 0 |  |  |  |  | if($params{external_clock}) { | 
| 99 | 0 |  |  |  |  |  | $params{clock} = $params{external_clock}; | 
| 100 |  |  |  |  |  |  | } else { | 
| 101 | 0 |  |  |  |  |  | $params{clock} = $params{internal_clock}; | 
| 102 |  |  |  |  |  |  | } | 
| 103 |  |  |  |  |  |  |  | 
| 104 | 0 | 0 |  |  |  |  | unless( defined($params{device}) ) { | 
| 105 | 0 | 0 |  |  |  |  | if ( $params{backend} eq 'bcm2835' ) { | 
| 106 | 0 |  |  |  |  |  | require HiPi::BCM2835::I2C; | 
| 107 |  |  |  |  |  |  | $params{device} = HiPi::BCM2835::I2C->new( | 
| 108 |  |  |  |  |  |  | address    => $params{address}, | 
| 109 | 0 | 0 |  |  |  |  | peripheral => ( $params{devicename} eq '/dev/i2c-0' ) ? HiPi::BCM2835::I2C::BB_I2C_PERI_0() : HiPi::BCM2835::I2C::BB_I2C_PERI_1(), | 
| 110 |  |  |  |  |  |  | ); | 
| 111 |  |  |  |  |  |  | } else { | 
| 112 | 0 |  |  |  |  |  | require HiPi::Device::I2C; | 
| 113 |  |  |  |  |  |  | $params{device} = HiPi::Device::I2C->new( | 
| 114 |  |  |  |  |  |  | devicename  => $params{devicename}, | 
| 115 |  |  |  |  |  |  | address     => $params{address}, | 
| 116 |  |  |  |  |  |  | busmode     => $params{backend}, | 
| 117 | 0 |  |  |  |  |  | ); | 
| 118 |  |  |  |  |  |  | } | 
| 119 |  |  |  |  |  |  | } | 
| 120 |  |  |  |  |  |  |  | 
| 121 | 0 |  |  |  |  |  | my $self = $class->SUPER::new(%params); | 
| 122 |  |  |  |  |  |  |  | 
| 123 | 0 |  |  |  |  |  | my $servotypes = [ | 
| 124 |  |  |  |  |  |  | # PCA_9685_SERVOTYPE_DEFAULT | 
| 125 |  |  |  |  |  |  | { | 
| 126 |  |  |  |  |  |  | pulse_min         => 1000, | 
| 127 |  |  |  |  |  |  | pulse_max         => 2000, | 
| 128 |  |  |  |  |  |  | degree_range      => 160, | 
| 129 |  |  |  |  |  |  | degree_min        => 10, | 
| 130 |  |  |  |  |  |  | degree_max        => 170, | 
| 131 |  |  |  |  |  |  | }, | 
| 132 |  |  |  |  |  |  | # PCA_9685_SERVOTYPE_DEFAULT | 
| 133 |  |  |  |  |  |  | { | 
| 134 |  |  |  |  |  |  | pulse_min         => 1000, | 
| 135 |  |  |  |  |  |  | pulse_max         => 2000, | 
| 136 |  |  |  |  |  |  | degree_range      => 160, | 
| 137 |  |  |  |  |  |  | degree_min        => 10, | 
| 138 |  |  |  |  |  |  | degree_max        => 170, | 
| 139 |  |  |  |  |  |  | }, | 
| 140 |  |  |  |  |  |  | # PCA_9685_SERVOTYPE_EXT_1 | 
| 141 |  |  |  |  |  |  | { | 
| 142 |  |  |  |  |  |  | pulse_min         => 600, | 
| 143 |  |  |  |  |  |  | pulse_max         => 2400, | 
| 144 |  |  |  |  |  |  | degree_range      => 160, | 
| 145 |  |  |  |  |  |  | degree_min        => 10, | 
| 146 |  |  |  |  |  |  | degree_max        => 170, | 
| 147 |  |  |  |  |  |  | }, | 
| 148 |  |  |  |  |  |  | # PCA_9685_SERVOTYPE_EXT_2 | 
| 149 |  |  |  |  |  |  | { | 
| 150 |  |  |  |  |  |  | pulse_min         => 800, | 
| 151 |  |  |  |  |  |  | pulse_max         => 2200, | 
| 152 |  |  |  |  |  |  | degree_range      => 160, | 
| 153 |  |  |  |  |  |  | degree_min        => 10, | 
| 154 |  |  |  |  |  |  | degree_max        => 170, | 
| 155 |  |  |  |  |  |  | }, | 
| 156 |  |  |  |  |  |  | # PCA_9685_SERVOTYPE_SG90 | 
| 157 |  |  |  |  |  |  | { | 
| 158 |  |  |  |  |  |  | pulse_min         => 550, | 
| 159 |  |  |  |  |  |  | pulse_max         => 2350, | 
| 160 |  |  |  |  |  |  | degree_range      => 150, | 
| 161 |  |  |  |  |  |  | degree_min        => 15, | 
| 162 |  |  |  |  |  |  | degree_max        => 165, | 
| 163 |  |  |  |  |  |  | }, | 
| 164 |  |  |  |  |  |  |  | 
| 165 |  |  |  |  |  |  | ]; | 
| 166 |  |  |  |  |  |  |  | 
| 167 | 0 |  |  |  |  |  | for my $stype( @$servotypes ) { | 
| 168 | 0 |  |  |  |  |  | $self->register_servotype(%$stype); | 
| 169 |  |  |  |  |  |  | } | 
| 170 |  |  |  |  |  |  |  | 
| 171 | 0 |  |  |  |  |  | $self->restart(); | 
| 172 |  |  |  |  |  |  |  | 
| 173 | 0 |  |  |  |  |  | return $self; | 
| 174 |  |  |  |  |  |  | } | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | sub restart { | 
| 177 | 0 |  |  | 0 | 0 |  | my($self) = @_; | 
| 178 |  |  |  |  |  |  |  | 
| 179 | 0 |  |  |  |  |  | my $prescale =  $self->calculate_prescale; | 
| 180 |  |  |  |  |  |  |  | 
| 181 | 0 | 0 |  |  |  |  | my $allcall = ( $self->allcall ) ? ALLCALL : 0; | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | # set sleep register | 
| 184 | 0 |  |  |  |  |  | $self->device->bus_write( MODE1, SLEEP ); | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | # set prescale | 
| 187 | 0 |  |  |  |  |  | $self->device->bus_write( PRE_SCALE, $prescale ); | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | # external clock ? | 
| 190 | 0 | 0 |  |  |  |  | if( $self->external_clock ) { | 
| 191 | 0 |  |  |  |  |  | $self->device->bus_write( MODE1, SLEEP | EXTCLK  ); | 
| 192 |  |  |  |  |  |  | } | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | # bring out of sleep | 
| 195 | 0 |  |  |  |  |  | $self->device->bus_write( MODE1, CLEAR_REG | $allcall ); | 
| 196 | 0 |  |  |  |  |  | $self->delay( 10 ); | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | # use autoincrement and restart | 
| 199 | 0 |  |  |  |  |  | $self->device->bus_write( MODE1, RESTART | AI | $allcall ); | 
| 200 |  |  |  |  |  |  | } | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | sub calculate_prescale { | 
| 203 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 204 | 0 |  |  |  |  |  | my $prescale =  int( 0.5 + ( $self->clock * 1000000.0 ) / ( 4096.0 * $self->frequency ) ) -1 ; | 
| 205 |  |  |  |  |  |  | # hardware defines a minimum value of 3 anyway so we can avoid returning a zero value | 
| 206 | 0 |  | 0 |  |  |  | $prescale ||= 3; | 
| 207 | 0 |  |  |  |  |  | return $prescale; | 
| 208 |  |  |  |  |  |  | } | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | sub set_servo_degrees { | 
| 211 | 0 |  |  | 0 | 0 |  | my($self, $channel, $servotype, $degrees, $delay ) = @_; | 
| 212 |  |  |  |  |  |  |  | 
| 213 | 0 |  |  |  |  |  | my $position; | 
| 214 |  |  |  |  |  |  |  | 
| 215 | 0 | 0 | 0 |  |  |  | if( $delay && $delay > 0 ) { | 
| 216 |  |  |  |  |  |  | # delay defined in microseconds | 
| 217 |  |  |  |  |  |  |  | 
| 218 | 0 | 0 |  |  |  |  | if( defined( $self->_servo_position->[$channel] ) ) { | 
| 219 | 0 |  |  |  |  |  | $position = $self->_servo_position->[$channel]; | 
| 220 |  |  |  |  |  |  | } else { | 
| 221 |  |  |  |  |  |  | # read  it from device | 
| 222 | 0 |  |  |  |  |  | my ( $on, $duration ) = $self->read_channel( $channel ) ; | 
| 223 | 0 |  |  |  |  |  | $duration &= PCA_9685_SERVO_CHANNEL_MASK; | 
| 224 | 0 |  | 0 |  |  |  | $position = $duration || undef; | 
| 225 |  |  |  |  |  |  | } | 
| 226 |  |  |  |  |  |  | } | 
| 227 |  |  |  |  |  |  |  | 
| 228 |  |  |  |  |  |  | # return if nothing bo do | 
| 229 |  |  |  |  |  |  |  | 
| 230 | 0 |  |  |  |  |  | my $desired_postion = $self->servo_degrees_to_duration($servotype, $degrees); | 
| 231 |  |  |  |  |  |  |  | 
| 232 | 0 | 0 | 0 |  |  |  | return $position if defined($position) && $position == $desired_postion; | 
| 233 |  |  |  |  |  |  |  | 
| 234 | 0 | 0 | 0 |  |  |  | my $increment = ( defined($position) && $position > $desired_postion  ) ? -1 : 1; | 
| 235 |  |  |  |  |  |  |  | 
| 236 | 0 |  | 0 |  |  |  | $position //= $desired_postion - $increment; | 
| 237 |  |  |  |  |  |  |  | 
| 238 | 0 |  |  |  |  |  | while( $position != $desired_postion ) { | 
| 239 | 0 |  |  |  |  |  | $position += $increment; | 
| 240 | 0 |  |  |  |  |  | $self->write_channel( $channel, 0x00, $position & PCA_9685_SERVO_CHANNEL_MASK ); | 
| 241 | 0 | 0 |  |  |  |  | $self->delayMicroseconds( $delay ) if $delay; | 
| 242 |  |  |  |  |  |  | } | 
| 243 |  |  |  |  |  |  |  | 
| 244 | 0 |  |  |  |  |  | $self->_servo_position->[$channel] = $position; | 
| 245 |  |  |  |  |  |  |  | 
| 246 | 0 |  |  |  |  |  | return $position; | 
| 247 |  |  |  |  |  |  | } | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | sub get_servo_degrees { | 
| 250 | 0 |  |  | 0 | 0 |  | my( $self, $channel, $servotype ) = @_; | 
| 251 | 0 |  |  |  |  |  | my ( $on, $duration ) = $self->read_channel( $channel ) ; | 
| 252 | 0 |  |  |  |  |  | $duration &= PCA_9685_SERVO_CHANNEL_MASK; | 
| 253 | 0 |  |  |  |  |  | my $degrees = $self->servo_duration_to_degrees($servotype, $duration); | 
| 254 | 0 |  |  |  |  |  | return $degrees; | 
| 255 |  |  |  |  |  |  | } | 
| 256 |  |  |  |  |  |  |  | 
| 257 |  |  |  |  |  |  | sub set_servo_pulse { | 
| 258 | 0 |  |  | 0 | 0 |  | my( $self, $channel, $us ) = @_; | 
| 259 | 0 |  |  |  |  |  | my $duration = $self->microseconds_to_duration( $us ); | 
| 260 | 0 |  |  |  |  |  | $self->write_channel( $channel, 0x00, $duration & PCA_9685_SERVO_CHANNEL_MASK ); | 
| 261 | 0 |  |  |  |  |  | return $duration; | 
| 262 |  |  |  |  |  |  | } | 
| 263 |  |  |  |  |  |  |  | 
| 264 |  |  |  |  |  |  | sub get_servo_pulse { | 
| 265 | 0 |  |  | 0 | 0 |  | my( $self, $channel ) = @_; | 
| 266 | 0 |  |  |  |  |  | my ( $on, $duration ) = $self->read_channel( $channel ) ; | 
| 267 | 0 |  |  |  |  |  | $duration &= PCA_9685_SERVO_CHANNEL_MASK; | 
| 268 | 0 |  |  |  |  |  | my $us = $self->duration_to_microseconds($duration); | 
| 269 | 0 |  |  |  |  |  | return $us; | 
| 270 |  |  |  |  |  |  | } | 
| 271 |  |  |  |  |  |  |  | 
| 272 |  |  |  |  |  |  | sub sleep { | 
| 273 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 274 | 0 |  |  |  |  |  | $self->device->bus_write( MODE1, SLEEP ); | 
| 275 |  |  |  |  |  |  | } | 
| 276 |  |  |  |  |  |  |  | 
| 277 |  |  |  |  |  |  | sub read_channel { | 
| 278 | 0 |  |  | 0 | 0 |  | my( $self, $channel ) = @_; | 
| 279 |  |  |  |  |  |  |  | 
| 280 | 0 |  | 0 |  |  |  | $channel //= 0; | 
| 281 |  |  |  |  |  |  |  | 
| 282 | 0 |  |  |  |  |  | my ( $on_lsb, $on_msb, $off_lsb, $off_msb )  = $self->device->bus_read( CHAN_BASE + ( 4 * $channel ) , 4 ); | 
| 283 |  |  |  |  |  |  |  | 
| 284 | 0 |  |  |  |  |  | my $on  = ( ( $on_msb & 0x1F ) << 8 ) + $on_lsb; | 
| 285 | 0 |  |  |  |  |  | my $off = ( ( $off_msb & 0x1F ) << 8 ) + $off_lsb; | 
| 286 |  |  |  |  |  |  |  | 
| 287 | 0 |  |  |  |  |  | return ( $on, $off ); | 
| 288 |  |  |  |  |  |  | } | 
| 289 |  |  |  |  |  |  |  | 
| 290 |  |  |  |  |  |  | sub write_channel { | 
| 291 | 0 |  |  | 0 | 0 |  | my( $self, $channel, $on, $off ) = @_; | 
| 292 |  |  |  |  |  |  |  | 
| 293 | 0 |  | 0 |  |  |  | $on //= 0; | 
| 294 | 0 |  | 0 |  |  |  | $off //= 0; | 
| 295 |  |  |  |  |  |  |  | 
| 296 | 0 |  |  |  |  |  | my $on_lsb = $on & 0xFF; | 
| 297 | 0 |  |  |  |  |  | my $on_msb = ( $on & 0x1F00 ) >> 8; | 
| 298 | 0 |  |  |  |  |  | my $off_lsb = $off & 0xFF; | 
| 299 | 0 |  |  |  |  |  | my $off_msb = ( $off & 0x1F00 ) >> 8; | 
| 300 |  |  |  |  |  |  |  | 
| 301 | 0 |  |  |  |  |  | $self->device->bus_write( CHAN_BASE + ( 4 * $channel ), $on_lsb, $on_msb, $off_lsb, $off_msb ); | 
| 302 |  |  |  |  |  |  | } | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  |  | 
| 305 |  |  |  |  |  |  | sub microseconds_to_duration { | 
| 306 | 0 |  |  | 0 | 0 |  | my( $self, $us ) = @_; | 
| 307 | 0 |  | 0 |  |  |  | $us ||= 100; | 
| 308 | 0 |  |  |  |  |  | my $period_us = 1000000.0 / $self->frequency; | 
| 309 | 0 |  |  |  |  |  | my $duration_percent = ( $us / $period_us ) * 100.0; | 
| 310 | 0 |  |  |  |  |  | my $duration = 4096.0 * ( $duration_percent / 100.0 ); | 
| 311 | 0 |  |  |  |  |  | $duration = int( 0.5 + $duration ) - 1; | 
| 312 | 0 | 0 |  |  |  |  | if( $self->debug ) { | 
| 313 | 0 |  |  |  |  |  | warn qq($us microseconds converted to duration $duration); | 
| 314 |  |  |  |  |  |  | } | 
| 315 | 0 |  |  |  |  |  | return $duration; | 
| 316 |  |  |  |  |  |  | } | 
| 317 |  |  |  |  |  |  |  | 
| 318 |  |  |  |  |  |  | sub duration_to_microseconds { | 
| 319 | 0 |  |  | 0 | 0 |  | my( $self, $duration ) = @_; | 
| 320 | 0 | 0 |  |  |  |  | return 0 unless $duration; | 
| 321 | 0 |  |  |  |  |  | $duration ++; | 
| 322 | 0 |  |  |  |  |  | my $duration_percent = ( $duration / 4096.0 ) * 100.0; | 
| 323 | 0 |  |  |  |  |  | my $period_us = 1000000.0 / $self->frequency; | 
| 324 | 0 |  |  |  |  |  | my $us = int( 0.5 + (( $period_us /100 ) * $duration_percent)); | 
| 325 | 0 | 0 |  |  |  |  | if( $self->debug ) { | 
| 326 | 0 |  |  |  |  |  | warn qq($us microseconds converted from duration $duration); | 
| 327 |  |  |  |  |  |  | } | 
| 328 | 0 |  |  |  |  |  | return $us; | 
| 329 |  |  |  |  |  |  | } | 
| 330 |  |  |  |  |  |  |  | 
| 331 |  |  |  |  |  |  | sub servo_degrees_to_pulse { | 
| 332 | 0 |  |  | 0 | 0 |  | my ( $self, $servotype, $degrees) = @_; | 
| 333 | 0 |  |  |  |  |  | my $svc = $self->servo_type_config( $servotype ); | 
| 334 | 0 |  | 0 |  |  |  | $degrees //= 90; | 
| 335 | 0 | 0 |  |  |  |  | $degrees = $svc->{limit_min} if $degrees < $svc->{limit_min}; | 
| 336 | 0 | 0 |  |  |  |  | $degrees = $svc->{limit_max} if $degrees > $svc->{limit_max}; | 
| 337 |  |  |  |  |  |  | my $us = $svc->{pulse_min} + | 
| 338 | 0 |  |  |  |  |  | int( 0.5 + ( ( $degrees - $svc->{degree_min} ) * $svc->{pw_per_degree} ) ); | 
| 339 |  |  |  |  |  |  |  | 
| 340 | 0 | 0 |  |  |  |  | if($self->debug) { | 
| 341 | 0 |  |  |  |  |  | warn qq($degrees degrees converted to pulse $us); | 
| 342 |  |  |  |  |  |  | } | 
| 343 | 0 |  |  |  |  |  | return $us; | 
| 344 |  |  |  |  |  |  | } | 
| 345 |  |  |  |  |  |  |  | 
| 346 |  |  |  |  |  |  | sub servo_pulse_to_degrees { | 
| 347 | 0 |  |  | 0 | 0 |  | my ( $self, $servotype, $us) = @_; | 
| 348 | 0 |  |  |  |  |  | my $svc = $self->servo_type_config( $servotype ); | 
| 349 | 0 |  | 0 |  |  |  | $us ||= $svc->{pulse_mid}; | 
| 350 | 0 | 0 |  |  |  |  | $us = $svc->{pulse_min} if $us < $svc->{pulse_min}; | 
| 351 | 0 | 0 |  |  |  |  | $us = $svc->{pulse_max} if $us > $svc->{pulse_max}; | 
| 352 | 0 | 0 |  |  |  |  | return 90 if $us == $svc->{pulse_mid}; | 
| 353 | 0 |  |  |  |  |  | my $degrees =  $svc->{degree_min} + int( 0.5 + ($us - $svc->{pulse_min}) / $svc->{pw_per_degree} ); | 
| 354 | 0 | 0 |  |  |  |  | if($self->debug) { | 
| 355 | 0 |  |  |  |  |  | warn qq($us pulse converted to degrees $degrees); | 
| 356 |  |  |  |  |  |  | } | 
| 357 | 0 |  |  |  |  |  | return $degrees; | 
| 358 |  |  |  |  |  |  | } | 
| 359 |  |  |  |  |  |  |  | 
| 360 |  |  |  |  |  |  | sub servo_degrees_to_duration { | 
| 361 | 0 |  |  | 0 | 0 |  | my($self, $servotype, $degrees ) = @_; | 
| 362 | 0 |  |  |  |  |  | my $us = $self->servo_degrees_to_pulse($servotype, $degrees); | 
| 363 | 0 |  |  |  |  |  | my $duration = $self->microseconds_to_duration($us); | 
| 364 | 0 | 0 |  |  |  |  | if($self->debug) { | 
| 365 | 0 |  |  |  |  |  | warn qq($degrees degrees converted to duration $duration); | 
| 366 |  |  |  |  |  |  | } | 
| 367 | 0 |  |  |  |  |  | return $duration; | 
| 368 |  |  |  |  |  |  | } | 
| 369 |  |  |  |  |  |  |  | 
| 370 |  |  |  |  |  |  | sub servo_duration_to_degrees { | 
| 371 | 0 |  |  | 0 | 0 |  | my($self, $servotype, $duration) = @_; | 
| 372 | 0 |  |  |  |  |  | my $us = $self->duration_to_microseconds($duration); | 
| 373 | 0 |  |  |  |  |  | my $degrees = $self->servo_pulse_to_degrees($servotype, $us); | 
| 374 | 0 | 0 |  |  |  |  | if($self->debug) { | 
| 375 | 0 |  |  |  |  |  | warn qq($duration duration converted to degrees $degrees); | 
| 376 |  |  |  |  |  |  | } | 
| 377 | 0 |  |  |  |  |  | return $degrees; | 
| 378 |  |  |  |  |  |  | } | 
| 379 |  |  |  |  |  |  |  | 
| 380 |  |  |  |  |  |  | sub servo_type_config { | 
| 381 | 0 |  |  | 0 | 0 |  | my ($self, $type) = @_; | 
| 382 |  |  |  |  |  |  |  | 
| 383 | 0 |  | 0 |  |  |  | $type //= PCA_9685_SERVOTYPE_DEFAULT; | 
| 384 |  |  |  |  |  |  |  | 
| 385 | 0 | 0 |  |  |  |  | if( exists($self->_servo_types->[$type] ) ) { | 
| 386 | 0 |  |  |  |  |  | return { %{ $self->_servo_types->[$type] } }; | 
|  | 0 |  |  |  |  |  |  | 
| 387 |  |  |  |  |  |  | } else { | 
| 388 | 0 |  |  |  |  |  | carp 'unknown servo type specified'; | 
| 389 | 0 |  |  |  |  |  | return { %{ $self->_servo_types->[PCA_9685_SERVOTYPE_DEFAULT] } }; | 
|  | 0 |  |  |  |  |  |  | 
| 390 |  |  |  |  |  |  | } | 
| 391 |  |  |  |  |  |  | } | 
| 392 |  |  |  |  |  |  |  | 
| 393 |  |  |  |  |  |  | sub register_servotype { | 
| 394 | 0 |  |  | 0 | 0 |  | my($self, %params) = @_; | 
| 395 | 0 |  |  |  |  |  | for my $param ( qw( pulse_min pulse_max degree_range ) ) { | 
| 396 | 0 | 0 |  |  |  |  | unless(exists($params{$param})) { | 
| 397 | 0 |  |  |  |  |  | carp(q(you must provide parameters pulse_min, pulse_max, and degree_range)); | 
| 398 | 0 |  |  |  |  |  | return undef; | 
| 399 |  |  |  |  |  |  | } | 
| 400 |  |  |  |  |  |  | } | 
| 401 | 0 | 0 |  |  |  |  | unless($params{pulse_max} > $params{pulse_min}) { | 
| 402 | 0 |  |  |  |  |  | carp(q(pulse_max must be greater than pulse_min)); | 
| 403 | 0 |  |  |  |  |  | return undef; | 
| 404 |  |  |  |  |  |  | } | 
| 405 |  |  |  |  |  |  |  | 
| 406 | 0 |  |  |  |  |  | my $index = scalar @{ $self->_servo_types }; | 
|  | 0 |  |  |  |  |  |  | 
| 407 | 0 |  |  |  |  |  | my $pulse_band = $params{pulse_max} - $params{pulse_min}; | 
| 408 | 0 |  |  |  |  |  | my $pw_per_degree = $pulse_band / $params{degree_range}; | 
| 409 | 0 |  |  |  |  |  | my $degree_min = int( 90.5 - ( $params{degree_range} / 2.0 )); | 
| 410 | 0 |  |  |  |  |  | my $degree_max = $degree_min + $params{degree_range}; | 
| 411 |  |  |  |  |  |  |  | 
| 412 |  |  |  |  |  |  | my $pulse_mid = $params{pulse_min} + | 
| 413 | 0 |  |  |  |  |  | int( 0.5 + ( ( 90.0 - $degree_min ) * $pw_per_degree ) ); | 
| 414 |  |  |  |  |  |  |  | 
| 415 | 0 |  |  |  |  |  | my $limit_max = $degree_max; | 
| 416 | 0 | 0 |  |  |  |  | if(exists($params{degree_max})) { | 
| 417 | 0 | 0 |  |  |  |  | $limit_max = $params{degree_max} if $limit_max > $params{degree_max}; | 
| 418 |  |  |  |  |  |  | } | 
| 419 | 0 |  |  |  |  |  | my $limit_min = $degree_min; | 
| 420 | 0 | 0 |  |  |  |  | if(exists($params{degree_min})) { | 
| 421 | 0 | 0 |  |  |  |  | $limit_min = $params{degree_min} if $limit_min < $params{degree_min}; | 
| 422 |  |  |  |  |  |  | } | 
| 423 |  |  |  |  |  |  |  | 
| 424 |  |  |  |  |  |  | $self->_servo_types->[$index] = { | 
| 425 |  |  |  |  |  |  | pulse_min => $params{pulse_min}, | 
| 426 |  |  |  |  |  |  | pulse_max => $params{pulse_max}, | 
| 427 |  |  |  |  |  |  | pulse_mid => $pulse_mid, | 
| 428 |  |  |  |  |  |  | degree_range => $params{degree_range}, | 
| 429 | 0 |  |  |  |  |  | degree_min => $degree_min, | 
| 430 |  |  |  |  |  |  | degree_max => $degree_max, | 
| 431 |  |  |  |  |  |  | pw_per_degree => $pw_per_degree, | 
| 432 |  |  |  |  |  |  | limit_min => $limit_min, | 
| 433 |  |  |  |  |  |  | limit_max => $limit_max, | 
| 434 |  |  |  |  |  |  | }; | 
| 435 | 0 |  |  |  |  |  | return $index; | 
| 436 |  |  |  |  |  |  | } | 
| 437 |  |  |  |  |  |  | 1; | 
| 438 |  |  |  |  |  |  |  | 
| 439 |  |  |  |  |  |  | __END__ |