| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | ######################################################################################### | 
| 2 |  |  |  |  |  |  | # Package        HiPi::Interface::MCP4DAC | 
| 3 |  |  |  |  |  |  | # Description  : Control MCP4xxx Digital 2 Analog ICs | 
| 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::MCP4DAC; | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | ######################################################################################### | 
| 12 |  |  |  |  |  |  |  | 
| 13 | 1 |  |  | 1 |  | 1034 | use strict; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 28 |  | 
| 14 | 1 |  |  | 1 |  | 18 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 26 |  | 
| 15 | 1 |  |  | 1 |  | 5 | use parent qw( HiPi::Interface ); | 
|  | 1 |  |  |  |  | 13 |  | 
|  | 1 |  |  |  |  | 5 |  | 
| 16 | 1 |  |  | 1 |  | 67 | use Carp; | 
|  | 1 |  |  |  |  | 4 |  | 
|  | 1 |  |  |  |  | 79 |  | 
| 17 | 1 |  |  | 1 |  | 7 | use HiPi qw( :spi :mcp4dac ); | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 215 |  | 
| 18 | 1 |  |  | 1 |  | 18 | use HiPi::Device::SPI; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 768 |  | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | our $VERSION ='0.81'; | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | __PACKAGE__->create_accessors( qw( bitsperword minvar ic devicename | 
| 23 |  |  |  |  |  |  | dualchannel canbuffer buffer gain | 
| 24 |  |  |  |  |  |  | writemask shiftvalue shiftbits ) ); | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | sub new { | 
| 27 | 0 |  |  | 0 | 0 |  | my( $class, %userparams ) = @_; | 
| 28 |  |  |  |  |  |  |  | 
| 29 | 0 |  |  |  |  |  | my %params = ( | 
| 30 |  |  |  |  |  |  | devicename   => '/dev/spidev0.0', | 
| 31 |  |  |  |  |  |  | speed        => SPI_SPEED_MHZ_1, | 
| 32 |  |  |  |  |  |  | bitsperword  => 8, | 
| 33 |  |  |  |  |  |  | delay        => 0, | 
| 34 |  |  |  |  |  |  | device       => undef, | 
| 35 |  |  |  |  |  |  | ic           => MCP4902, | 
| 36 |  |  |  |  |  |  | buffer       => 0, | 
| 37 |  |  |  |  |  |  | gain         => 0, | 
| 38 |  |  |  |  |  |  | shiftvalue   => 0, | 
| 39 |  |  |  |  |  |  | ); | 
| 40 |  |  |  |  |  |  |  | 
| 41 | 0 |  |  |  |  |  | foreach my $key (sort keys(%userparams)) { | 
| 42 | 0 |  |  |  |  |  | $params{$key} = $userparams{$key}; | 
| 43 |  |  |  |  |  |  | } | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | { | 
| 46 | 0 |  |  |  |  |  | my $ic = $params{ic}; | 
|  | 0 |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  |  | 
| 48 | 0 | 0 |  |  |  |  | if( $ic & MCP_DAC_RESOLUTION_12 ) { | 
|  |  | 0 |  |  |  |  |  | 
| 49 | 0 |  |  |  |  |  | $params{minvar} = 0; | 
| 50 | 0 |  |  |  |  |  | $params{shiftbits} = 0; | 
| 51 | 0 |  |  |  |  |  | $params{writemask} = 0b1111111111111111; | 
| 52 |  |  |  |  |  |  | } elsif( $ic & MCP_DAC_RESOLUTION_10 ) { | 
| 53 | 0 |  |  |  |  |  | $params{minvar} = 4; | 
| 54 | 0 |  |  |  |  |  | $params{shiftbits} = 2; | 
| 55 | 0 |  |  |  |  |  | $params{writemask} = 0b1111111111111100; | 
| 56 |  |  |  |  |  |  | } else { | 
| 57 | 0 |  |  |  |  |  | $params{minvar} = 16; | 
| 58 | 0 |  |  |  |  |  | $params{shiftbits} = 4; | 
| 59 | 0 |  |  |  |  |  | $params{writemask} = 0b1111111111110000; | 
| 60 |  |  |  |  |  |  | } | 
| 61 |  |  |  |  |  |  |  | 
| 62 | 0 | 0 |  |  |  |  | if( $ic & MCP_DAC_CAN_BUFFER ) { | 
| 63 | 0 |  |  |  |  |  | $params{canbuffer} = 1; | 
| 64 |  |  |  |  |  |  | } else { | 
| 65 | 0 |  |  |  |  |  | $params{canbuffer} = 0; | 
| 66 |  |  |  |  |  |  | } | 
| 67 |  |  |  |  |  |  |  | 
| 68 | 0 | 0 |  |  |  |  | if( $ic & MCP_DAC_DUAL_CHANNEL ) { | 
| 69 | 0 |  |  |  |  |  | $params{dualchannel} = 1; | 
| 70 |  |  |  |  |  |  | } else { | 
| 71 | 0 |  |  |  |  |  | $params{dualchannel} = 0; | 
| 72 |  |  |  |  |  |  | } | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | } | 
| 75 |  |  |  |  |  |  |  | 
| 76 | 0 | 0 |  |  |  |  | unless( defined($params{device}) ) { | 
| 77 |  |  |  |  |  |  | my $dev = HiPi::Device::SPI->new( | 
| 78 |  |  |  |  |  |  | speed        => $params{speed}, | 
| 79 |  |  |  |  |  |  | bitsperword  => $params{bitsperword}, | 
| 80 |  |  |  |  |  |  | delay        => $params{delay}, | 
| 81 |  |  |  |  |  |  | devicename   => $params{devicename}, | 
| 82 | 0 |  |  |  |  |  | ); | 
| 83 |  |  |  |  |  |  |  | 
| 84 | 0 |  |  |  |  |  | $params{device} = $dev; | 
| 85 |  |  |  |  |  |  | } | 
| 86 |  |  |  |  |  |  |  | 
| 87 | 0 |  |  |  |  |  | my $self = $class->SUPER::new(%params); | 
| 88 | 0 |  |  |  |  |  | return $self; | 
| 89 |  |  |  |  |  |  | } | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | sub write { | 
| 93 | 0 |  |  | 0 | 0 |  | my($self, $value, $channelb) = @_; | 
| 94 | 0 |  | 0 |  |  |  | $channelb ||= 0; | 
| 95 | 0 | 0 |  |  |  |  | $channelb = 0 if !$self->dualchannel; | 
| 96 |  |  |  |  |  |  |  | 
| 97 | 0 | 0 |  |  |  |  | my $output = ( $channelb ) ? MCP_DAC_CHANNEL_B : MCP_DAC_CHANNEL_A; | 
| 98 | 0 | 0 | 0 |  |  |  | $output += MCP_DAC_BUFFER if($self->canbuffer && $self->buffer); | 
| 99 | 0 | 0 |  |  |  |  | $output += ( $self->gain ) ? MCP_DAC_GAIN : MCP_DAC_NO_GAIN; | 
| 100 | 0 |  |  |  |  |  | $output += MCP_DAC_LIVE; | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | # allow user to specify values 1-255 for 8 bit device etc | 
| 103 |  |  |  |  |  |  |  | 
| 104 | 0 | 0 |  |  |  |  | if( $self->shiftvalue ) { | 
| 105 | 0 |  |  |  |  |  | $value <<= $self->shiftbits; | 
| 106 |  |  |  |  |  |  | } | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | # mask the $value. If user specifies shiftvalue == true | 
| 109 |  |  |  |  |  |  | # and gives a value over 255 for an 8 bit device | 
| 110 |  |  |  |  |  |  | # confusing things will happen. We only want | 
| 111 |  |  |  |  |  |  | # 12 bits. If user gets it wrong then at least | 
| 112 |  |  |  |  |  |  | # all that happens is they get wrong voltage - | 
| 113 |  |  |  |  |  |  | # instead of potentially writing to wrong channel | 
| 114 |  |  |  |  |  |  | # or shutting the channel down if we shift a high value | 
| 115 |  |  |  |  |  |  |  | 
| 116 | 0 |  |  |  |  |  | $value &= 0b111111111111; | 
| 117 |  |  |  |  |  |  |  | 
| 118 | 0 | 0 | 0 |  |  |  | $value = $self->minvar if( $value > 0 && $value < $self->minvar ); | 
| 119 | 0 | 0 |  |  |  |  | $value = 0 if $value < 0; | 
| 120 |  |  |  |  |  |  |  | 
| 121 | 0 |  |  |  |  |  | $output += $value; | 
| 122 | 0 |  |  |  |  |  | $output &= $self->writemask; | 
| 123 | 0 |  |  |  |  |  | $self->device->transfer( $self->_fmt_val( $output ) ); | 
| 124 |  |  |  |  |  |  | } | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | sub _fmt_val { | 
| 127 | 0 |  |  | 0 |  |  | my($self, $val) = @_; | 
| 128 | 0 |  |  |  |  |  | pack('n', $val); | 
| 129 |  |  |  |  |  |  | } | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | sub shutdown { | 
| 132 | 0 |  |  | 0 | 0 |  | my($self, $channelb) = @_; | 
| 133 | 0 |  | 0 |  |  |  | $channelb ||= 0; | 
| 134 | 0 | 0 |  |  |  |  | $channelb = 0 if !$self->dualchannel; | 
| 135 | 0 | 0 |  |  |  |  | my $output = ( $channelb ) ? MCP_DAC_CHANNEL_B : MCP_DAC_CHANNEL_A; | 
| 136 | 0 |  |  |  |  |  | $output += MCP_DAC_SHUTDOWN; | 
| 137 | 0 |  |  |  |  |  | $self->device->transfer( $self->_fmt_val( $output ) ); | 
| 138 |  |  |  |  |  |  | } | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | 1; | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | __END__ |