# HG changeset patch # User Heiko Schlittermann # Date 1232595314 -3600 # Node ID 66c21518904c3bb7bcef8b7eef9609f977ee5555 # Parent 7690e12fafdaa9b60da21b19a67f96a006c9db82 Implemented get(), on(), off(). But it's not tested a lot! So, you're warned. diff -r 7690e12fafda -r 66c21518904c examples/client --- a/examples/client Thu Jan 22 03:57:27 2009 +0100 +++ b/examples/client Thu Jan 22 04:35:14 2009 +0100 @@ -15,14 +15,18 @@ my $r; $q->set(1..64 => 1); sleep 1; + print $q->get(1..64), "\n"; $q->set(1..64 => 0); sleep 1; + print $q->get(1..64), "\n"; foreach (1..64) { $q->set($_ => 1); + print $q->get(1..64), "\n"; usleep 1e6/20; } foreach (1..64) { $q->set($_ => 0); + print $q->get(1..64), "\n"; usleep 1e6/20; } diff -r 7690e12fafda -r 66c21518904c lib/Quancom.pm --- a/lib/Quancom.pm Thu Jan 22 03:57:27 2009 +0100 +++ b/lib/Quancom.pm Thu Jan 22 04:35:14 2009 +0100 @@ -82,8 +82,11 @@ } sub set { - my $self = shift; - my $value = pop @_ ? 1 : 0; + my $self = shift; + + #my $value = @_ == 1 ? 1 : pop @_ ? 1 : 0; + croak "need at least 2 values" if @_ < 2; + my $value = pop @_ ? 1 : 0; my @bits = map { $_ - 1 } @_; my @groups = map { 0 } 0 .. 7; @@ -96,11 +99,39 @@ } my $cmd = $value ? "S" : "C"; + + # could be optimized to only include the bytes we're interested + # in $cmd .= "X 0100"; $cmd .= join "", map { sprintf "%02x ", $_ } reverse @groups; $self->cmd($cmd); } +sub on { push @_, 1; goto \&set } + +sub off { push @_, 0; goto \&set } + +sub get { + my $self = shift; + my @bits = map { $_ - 1 } @_; + + # could be optimized to only include the bytes we're interested + # in + $self->cmd("RX 0100")->ok + or return undef; + my @groups = reverse map { hex } ($self->last_result->data =~ /../g); + + my @r; + + foreach (@bits) { + my $group = int($_ / 8); + my $bit = $_ % 8; + push @r, $groups[$group] & (1 << $bit) ? 1 : 0; + } + + return @bits == 1 ? $r[0] : @r; +} + sub set_timeout { my $self = shift; my $to = shift; @@ -179,6 +210,19 @@ This sets one or more bits the specified values (true, false). +=item B( $bit, ... ) + +Return the values of the specified bits. If you provide a list of bits, +you'll get a list of values, if you provide just a single bit, you'll +get a single scalar only. On error it returns B. So for a single +scalar you've to check carefully if you got 0 or undef. + +=item B( $bit, ... ) + +=item B( $bit, ... ) + +Both are just shortcuts for L(). + =item B( I ) Send a Quancom string to the device. The string here should be @@ -231,6 +275,16 @@ $quancom->set(1..63 => 1)->ok or die $quancom->last_result->error_message; + $quancom->on(33); + $quancom->off(33); + + @a = $quancom->get(1..64) or + die $quancom->last_result->error_message; + ($a23, $a34) = $quancom->get(23, 34); + + defined($a = $quancom->get(12)) + or die $quancom->last_result->error_message; + =head1 SEE ALSO L