File Coverage

blib/lib/Device/Chip/AD9833.pm
Criterion Covered Total %
statement 70 89 78.6
branch 5 16 31.2
condition n/a
subroutine 15 17 88.2
pod 7 8 87.5
total 97 130 74.6


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2020-2022 -- leonerd@leonerd.org.uk
5              
6 3     3   254315 use v5.26;
  3         34  
7 3     3   630 use Object::Pad 0.73 ':experimental(init_expr)';
  3         11248  
  3         15  
8              
9             package Device::Chip::AD9833 0.04;
10             class Device::Chip::AD9833
11 1     1   687 :isa(Device::Chip);
  1         18577  
  1         34  
12              
13 3     3   842 use Carp;
  3         7  
  3         216  
14 3     3   1467 use Data::Bitfield 0.02 qw( bitfield boolfield );
  3         6634  
  3         226  
15              
16 3     3   23 use Future::AsyncAwait 0.38; # aync method
  3         59  
  3         16  
17              
18 3     3   199 use constant PROTOCOL => "SPI";
  3         6  
  3         234  
19              
20             use constant {
21 3         5493 REG_CONFIG => 0x0000,
22             REG_FREQ0 => 0x4000,
23             REG_FREQ1 => 0x8000,
24             REG_PHASE0 => 0xC000,
25             REG_PHASE1 => 0xE000,
26 3     3   21 };
  3         5  
27              
28             =head1 NAME
29              
30             C - chip driver for F
31              
32             =head1 SYNOPSIS
33              
34             use Device::Chip::AD9833;
35             use Future::AsyncAwait;
36              
37             my $chip = Device::Chip::AD9833->new;
38             await $chip->mount( Device::Chip::Adapter::...->new );
39              
40             await $chip->init;
41              
42             my $freq = 440; # in Hz
43             await $chip->write_FREQ0( ( $freq << 28 ) / 25E6 ); # presuming 25MHz reference
44              
45             =head1 DESCRIPTION
46              
47             This L subclass provides specific communication to an
48             F F attached to a computer via an SPI adapter.
49              
50             The reader is presumed to be familiar with the general operation of this chip;
51             the documentation here will not attempt to explain or define chip-specific
52             concepts or features, only the use of this module to access them.
53              
54             =cut
55              
56             sub SPI_options
57             {
58 2     2 0 793 return ( mode => 2 );
59             }
60              
61             field $_config = 0;
62              
63 7         12 async method _write ( $word )
  7         9  
  7         15  
64 7         21 {
65 7         19 await $self->protocol->write( pack "S>", $word )
66 7     7   376 }
67              
68             =head1 METHODS
69              
70             The following methods documented in an C expression return L
71             instances.
72              
73             =cut
74              
75             =head2 init
76              
77             await $chip->init;
78              
79             Resets the chip to a working configuration, including setting the C bit
80             appropriately for the way this module writes the frequency registers.
81              
82             This method must be called before setting the frequency using L
83             or L.
84              
85             =cut
86              
87 1         2 async method init ()
  1         1  
88 1         8 {
89 1         5 await $self->_write( REG_CONFIG | 0x2100 ); # RESET, B28=1
90 1         9580 await $self->_write( REG_CONFIG | 0x2000 ); # unreset, B28=1
91 1     1 1 358 }
92              
93             bitfield { format => "integer" }, CONFIG =>
94             B28 => boolfield( 13 ),
95             HLB => boolfield( 12 ),
96             FSELECT => boolfield( 11 ),
97             PSELECT => boolfield( 10 ),
98             SLEEP1 => boolfield( 7 ),
99             SLEEP12 => boolfield( 6 ),
100             OPBITEN => boolfield( 5 ),
101             DIV2 => boolfield( 3 ),
102             MODE => boolfield( 1 );
103              
104             =head2 read_config
105              
106             $config = await $chip->read_config;
107              
108             Returns a C reference containing the current chip configuration. Note
109             that since the chip does not support querying the configuration, this is just
110             an in-memory copy maintained by the object instance, updated by calls to
111             L.
112              
113             The hash will contain the following named fields, all booleans.
114              
115             B28
116             HLB
117             FSELECT
118             PSELECT
119             SLEEP1
120             SLEEP12
121             OPBITEN
122             DIV2
123             MODE
124              
125             In addition, a new value C will be created combining the current
126             settings of C, C and C to explain the waveform generated
127              
128             wave => "sine" | "triangle" | "square" | "square/2"
129              
130             =cut
131              
132 1         2 async method read_config ()
  1         2  
