Wednesday 22 July 2015

This time, it even looks like Perl!

I said before that my first attempt to get controlling the Raspberry Pi's GPIO pins from Perl looked ugly.  This time, I've added some methods to my JKLMwiringPi package, in an attempt to make the program look more like Perl.


#!/usr/bin/perl -w
use strict;

package JKLMwiringPi;
use strict;

use Inline C => Config =>
    ENABLE => AUTOWRAP =>
    LIBS => "-lwiringPi ";

use Inline C => <<"--END-C--";
    int  wiringPiSetup() ;
    void pinMode(int pin, int mode) ;
    int  digitalRead(int pin) ;
    void digitalWrite(int pin, int value) ;
    void delay(unsigned int howLong);
--END-C--

sub setup {
    my $proto = shift;                          #  MAGIC - DO NOT TRY TO UNDERSTAND THIS
    my $class = ref($proto) || $proto;          #  MAGIC - DO NOT TRY TO UNDERSTAND THIS
    my $self = undef;
    
    my $success = wiringPiSetup;
    if ($success >= 0) {
        $self = {"success" => $success};
        bless $self, $class;                    #  MAGIC - DO NOT TRY TO UNDERSTAND THIS
        return $self;
    };
    return undef;
};

sub pin_mode {
    my $self = shift;
    return undef unless $self;
    my ($pin, $mode, $mode1);
    while (@_ > 1) {
        $pin = shift;
        $mode = shift;
        $mode1 = 0;
        if ($mode =~ /[1oO]/) {
            $mode1 = 1;
        };
        pinMode $pin + 0, $mode1;
    };
    return $self;
};

sub ms_delay {
    my $self = shift;
    return undef unless $self;
    my $ms = shift;
    delay $ms + 0;
    return $self;
};

sub digital_read {
    my $self = shift;
    return undef unless $self;
    my @ans = ();
    foreach (@_) {
        push @ans, digitalRead($_ + 0);
    };
    return wantarray ? @ans : $ans[0];
};

sub digital_write {
    my $self = shift;
    return undef unless $self;
    my ($pin, $state, $state1);
    while (@_ > 1) {
        $pin = shift;
        $state = shift;
        $state1 = 0;
        if ($state =~ /[1nN]/) {
            $state1 = 1;
        };
        digitalWrite $pin + 0, $state1;
    };
    return $self;
};
 
1;
 
package Main;
use strict;
$| = 1;

my ($pin, $state, $wait, $array_ref, @array, $button);

#  Each element is an array reference constructor:
#  [ pin to affect, state to set it to, milliseconds to wait ]
my @seq = ([0, 1, 500], [1, 1, 500], [2, 1, 0], [0, 0, 500], [3, 1, 0], [1, 0, 500],
           [4, 1, 0], [2, 0, 500], [5, 1, 0], [3, 0, 500], [6, 1, 0], [4, 0, 500],
           [7, 1, 0], [5, 0, 500], [6, 0, 500], [7, 0, 1500],
           [7, 1, 500], [6, 1, 500], [5, 1, 0], [7, 0, 500], [4, 1, 0], [6, 0, 500],
           [3, 1, 0], [5, 0, 500], [2, 1, 0], [4, 0, 500], [1, 1, 0], [3, 0, 500],
           [0, 1, 0], [2, 0, 500], [1, 0, 500], [0, 0, 1500]);

#  Initialise GPIO
my $gpio = JKLMwiringPi->setup;
die "Something wrong with JKLMwiringPi->setup"                  unless $gpio;

#  Set ports 0 - 7 as outputs and port 8 as an input; note this channel has a
#  pull-up resistor

$gpio->pin_mode(0 => "out", 1 => "out", 2 => "out", 3 => "out", 4 => "out",
                5 => "out", 6 => "out", 7 => "out", 8 => "in");

#  Main loop:  Keep going around as long as button is unpressed  (due to wiring,
#  button shows 0 when pressed)

while ($button =$gpio->digital_read(8)) {
    push @seq, $array_ref = shift @seq;

    ($pin, $state, $wait) = @{$array_ref};

    print "Turning pin $pin ";
    print $state ? "on" : "off";

    $gpio->digital_write($pin, $state);
    $gpio->ms_delay($wait * .15);
    print "\n";
};

#  Tidy up after ourselves, leaving all outputs off

$gpio->digital_write(0 => "off", 1 => "off", 2 => "off", 3 => "off",
                     4 => "off", 5 => "off", 6 => "off", 7 => "off");

exit 0;

Now, that looks a lot more Perl-like. "Asking" methods such as digital_read() return the thing being asked for.  "Telling" methods return the JKLMwiringPi object, so they can be concatenated.  So we could write the guts of our main loop as

$gpio->digital_write($pin, $state)->ms_delay($wait * .15);

if we really wanted to.  But because of the way I've written pin_mode() and digital_write() to be able to accept arrays, there isn't a great deal of need to.

No comments:

Post a Comment