File Coverage

blib/lib/Device/BusPirate/Mode/BB.pm
Criterion Covered Total %
statement 115 129 89.1
branch 15 24 62.5
condition 5 6 83.3
subroutine 22 24 91.6
pod 8 12 66.6
total 165 195 84.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, 2014-2024 -- leonerd@leonerd.org.uk
5              
6 8     8   30144 use v5.26;
  8         40  
7 8     8   62 use warnings;
  8         29  
  8         567  
8 8     8   45 use Object::Pad 0.800;
  8         113  
  8         420  
9              
10             package Device::BusPirate::Mode::BB 0.25;
11 8     8   5583 class Device::BusPirate::Mode::BB :isa(Device::BusPirate::Mode);
  8         30  
  8         1268  
12              
13 8     8   789 use Carp;
  8         14  
  8         690  
14              
15 8     8   55 use Future::AsyncAwait;
  8         17  
  8         44  
16              
17 8     8   565 use constant MODE => "BB";
  8         16  
  8         756  
18              
19             use constant {
20 8         24027 MASK_CS => 0x01,
21             MASK_MISO => 0x02,
22             MASK_CLK => 0x04,
23             MASK_MOSI => 0x08,
24             MASK_AUX => 0x10,
25              
26             CONF_PULLUP => 0x20,
27             CONF_POWER => 0x40,
28 8     8   43 };
  8         16  
29              
30             # Convenience hash
31             my %PIN_MASK = map { $_ => __PACKAGE__->${\"MASK_\U$_"} } qw( cs miso clk mosi aux );
32              
33             =head1 NAME
34              
35             C - use C in bit-banging mode
36              
37             =head1 SYNOPSIS
38              
39             use Device::BusPirate;
40              
41             my $pirate = Device::BusPirate->new;
42             my $bb = $pirate->enter_mode( "BB" )->get;
43              
44             my $count = 0;
45             while(1) {
46             $bb->write(
47             miso => $count == 0,
48             cs => $count == 1,
49             mosi => $count == 2,
50             clk => $count == 3,
51             aux => $count == 4,
52             )->then( sub { $pirate->sleep( 0.5 ) })
53             ->get;
54              
55             $count++;
56             $count = 0 if $count >= 5;
57             }
58              
59             =head1 DESCRIPTION
60              
61             This object is returned by a L instance when switching it
62             into C mode. It provides methods to configure the hardware, and interact
63             with the five basic IO lines in bit-banging mode.
64              
65             =cut
66              
67             =head1 METHODS
68              
69             The following methods documented with C expressions L instances.
70              
71             =cut
72              
73             field $_dir_mask;
74             field $_out_mask;
75              
76             async method start
77 1     1 0 3 {
78 1         1 $_dir_mask = 0x1f; # all inputs
79              
80 1         2 $_out_mask = 0; # all off
81              
82 1         11 return $self;
83             }
84              
85             =head2 configure
86              
87             await $bb->configure( %args );
88              
89             Change configuration options. The following options exist; all of which are
90             simple true/false booleans.
91              
92             =over 4
93              
94             =item open_drain
95              
96             If enabled, a "high" output pin will be set as an input; i.e. hi-Z. When
97             disabled (default), a "high" output pin will be driven by 3.3V. A "low" output
98             will be driven to GND in either case.
99              
100             =back
101              
102             =cut
103              
104             field $_open_drain;
105              
106 0     0 1 0 async method configure ( %args )
  0         0  
  0         0  
  0         0  
107 0         0 {
108 0 0       0 defined $args{open_drain} and $_open_drain = $args{open_drain};
109             }
110              
111             =head2 write
112              
113             await $bb->write( %pins );
114              
115             Sets the state of multiple output pins at the same time.
116              
117             =cut
118              
119 4     4   6 async method _writeread ( $want_read, $pins_write, $pins_read )
  4         9  
  4         4  
  4         7  
  4         5  
  4         4  
120 4         6 {
121 4         6 my $out = $_out_mask;
122 4         56 my $dir = $_dir_mask;
123              
124 4         11 foreach my $pin ( keys %$pins_write ) {
125 3 50       10 my $mask = $PIN_MASK{$pin} or
126             croak "Unrecognised BB pin name $pin";
127 3         6 my $val = $pins_write->{$pin};
128              
129 3 100 66     15 if( $val and !$_open_drain ) {
    50          
130 2         3 $dir &= ~$mask;
131 2         4 $out |= $mask;
132             }
133             elsif( $val ) {
134 0         0 $dir |= $mask;
135             }
136             else {
137 1         1 $dir &= ~$mask;
138 1         2 $out &= ~$mask;
139             }
140             }
141              
142 4         7 foreach my $pin ( @$pins_read ) {
143 0 0       0 my $mask = $PIN_MASK{$pin} or
144             croak "Unrecognised BB pin name $pin";
145              
146 0         0 $dir |= $mask;
147             }
148              
149 4         6 my $len = 0;
150 4 100       10 if( $dir != $_dir_mask ) {
151 2         22 $self->pirate->write( chr( 0x40 | $dir ) );
152 2         10 $len++;
153              
154 2         3 $_dir_mask = $dir;
155             }
156              
157 4 100 100     13 if( $want_read or $out != $_out_mask ) {
158 3         11 $self->pirate->write( chr( 0x80 | $out ) );
159 3         13 $len++;
160              
161 3         5 $_out_mask = $out;
162             }
163              
164 4 50       9 return unless $len;
165              
166 4         8 my $buf = await $self->pirate->read( $len );
167              
168 4 100       627 return if !$want_read;
169              
170 2         3 $buf = ord $buf;
171              
172 2         3 my $pins;
173 2         9 foreach my $pin ( keys %PIN_MASK ) {
174 10         15 my $mask = $PIN_MASK{$pin};
175 10 100       18 next unless $_dir_mask & $mask;
176 8         33 $pins->{$pin} = !!( $buf & $mask );
177             }
178              
179 2         11 return $pins;
180             }
181              
182 1     1 1 1318 method write ( %pins )
  1         5  
  1         4  
  1         2  
