lib/Quancom.pm
changeset 19 6acf8ea44e0a
parent 18 a6bc8818d069
child 20 94281ba012c8
equal deleted inserted replaced
18:a6bc8818d069 19:6acf8ea44e0a
    79     my $self = shift;
    79     my $self = shift;
    80     $self->reset->ok or return $self->{last_result};
    80     $self->reset->ok or return $self->{last_result};
    81     $self->cmd("WB 0007 00");
    81     $self->cmd("WB 0007 00");
    82 }
    82 }
    83 
    83 
       
    84 sub set {
       
    85     my $self   = shift;
       
    86     my $value  = pop @_ ? 1 : 0;
       
    87     my @bits   = map { $_ - 1 } @_;
       
    88     my @groups = map { 0 } 0 .. 7;
       
    89 
       
    90     # input is a list of bits to set and the value (0/1)
       
    91     # we'll map it to SX 0100 xx.xx.xx.xx xx.xx.xx.xx
       
    92     foreach (@bits) {
       
    93         my $group = int($_ / 8);
       
    94         my $bit   = $_ % 8;
       
    95         $groups[$group] |= (1 << $bit);
       
    96     }
       
    97     $_ = "SX 0100 " . join "", map { sprintf "%02x ", $_ } reverse @groups;
       
    98     $self->cmd($_);
       
    99 }
       
   100 
    84 sub set_timeout {
   101 sub set_timeout {
    85     my $self = shift;
   102     my $self = shift;
    86     my $to = shift;
   103     my $to   = shift;
       
   104 
       
   105     carp "setting timeouts does not work!";
    87 
   106 
    88     # timeout 3 (2.8s)
   107     # timeout 3 (2.8s)
    89     # [__--.-___]
   108     # [__--.-___]
    90     #     1 1	    0x18
   109     #     1 1	    0x18
    91     #   1           0x58
   110     #   1           0x58
   132     my $self = shift;
   151     my $self = shift;
   133 
   152 
   134     local $/ = "\r";                                       # CR is the delimiter
   153     local $/ = "\r";                                       # CR is the delimiter
   135 
   154 
   136     local $_ = $self->{socket}->getline;
   155     local $_ = $self->{socket}->getline;
       
   156 
   137     # chomp; warn "<<$_>>\n";
   157     # chomp; warn "<<$_>>\n";
   138     return $self->{last_result} = new Quancom::Result($_);
   158     return $self->{last_result} = new Quancom::Result($_);
   139 }
   159 }
   140 
   160 
   141 1;
   161 1;