view release on metacpan or  search on metacpan

lib/HiPi/Interface/Si470N.pm  view on Meta::CPAN

    $rname //= 'UNKNOWN';
    if( exists($self->_register_names->{$rname}) ) {
        return $self->_register_names->{$rname};
    } else {
        carp qq(register name $rname is unknown);
        return undef;
    }
}

sub register_to_name {
    my( $self, $register ) = @_;
    $register //= -1;
    return 'UNKNOWN' if(( $register < 0 ) || ($register > 15));
    return $self->_register_name_order->[$register];
}

sub read_registers {
    my($self) = @_;
    
    my @bytes = $self->device->bus_read( undef, 32 );
    
    # change 32 bytes into 16 16 bit words
    my @words = ();
    for ( my $i = 0; $i < @bytes; $i += 2  ) {
        push @words, ( $bytes[$i] << 8 ) + $bytes[$i + 1];
    }
    
    # map to correct write order
    
    my @mappedwords = ();
    for ( my $i = 6; $i < 16; $i ++ ) {
        $mappedwords[$i - 6] = $words[$i];
    }
    for ( my $i = 0; $i < 6; $i ++ ) {
        $mappedwords[$i + 10] = $words[$i];
    }
    
    $self->_mapped_registers( \@mappedwords );
    
    return ( wantarray ) ? @{$self->_mapped_registers } : 1;
}

sub write_registers {
    my($self) = @_;
    my $regvals = $self->_mapped_registers;
    return unless( $regvals && ref( $regvals ) eq 'ARRAY');
    
    my @bytes = (); 
    
    # write words 2 to 7
    for ( my $i = 2; $i < 8; $i ++) {
        my $high = $regvals->[$i] >> 8;
        my $low  = $regvals->[$i] & 0xFF;
        push @bytes, ( $high, $low );
    }
    
    my $rval = $self->device->bus_write( @bytes );
    return $rval;
}

sub update_registers {
    my($self, $delay) = @_;
    $delay ||= 0.1;
    $self->write_registers();
    $self->sleep_seconds( $delay );
    $self->read_registers;
    return 1;
}

sub set_config_value {
    my( $self, $valuename, $newvalue ) = @_;
    $valuename //= 'UNKNOWN';
    $newvalue ||= 0;
    my $config = $self->_datamap->{$valuename};
    unless( $config ) {
        carp qq(unknownvalue $valuename);
        return undef;
    }
    my $register = $config->{word};
    my $wordname = $self->register_to_name( $register );
    my $currentword = $self->get_register($register);

    my( $bitsbefore, $bitsafter, $bitlen ) = @{ $config->{shiftbits} };
    
    my $mask = ( (2 ** $bitlen) -1 ) << $bitsafter;
    
    my $currentvalue = ($currentword & $mask) >> $bitsafter;
    
    return $currentvalue if $newvalue == $currentvalue;
    
    my $newbits = $newvalue << $bitsafter;
    my $newword = ($currentword & ~$mask) | ($newbits & $mask);
    
    $self->set_register($register, $newword);
    return $newvalue;
}

sub get_word_value {
    my($self, $wordname) = @_;
    my $register = $self->name_to_register( $wordname );
    my $word = $self->get_register($register);
    return $word;
}

sub get_config_value {
    my($self, $valuename) = @_;
    $valuename //= 'UNKNOWN';
    my $config = $self->_datamap->{$valuename};
    unless( $config ) {
        carp qq(unknownvalue $valuename);
        return undef;
    }
    my $currentword = $self->get_register($config->{word});
    my( $bitsbefore, $bitsafter, $bitlen ) = @{ $config->{shiftbits} };
    
    my $mask = ( (2 ** $bitlen) -1 ) << $bitsafter;
    my $currentvalue = ($currentword & $mask) >> $bitsafter;
    return $currentvalue;
}

sub configure_europe {