183             {
184 1         5 $self->_writeread( 0, \%pins, [] );
185             }
186              
187 1     1   2 async method _input1 ( $mask )
  1         1  
  1         2  
  1         2  
188 1         2 {
189 1         2 $_dir_mask |= $mask;
190              
191 1         9 $self->pirate->write( chr( 0x40 | $_dir_mask ) );
192 1         6 return ord( await $self->pirate->read( 1 ) ) & $mask;
193             }
194              
195             =head2 read
196              
197             $pins = await $bbio->read( @pins );
198              
199             Sets given list of pins (which may be empty) to be inputs, and returns a HASH
200             containing the current state of all the pins currently configured as inputs.
201             More efficient than calling multiple C methods when more than one pin
202             is being read at the same time.
203              
204             =cut
205              
206 2     2 1 1030 method read ( @pins )
  2         26  
  2         5  
  2         2  
207             {
208 2         8 $self->_writeread( 1, {}, \@pins );
209             }
210              
211             =head2 writeread
212              
213             $in_pins = await $bbio->writeread( %out_pins );
214              
215             Combines the effects of C and C in a single operation; sets the
216             output state of any pins in C<%out_pins> then returns the input state of the
217             pins currently set as inputs.
218              
219             =cut
220              
221 0     0 1 0 method writeread ( %pins )
  0         0  
  0         0  
  0         0  
222             {
223 0         0 $self->_writeread( 1, \%pins, [] );
224             }
225              
226             =head2 power
227              
228             await $bb->power( $power );
229              
230             Enable or disable the C 5V and 3.3V power outputs.
231              
232             =cut
233              
234 1     1 1 727 async method power ( $on )
  1         4  
  1         2  
  1         2  
235 1         2 {
236 1 50       3 $on ? ( $_out_mask |= CONF_POWER )
237             : ( $_out_mask &= ~CONF_POWER );
238 1         3 $self->pirate->write( chr( 0x80 | $_out_mask ) );
239 1         7 await $self->pirate->read( 1 );
240 1         168 return;
241             }
242              
243             =head2 pullup
244              
245             await $bb->pullup( $pullup );
246              
247             Enable or disable the IO pin pullup resistors from C. These are connected
248             to the C, C, C and C pins.
249              
250             =cut
251              
252 1     1 1 79 async method pullup ( $on )
  1         3  
  1         1  
  1         2  
253 1         3 {
254 1 50       4 $on ? ( $_out_mask |= CONF_PULLUP )
255             : ( $_out_mask &= ~CONF_PULLUP );
256 1         2 $self->pirate->write( chr( 0x80 | $_out_mask ) );
257 1         6 await $self->pirate->read( 1 );
258 1         137 return;
259             }
260              
261             =head1 PER-PIN METHODS
262              
263             For each named pin, the following methods are defined. The pin names are
264              
265             cs miso sck mosi aux
266              
267             =head2 I
268              
269             await $bbio->PIN( $state );
270              
271             Sets the output state of the given pin.
272              
273             =head2 read_I
274              
275             $state = await $bbio->read_PIN;
276              
277             Sets the pin to input direction and reads its current state.
278              
279             =cut
280              
281             BEGIN {
282 8     8   73 use Object::Pad 0.800 ':experimental(mop)';
  8         54  
  8         385  
283 8     8   5625 my $metaclass = Object::Pad::MOP::Class->for_caller;
284              
285 8         609 foreach my $pin (qw( cs miso clk mosi aux )) {
286 40         67 my $mask = __PACKAGE__->${\"MASK_\U$pin"};
  40         1236  
287              
288 1         4 $metaclass->add_method(
289 40     1 1 506 $pin => method ( $on ) { $self->_writeread( 0, { $pin => $on }, [] ) }
  1     1 0 932  
  1     1 1 2  
  1     1 0 1  
  1     1 0 4  
290             );
291              
292             $metaclass->add_method(
293 40         1567 "read_$pin" => method { $self->_input1( $mask ) }
  1         64  
294             );
295             }
296             }
297              
298             =head1 TODO
299              
300             =over 4
301              
302             =item *
303              
304             Some method of setting multiple pins into read mode at once, so that a single
305             C method hits them all.
306              
307             =back
308              
309             =head1 AUTHOR
310              
311             Paul Evans
312              
313             =cut
314              
315             0x55AA;