133 1         6 {
134 1         6 my %config = unpack_CONFIG( $_config );
135              
136 1         146 my $wave;
137 1 50       5 if( $config{OPBITEN} ) {
    50          
138 0 0       0 $wave = $config{DIV2} ? "square" : "square/2";
139             }
140             elsif( $config{MODE} ) {
141 0         0 $wave = "triangle";
142             }
143             else {
144 1         2 $wave = "sine";
145             }
146 1         2 $config{wave} = $wave;
147              
148 1         14 return \%config;
149 1     1 1 236 }
150              
151             =head2 change_config
152              
153             await $chip->change_config( %changes );
154              
155             Writes updates to the chip configuration. Takes named arguments of the same
156             form as returned by L, including the synthesized C
157             setting.
158              
159             =cut
160              
161 2         3 async method change_config ( %changes )
  2         5  
  2         2  
162 2         7 {
163 2 100       7 if( defined( my $wave = delete $changes{wave} ) ) {{
164 1 50       2 $changes{OPBITEN} = 1, $changes{MODE} = 0, $changes{DIV2} = 1, last if $wave eq "square";
  1         4  
165 0 0       0 $changes{OPBITEN} = 1, $changes{MODE} = 0, $changes{DIV2} = 0, last if $wave eq "square/2";
166 0 0       0 $changes{OPBITEN} = 0, $changes{MODE} = 1, last if $wave eq "triangle";
167 0 0       0 $changes{OPBITEN} = 0, $changes{MODE} = 0, last if $wave eq "sine";
168 0         0 croak "Unrecognised value for 'wave' configuration - $wave";
169             }}
170              
171 2         17 my %config = ( unpack_CONFIG( $_config ), %changes );
172              
173 2         211 $config{B28} = 1;
174              
175 2         9 await $self->_write( REG_CONFIG | ( $_config = pack_CONFIG( %config ) ) );
176 2     2 1 15035 }
177              
178             =head2 write_FREQ0
179              
180             =head2 write_FREQ1
181              
182             await $chip->write_FREQ0( $freq );
183             await $chip->write_FREQ1( $freq );
184              
185             Writes the C or C frequency control register. C<$freq> should
186             be a 28bit integer value.
187              
188             =cut
189              
190 1         2 async method write_FREQ0 ( $freq )
  1         2  
  1         2  
191 1         4 {
192 1         4 await $self->_write( REG_FREQ0 | ( $freq & 0x3FFF ) );
193 1         1368 await $self->_write( REG_FREQ0 | ( $freq >> 14 ) );
194 1     1 1 5004 }
195              
196 0         0 async method write_FREQ1 ( $freq )
  0         0  
  0         0  
197 0         0 {
198 0         0 await $self->_write( REG_FREQ1 | ( $freq & 0x3FFF ) );
199 0         0 await $self->_write( REG_FREQ1 | ( $freq >> 14 ) );
200 0     0 1 0 }
201              
202             =head2 write_PHASE0
203              
204             =head2 write_PHASE1
205              
206             await $chip->write_PHASE0( $phase );
207             await $chip->write_PHASE1( $phase );
208              
209             Writes the C or C phase control register. C<$phase> should
210             be a 12bit integer value.
211              
212             =cut
213              
214 1         3 async method write_PHASE0 ( $phase )
  1         2  
  1         2  
215 1         3 {
216 1         4 await $self->_write( REG_PHASE0 | $phase );
217 1     1 1 4072 }
218              
219 0           async method write_PHASE1 ( $phase )
  0            
  0            
220 0           {
221 0           await $self->_write( REG_PHASE1 | $phase );
222 0     0 1   }
223              
224             =head1 AUTHOR
225              
226             Paul Evans
227              
228             =cut
229              
230             0x55AA;