equal
deleted
inserted
replaced
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 { |
84 sub set { |
85 my $self = shift; |
85 my $self = shift; |
86 my $value = pop @_ ? 1 : 0; |
86 |
|
87 #my $value = @_ == 1 ? 1 : pop @_ ? 1 : 0; |
|
88 croak "need at least 2 values" if @_ < 2; |
|
89 my $value = pop @_ ? 1 : 0; |
87 my @bits = map { $_ - 1 } @_; |
90 my @bits = map { $_ - 1 } @_; |
88 my @groups = map { 0 } 0 .. 7; |
91 my @groups = map { 0 } 0 .. 7; |
89 |
92 |
90 # input is a list of bits to set and the value (0/1) |
93 # 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 |
94 # we'll map it to SX 0100 xx.xx.xx.xx xx.xx.xx.xx |
94 my $bit = $_ % 8; |
97 my $bit = $_ % 8; |
95 $groups[$group] |= (1 << $bit); |
98 $groups[$group] |= (1 << $bit); |
96 } |
99 } |
97 |
100 |
98 my $cmd = $value ? "S" : "C"; |
101 my $cmd = $value ? "S" : "C"; |
|
102 |
|
103 # could be optimized to only include the bytes we're interested |
|
104 # in |
99 $cmd .= "X 0100"; |
105 $cmd .= "X 0100"; |
100 $cmd .= join "", map { sprintf "%02x ", $_ } reverse @groups; |
106 $cmd .= join "", map { sprintf "%02x ", $_ } reverse @groups; |
101 $self->cmd($cmd); |
107 $self->cmd($cmd); |
|
108 } |
|
109 |
|
110 sub on { push @_, 1; goto \&set } |
|
111 |
|
112 sub off { push @_, 0; goto \&set } |
|
113 |
|
114 sub get { |
|
115 my $self = shift; |
|
116 my @bits = map { $_ - 1 } @_; |
|
117 |
|
118 # could be optimized to only include the bytes we're interested |
|
119 # in |
|
120 $self->cmd("RX 0100")->ok |
|
121 or return undef; |
|
122 my @groups = reverse map { hex } ($self->last_result->data =~ /../g); |
|
123 |
|
124 my @r; |
|
125 |
|
126 foreach (@bits) { |
|
127 my $group = int($_ / 8); |
|
128 my $bit = $_ % 8; |
|
129 push @r, $groups[$group] & (1 << $bit) ? 1 : 0; |
|
130 } |
|
131 |
|
132 return @bits == 1 ? $r[0] : @r; |
102 } |
133 } |
103 |
134 |
104 sub set_timeout { |
135 sub set_timeout { |
105 my $self = shift; |
136 my $self = shift; |
106 my $to = shift; |
137 my $to = shift; |
177 |
208 |
178 =item B<set>( $bit, ... => $value ) |
209 =item B<set>( $bit, ... => $value ) |
179 |
210 |
180 This sets one or more bits the specified values (true, false). |
211 This sets one or more bits the specified values (true, false). |
181 |
212 |
|
213 =item B<get>( $bit, ... ) |
|
214 |
|
215 Return the values of the specified bits. If you provide a list of bits, |
|
216 you'll get a list of values, if you provide just a single bit, you'll |
|
217 get a single scalar only. On error it returns B<undef>. So for a single |
|
218 scalar you've to check carefully if you got 0 or undef. |
|
219 |
|
220 =item B<on>( $bit, ... ) |
|
221 |
|
222 =item B<off>( $bit, ... ) |
|
223 |
|
224 Both are just shortcuts for L<set>(). |
|
225 |
182 =item B<cmd>( I<string> ) |
226 =item B<cmd>( I<string> ) |
183 |
227 |
184 Send a Quancom string to the device. The string here should be |
228 Send a Quancom string to the device. The string here should be |
185 B<without> the leading STX and Jobid as well without the trailing CR. |
229 B<without> the leading STX and Jobid as well without the trailing CR. |
186 It returns a L<Quancom::Result> object. |
230 It returns a L<Quancom::Result> object. |
229 die $quancom->error_message if not $quancom->ok; |
273 die $quancom->error_message if not $quancom->ok; |
230 |
274 |
231 $quancom->set(1..63 => 1)->ok |
275 $quancom->set(1..63 => 1)->ok |
232 or die $quancom->last_result->error_message; |
276 or die $quancom->last_result->error_message; |
233 |
277 |
|
278 $quancom->on(33); |
|
279 $quancom->off(33); |
|
280 |
|
281 @a = $quancom->get(1..64) or |
|
282 die $quancom->last_result->error_message; |
|
283 ($a23, $a34) = $quancom->get(23, 34); |
|
284 |
|
285 defined($a = $quancom->get(12)) |
|
286 or die $quancom->last_result->error_message; |
|
287 |
234 =head1 SEE ALSO |
288 =head1 SEE ALSO |
235 |
289 |
236 L<Quancom::Result> |
290 L<Quancom::Result> |
237 |
291 |
238 =head1 AUTHOR |
292 =head1 AUTHOR |