File Coverage

blib/lib/Device/WebIO/RaspberryPi.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             # Copyright (c) 2015 Timm Murray
2             # All rights reserved.
3             #
4             # Redistribution and use in source and binary forms, with or without
5             # modification, are permitted provided that the following conditions are met:
6             #
7             # * Redistributions of source code must retain the above copyright notice,
8             # this list of conditions and the following disclaimer.
9             # * Redistributions in binary form must reproduce the above copyright
10             # notice, this list of conditions and the following disclaimer in the
11             # documentation and/or other materials provided with the distribution.
12             #
13             # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
14             # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
15             # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
16             # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
17             # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
18             # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
19             # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
20             # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
21             # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
22             # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
23             # POSSIBILITY OF SUCH DAMAGE.
24             package Device::WebIO::RaspberryPi;
25             $Device::WebIO::RaspberryPi::VERSION = '0.009';
26             # ABSTRACT: Device::WebIO implementation for the Rapsberry Pi
27 1     1   513 use v5.12;
  1         3  
  1         36  
28 1     1   8578 use Moo;
  1         13082  
  1         6  
29 1     1   1573 use namespace::clean;
  1         7228  
  1         4  
30 1     1   3865 use HiPi::Wiring qw( :wiring );
  0            
  0            
31             use HiPi::Device::I2C;
32             use HiPi::BCM2835::I2C qw( :all );
33             use HiPi::Device::SPI qw( :spi );
34             use GStreamer1;
35             use Glib qw( TRUE FALSE );
36             use AnyEvent;
37              
38             use constant {
39             TYPE_REV1 => 0,
40             TYPE_REV2 => 1,
41             TYPE_MODEL_B_PLUS => 2,
42             };
43              
44             use constant {
45             # maps of Rpi Pin -> Wiring lib pin
46             PIN_MAP_REV1 => {
47             0 => 8,
48             1 => 9,
49             4 => 7,
50             7 => 11,
51             8 => 10,
52             9 => 13,
53             10 => 12,
54             11 => 14,
55             14 => 15,
56             15 => 16,
57             17 => 0,
58             18 => 1,
59             21 => 2,
60             22 => 3,
61             23 => 4,
62             24 => 5,
63             25 => 6,
64             },
65             PIN_MAP_REV2 => {
66             2 => 8,
67             3 => 9,
68             4 => 7,
69             7 => 11,
70             8 => 10,
71             9 => 13,
72             10 => 12,
73             11 => 14,
74             14 => 15,
75             15 => 16,
76             17 => 0,
77             18 => 1,
78             27 => 2,
79             28 => 17,
80             22 => 3,
81             23 => 4,
82             24 => 5,
83             25 => 6,
84             30 => 19,
85             29 => 18,
86             31 => 20,
87             },
88             PIN_MAP_MODEL_B_PLUS => {
89             2 => 8,
90             3 => 9,
91             4 => 7,
92             7 => 11,
93             8 => 10,
94             9 => 13,
95             10 => 12,
96             11 => 14,
97             14 => 15,
98             15 => 16,
99             17 => 0,
100             18 => 1,
101             27 => 2,
102             28 => 17,
103             22 => 3,
104             23 => 4,
105             24 => 5,
106             25 => 6,
107             30 => 19,
108             29 => 18,
109             31 => 20,
110             },
111             };
112              
113             my %ALLOWED_VIDEO_TYPES = (
114             'video/H264' => 1,
115             'video/x-msvideo' => 1,
116              
117             # mp4mux doesn't seem to like the stream-format that comes out of rpicamsrc.
118             # Converting might be too slow on the Rpi. For reference, try to get this
119             # pipeline to work (which won't link up as written):
120             #
121             # gst-launch-1.0 -v rpicamsrc ! h264parse ! \
122             # 'video/x-h264,width=800,height=600,fps=30,stream-format=avc' ! \
123             # mp4mux ! filesink location=/tmp/output.mp4
124             #
125             # 'video/mp4' => 1,
126             );
127              
128              
129             has 'pin_desc', is => 'ro';
130             has '_type', is => 'ro';
131             has '_pin_mode' => (
132             is => 'ro',
133             );
134             has '_pin_map' => (
135             is => 'ro',
136             );
137             # Note that _output_pin_value should be mapped by the Wiring library's
138             # pin number, *not* the Rpi's numbering
139             has '_output_pin_value' => (
140             is => 'ro',
141             );
142              
143             has '_is_gstreamer_inited' => (
144             is => 'rw',
145             default => sub { 0 },
146             );
147              
148              
149             my $CALLED_WIRING_SETUP = 0;
150              
151              
152             sub BUILDARGS
153             {
154             my ($class, $args) = @_;
155             my $rpi_type = delete($args->{type}) // $class->TYPE_REV1;
156              
157             $args->{pwm_bit_resolution} = 10;
158             $args->{pwm_max_int} = 2 ** $args->{pwm_bit_resolution};
159              
160             if( TYPE_REV1 == $rpi_type ) {
161             $args->{input_pin_count} = 26;
162             $args->{output_pin_count} = 26;
163             $args->{pwm_pin_count} = 0;
164             $args->{pin_desc} = $class->_pin_desc_rev1;
165             $args->{'_pin_map'} = $class->PIN_MAP_REV1;
166             }
167             elsif( TYPE_REV2 == $rpi_type ) {
168             $args->{input_pin_count} = 26;
169             $args->{output_pin_count} = 26;
170             $args->{pwm_pin_count} = 1;
171             $args->{pin_desc} = $class->_pin_desc_rev2;
172             $args->{'_pin_map'} = $class->PIN_MAP_REV2;
173             }
174             elsif( TYPE_MODEL_B_PLUS == $rpi_type ) {
175             $args->{input_pin_count} = 26;
176             $args->{output_pin_count} = 26;
177             $args->{pwm_pin_count} = 1;
178             $args->{pin_desc} = $class->_pin_desc_model_b_plus;
179             $args->{'_pin_map'} = $class->PIN_MAP_MODEL_B_PLUS;
180             }
181             else {
182             die "Don't know what to do with Rpi type '$rpi_type'\n";
183             }
184              
185             $args->{'_pin_mode'} = [ ('IN') x $args->{input_pin_count} ];
186             $args->{'_output_pin_value'} = [ (0) x $args->{output_pin_count} ];
187              
188             HiPi::Wiring::wiringPiSetup() unless $CALLED_WIRING_SETUP;
189             $CALLED_WIRING_SETUP = 1;
190              
191             return $args;
192             }
193              
194              
195             has 'input_pin_count', is => 'ro';
196             with 'Device::WebIO::Device::DigitalInput';
197              
198             sub set_as_input
199             {
200             my ($self, $rpi_pin) = @_;
201             my $pin = $self->_rpi_pin_to_wiring( $rpi_pin );
202             return undef if $pin < 0;
203             $self->{'_pin_mode'}[$pin] = 'IN';
204             HiPi::Wiring::pinMode( $pin, WPI_INPUT );
205             return 1;
206             }
207              
208             sub input_pin
209             {
210             my ($self, $rpi_pin) = @_;
211             my $pin = $self->_rpi_pin_to_wiring( $rpi_pin );
212             return undef if $pin < 0;
213             my $in = HiPi::Wiring::digitalRead( $pin );
214             return $in;
215             }
216              
217             sub is_set_input
218             {
219             my ($self, $rpi_pin) = @_;
220             my $pin = $self->_rpi_pin_to_wiring( $rpi_pin );
221             return undef if $pin < 0;
222             return 1 if $self->_pin_mode->[$pin] eq 'IN';
223             return 0;
224             }
225              
226              
227             has 'output_pin_count', is => 'ro';
228             with 'Device::WebIO::Device::DigitalOutput';
229              
230             sub set_as_output
231             {
232             my ($self, $rpi_pin) = @_;
233             my $pin = $self->_rpi_pin_to_wiring( $rpi_pin );
234             return undef if $pin < 0;
235             $self->{'_pin_mode'}[$pin] = 'OUT';
236             HiPi::Wiring::pinMode( $pin, WPI_OUTPUT );
237             return 1;
238             }
239              
240             sub output_pin
241             {
242             my ($self, $rpi_pin, $value) = @_;
243             my $pin = $self->_rpi_pin_to_wiring( $rpi_pin );
244             return undef if $pin < 0;
245             $self->_output_pin_value->[$rpi_pin] = $value;
246             HiPi::Wiring::digitalWrite( $pin, $value ? WPI_HIGH : WPI_LOW );
247             return 1;
248             }
249              
250             sub is_set_output
251             {
252             my ($self, $rpi_pin) = @_;
253             my $pin = $self->_rpi_pin_to_wiring( $rpi_pin );
254             return undef if $pin < 0;
255             return 1 if $self->_pin_mode->[$pin] eq 'OUT';
256             return 0;
257             }
258              
259              
260             has 'pwm_pin_count', is => 'ro';
261             has 'pwm_bit_resolution', is => 'ro';
262             has 'pwm_max_int', is => 'ro';
263             with 'Device::WebIO::Device::PWM';
264              
265             {
266             my %did_set_pwm;
267             sub pwm_output_int
268             {
269             my ($self, $rpi_pin, $val) = @_;
270             my $pin = $self->_rpi_pin_to_wiring( $rpi_pin );
271             return undef if $pin < 0;
272             HiPi::Wiring::pinMode( $pin, WPI_PWM_OUTPUT )
273             if ! exists $did_set_pwm{$pin};
274             $did_set_pwm{$pin} = 1;
275              
276             HiPi::Wiring::pwmWrite( $pin, $val );
277             return 1;
278             }
279             }
280              
281             has '_img_width' => (
282             is => 'rw',
283             default => sub {[
284             1024
285             ]},
286             );
287             has '_img_height' => (
288             is => 'rw',
289             default => sub {[
290             768
291             ]},
292             );
293             has '_img_quality' => (
294             is => 'rw',
295             default => sub {[
296             100
297             ]},
298             );
299             with 'Device::WebIO::Device::StillImageOutput';
300              
301             my %IMG_CONTENT_TYPES = (
302             'image/jpeg' => 'jpeg',
303             'image/gif' => 'gif',
304             'image/png' => 'png',
305             );
306              
307             sub img_width
308             {
309             my ($self, $channel) = @_;
310             return $self->_img_width->[$channel];
311             }
312              
313             sub img_height
314             {
315             my ($self, $channel) = @_;
316             return $self->_img_height->[$channel];
317             }
318              
319             sub img_quality
320             {
321             my ($self, $channel) = @_;
322             return $self->_img_quality->[$channel];
323             }
324              
325             sub img_set_width
326             {
327             my ($self, $channel, $width) = @_;
328             $self->_img_width->[$channel] = $width;
329             return 1;
330             }
331              
332             sub img_set_height
333             {
334             my ($self, $channel, $height) = @_;
335             $self->_img_height->[$channel] = $height;
336             return 1;
337             }
338              
339             sub img_set_quality
340             {
341             my ($self, $channel, $quality) = @_;
342             $self->_img_quality->[$channel] = $quality;
343             return 1;
344             }
345              
346             sub img_channels
347             {
348             my ($self) = @_;
349             return 1;
350             }
351              
352             sub img_allowed_content_types
353             {
354             my ($self) = @_;
355             return [ keys %IMG_CONTENT_TYPES ];
356             }
357              
358             sub img_stream
359             {
360             my ($self, $channel, $mime_type) = @_;
361             my $imager_type = $IMG_CONTENT_TYPES{$mime_type};
362              
363             my $width = $self->img_width( $channel );
364             my $height = $self->img_height( $channel );
365             my $quality = $self->img_quality( $channel );
366              
367             $self->_init_gstreamer;
368              
369             my $loop = Glib::MainLoop->new( undef, FALSE );
370             my $pipeline = GStreamer1::Pipeline->new( 'pipeline' );
371              
372             my $rpi = GStreamer1::ElementFactory::make( rpicamsrc => 'and_who' );
373             my $h264parse = GStreamer1::ElementFactory::make( h264parse => 'are_you' );
374             my $capsfilter = GStreamer1::ElementFactory::make(
375             capsfilter => 'the_proud_lord_said' );
376             my $avdec_h264 = GStreamer1::ElementFactory::make(
377             avdec_h264 => 'that_i_should_bow_so_low' );
378             my $jpegenc = GStreamer1::ElementFactory::make( jpegenc => 'only_a_cat' );
379             my $appsink = GStreamer1::ElementFactory::make(
380             appsink => 'of_a_different_coat' );
381              
382             my $caps = GStreamer1::Caps::Simple->new( 'video/x-h264',
383             width => 'Glib::Int' => 800,
384             height => 'Glib::Int' => 600,
385             );
386             $capsfilter->set( caps => $caps );
387              
388             $appsink->set( 'max-buffers' => 20 );
389             $appsink->set( 'emit-signals' => TRUE );
390             $appsink->set( 'sync' => FALSE );
391              
392              
393             my @link = (
394             $rpi, $h264parse, $capsfilter, $avdec_h264, $jpegenc, $appsink );
395             $pipeline->add( $_ ) for @link;
396             foreach my $i (0 .. ($#link - 1)) {
397             my $this = $link[$i];
398             my $next = $link[$i+1];
399             $this->link( $next );
400             }
401              
402             $pipeline->set_state( "playing" );
403             my $jpeg_sample = $appsink->pull_sample;
404             $pipeline->set_state( "null" );
405              
406             my $jpeg_buf = $jpeg_sample->get_buffer;
407             my $size = $jpeg_buf->get_size;
408             my $buf = $jpeg_buf->extract_dup( 0, $size, undef, $size );
409              
410             my $scalar_buf = pack 'C*', @$buf;
411             open( my $jpeg_fh, '<', \$scalar_buf )
412             or die "Could not open ref to scalar: $!\n";
413              
414             return $jpeg_fh;
415             }
416              
417              
418             with 'Device::WebIO::Device::I2CProvider';
419              
420             sub i2c_channels { 2 }
421              
422             sub i2c_read
423             {
424             my ($self, $channel, $addr, $register, $len) = @_;
425             my $dev = $self->_get_i2c_device( $channel, $addr );
426             my @data = $dev->bus_read( $register, $len );
427             return @data;
428             }
429              
430             sub i2c_write
431             {
432             my ($self, $channel, $addr, $register, @data) = @_;
433             my $dev = $self->_get_i2c_device( $channel, $addr );
434             $dev->bus_write( $register, @data );
435             return 1;
436             }
437              
438             {
439             my @DEVS;
440             sub _get_i2c_device
441             {
442             my ($self, $channel, $addr) = @_;
443             return $DEVS[$channel]{$addr} if exists $DEVS[$channel]{$addr};
444              
445             my $peri =
446             $channel == 1 ? BB_I2C_PERI_1 :
447             $channel == 0 ? BB_I2C_PERI_0 :
448             undef;
449             my $hipi = HiPi::BCM2835::I2C->new(
450             peripheral => $peri,
451             address => $addr,
452             );
453              
454             $DEVS[$channel]{$addr} = $hipi;
455             return $hipi;
456             }
457             }
458              
459              
460             has '_vid_width' => (
461             is => 'rw',
462             default => sub {[
463             1920
464             ]},
465             );
466             has '_vid_height' => (
467             is => 'rw',
468             default => sub {[
469             1080
470             ]},
471             );
472             has '_vid_fps' => (
473             is => 'rw',
474             default => sub {[
475             30
476             ]},
477             );
478             has '_vid_bitrate' => (
479             is => 'rw',
480             default => sub {[
481             8000
482             ]},
483             );
484             has '_vid_stream_callbacks' => (
485             is => 'rw',
486             default => sub {[]},
487             );
488             has '_vid_stream_callback_types' => (
489             is => 'rw',
490             default => sub {[]},
491             );
492             has 'cv' => (
493             is => 'rw',
494             default => sub { AnyEvent->condvar },
495             );
496             has 'vid_use_audio' => (
497             is => 'rw',
498             default => sub { 0 },
499             );
500             has 'vid_audio_input_device' => (
501             is => 'rw',
502             default => sub { 'hw:1,0' },
503             );
504             with 'Device::WebIO::Device::VideoOutputCallback';
505              
506             sub vid_channels
507             {
508             return 1;
509             }
510              
511             sub vid_height
512             {
513             my ($self, $pin) = @_;
514             return $self->_vid_height->[$pin];
515             }
516              
517             sub vid_width
518             {
519             my ($self, $pin) = @_;
520             return $self->_vid_width->[$pin];
521             }
522              
523             sub vid_fps
524             {
525             my ($self, $pin) = @_;
526             return $self->_vid_fps->[$pin];
527             }
528              
529             sub vid_kbps
530             {
531             my ($self, $pin) = @_;
532             return $self->_vid_bitrate->[$pin];
533             }
534              
535             sub vid_set_width
536             {
537             my ($self, $pin, $val) = @_;
538             return $self->_vid_width->[$pin] = $val;
539             }
540              
541             sub vid_set_height
542             {
543             my ($self, $pin, $val) = @_;
544             return $self->_vid_height->[$pin] = $val;
545             }
546              
547             sub vid_set_fps
548             {
549             my ($self, $pin, $val) = @_;
550             return $self->_vid_fps->[$pin] = $val;
551             }
552              
553             sub vid_set_kbps
554             {
555             my ($self, $pin, $val) = @_;
556             $val *= 1024;
557             return $self->_vid_bitrate->[$pin] = $val;
558             }
559              
560             sub vid_allowed_content_types
561             {
562             return keys %ALLOWED_VIDEO_TYPES;
563             }
564              
565             sub vid_stream
566             {
567             my ($self, $pin, $type) = @_;
568             die "Do not support type '$type'" unless exists $ALLOWED_VIDEO_TYPES{$type};
569             $self->_init_gstreamer;
570             return 1;
571             }
572              
573             sub vid_stream_callback
574             {
575             my ($self, $pin, $type, $callback) = @_;
576             die "Do not support type '$type'" unless exists $ALLOWED_VIDEO_TYPES{$type};
577             $self->_vid_stream_callbacks->[$pin] = $callback;
578             $self->_vid_stream_callback_types->[$pin] = $type;
579             return 1;
580             }
581              
582             sub vid_stream_begin_loop
583             {
584             my ($self, $channel) = @_;
585             my $width = $self->vid_width( $channel );
586             my $height = $self->vid_height( $channel );
587             my $fps = $self->vid_fps( $channel );
588             my $bitrate = $self->vid_kbps( $channel );
589             my $callback = $self->_vid_stream_callbacks->[$channel];
590             my $type = $self->_vid_stream_callback_types->[$channel];
591             my $use_audio = $self->vid_use_audio;
592             my $audio_dev = $self->vid_audio_input_device;
593              
594              
595             $self->_init_gstreamer;
596             my $cv = $self->cv;
597             my $pipeline = GStreamer1::Pipeline->new( 'pipeline' );
598              
599             my $rpi = GStreamer1::ElementFactory::make( rpicamsrc => 'and_who' );
600             my $h264parse = GStreamer1::ElementFactory::make( h264parse => 'are_you' );
601             my $capsfilter = GStreamer1::ElementFactory::make(
602             capsfilter => 'the_proud_lord_said' );
603             my $sink = GStreamer1::ElementFactory::make(
604             fakesink => 'that_i_should_bow_so_low' );
605             my $vid_queue = GStreamer1::ElementFactory::make( 'queue' => 'only_a_cat' );
606              
607             my $muxer = ($type ne 'video/H264')
608             ? $self->_get_vid_mux_by_type( $type )
609             : undef;
610              
611             $rpi->set( bitrate => $bitrate );
612              
613             my $caps = GStreamer1::Caps::Simple->new( 'video/x-h264',
614             width => 'Glib::Int' => $width,
615             height => 'Glib::Int' => $height,
616             fps => 'Glib::Int' => $fps,
617             );
618             $capsfilter->set( caps => $caps );
619              
620             $sink->set( 'signal-handoffs' => TRUE );
621             $sink->signal_connect(
622             'handoff' => $self->_get_vid_stream_callback( $pipeline, $cv, $callback )
623             );
624              
625             $pipeline->add( $muxer ) if defined $muxer;
626              
627             if( $use_audio && defined $muxer ) {
628             my $audio_src = GStreamer1::ElementFactory::make(
629             'alsasrc' => 'of_a_different_coat' );
630             my $audio_caps = GStreamer1::ElementFactory::make(
631             capsfilter => 'the_only_truth_i_know' );
632             my $mp3enc = GStreamer1::ElementFactory::make(
633             lamemp3enc => 'in_a_coat_of_red' );
634             my $audio_queue = GStreamer1::ElementFactory::make(
635             queue => 'or_a_coat_of_gold' );
636              
637             $audio_src->set( 'device' => $audio_dev );
638             $mp3enc->set( 'bitrate' => 256 );
639              
640             my $caps = GStreamer1::Caps::Simple->new( 'audio/x-raw',
641             rate => 'Glib::Int' => 44100,
642             channels => 'Glib::Int' => 1,
643             format => 'Glib::String' => 'S16LE',
644             );
645             $audio_caps->set( caps => $caps );
646              
647             $pipeline->add( $_ ) for $audio_src, $audio_caps, $mp3enc, $audio_queue;
648             $audio_src->link( $audio_caps );
649             $audio_caps->link( $mp3enc );
650             $mp3enc->link( $audio_queue );
651             $audio_queue->link( $muxer );
652             }
653              
654             $pipeline->add( $_ ) for $rpi, $h264parse, $capsfilter, $sink, $vid_queue;
655             $rpi->link( $h264parse );
656             $h264parse->link( $capsfilter );
657             $capsfilter->link( $vid_queue );
658             $vid_queue->link( $muxer );
659             $muxer->link( $sink );
660              
661             $pipeline->set_state( "playing" );
662             $cv->recv;
663             $pipeline->set_state( "null" );
664              
665             return 1;
666             }
667              
668              
669             sub _get_vid_stream_callback
670             {
671             my ($self, $pipeline, $cv, $callback) = @_;
672              
673             my $full_callback = sub {
674             my ($sink, $data_buf, $pad) = @_;
675             my $size = $data_buf->get_size;
676             my $buf = $data_buf->extract_dup( 0, $size, undef, $size );
677              
678             $callback->( $buf );
679              
680             return 1;
681             };
682              
683             return $full_callback;
684             }
685              
686             my %MUXER_BY_TYPE = (
687             'video/x-msvideo' => [
688             'avimux', {},
689             ],
690             # 'video/mp4' => [
691             # 'mp4mux', {
692             # streamable => TRUE,
693             # },
694             # ],
695             );
696             sub _get_vid_mux_by_type
697             {
698             my ($self, $type) = @_;
699             my ($muxer_name, $properties) = @{ $MUXER_BY_TYPE{$type} };
700             my $muxer = GStreamer1::ElementFactory::make( $muxer_name => 'muxer' );
701              
702             for (keys %$properties) {
703             $muxer->set( $_ => $properties->{$_} );
704             }
705              
706             return $muxer;
707             }
708              
709             sub _pin_desc_rev1
710             {
711             return [qw{
712             V33 V50 2 V50 3 GND 4 14 GND 15 17 18 27 GND 22 23 V33 24 10 GND 9 25
713             11 8 GND 7
714             }];
715             }
716              
717             sub _pin_desc_rev2
718             {
719             return [qw{
720             V33 V50 2 V50 3 GND 4 14 GND 15 17 18 27 GND 22 23 V33 24 10 GND 9 25
721             11 8 GND 7
722             }];
723             }
724              
725             sub _pin_desc_model_b_plus
726             {
727             return [qw{
728             V33 V50 2 V50 3 GND 4 14 GND 15 17 18 27 GND 22 23 V33 24 10 GND 9 25
729             11 8 GND 7 GND GND 5 GND 6 12 13 GND 19 16 26 20 GND 21
730             }];
731             }
732              
733              
734             sub _rpi_pin_to_wiring
735             {
736             my ($self, $rpi_pin) = @_;
737             my $pin = $self->_pin_map->{$rpi_pin} // -1;
738             return $pin;
739             }
740              
741              
742             sub all_desc
743             {
744             my ($self) = @_;
745             my $pin_count = $self->input_pin_count;
746              
747             my %data = (
748             UART => 0,
749             SPI => 0,
750             I2C => 0,
751             ONEWIRE => 0,
752             GPIO => {
753             map {
754             my $function = $self->is_set_input( $_ ) ? 'IN'
755             : $self->is_set_output( $_ ) ? 'OUT'
756             : 'UNSET';
757             my $value = $function eq 'IN'
758             ? $self->input_pin( $_ )
759             : $self->_output_pin_value->[$_];
760             (defined $value)
761             ? (
762             $_ => {
763             function => $function,
764             value => $value,
765             }
766             )
767             : ();
768             } 0 .. ($pin_count - 1)
769             },
770             );
771              
772             return \%data;
773             }
774              
775              
776             sub _init_gstreamer
777             {
778             my ($self) = @_;
779             return 1 if $self->_is_gstreamer_inited;
780             GStreamer1::init([ $0, @ARGV ]);
781             $self->_is_gstreamer_inited( 1 );
782             return 1;
783             }
784              
785              
786             with 'Device::WebIO::Device::SPI';
787              
788             my @CHANNEL_NAMES = sort HiPi::Device::SPI->get_device_list;
789             has '_spi_channel_devs' => (
790             is => 'ro',
791             default => sub {{}},
792             );
793              
794              
795             sub spi_channels { scalar @CHANNEL_NAMES }
796              
797             sub spi_set_speed
798             {
799             my ($self, $channel, $speed) = @_;
800             my $dev = $self->_spi_get_dev( $channel, $speed );
801             $dev->set_bus_maxspeed( $speed );
802             return 1;
803             }
804              
805             sub spi_read
806             {
807             my ($self, $channel, $len) = @_;
808             my $dev = $self->_spi_get_dev( $channel );
809             my $buf = pack 'C*', ((0x00) x $len);
810             my $recv = $dev->transfer( $buf );
811             return [ unpack 'C*', $recv ];
812             }
813              
814             sub spi_write
815             {
816             my ($self, $channel, $data) = @_;
817             my $dev = $self->_spi_get_dev( $channel );
818             $dev->transfer( $data );
819             return 1;
820             }
821              
822             sub _spi_get_dev
823             {
824             my $self = shift;
825             my $channel = shift;
826             my $channel_name = $CHANNEL_NAMES[$channel];
827             return $self->_spi_channel_devs->{$channel_name}
828             if exists $self->_spi_channel_devs->{$channel_name};
829              
830             my $speed = @_
831             ? shift
832             : SPI_SPEED_KHZ_500;
833              
834             my $dev = HiPi::Device::SPI->new(
835             devicename => $channel_name,
836             speed => $speed,
837             );
838             $self->_spi_channel_devs->{$channel_name} = $dev;
839             return $dev;
840             }
841              
842              
843             # TODO
844             #with 'Device::WebIO::Device::Serial';
845              
846             1;
847             __END__