equal
deleted
inserted
replaced
82 } |
82 } |
83 |
83 |
84 sub set { |
84 sub set { |
85 my $self = shift; |
85 my $self = shift; |
86 |
86 |
87 #my $value = @_ == 1 ? 1 : pop @_ ? 1 : 0; |
87 croak "bad usage"; |
88 croak "need at least 2 values" if @_ < 2; |
|
89 my $value = pop @_ ? 1 : 0; |
88 my $value = pop @_ ? 1 : 0; |
90 my @bits = map { $_ - 1 } @_; |
89 my @bits = map { $_ - 1 } @_; |
91 my @groups = map { 0 } 0 .. 7; |
90 my @groups = map { 0 } 0 .. 7; |
92 |
91 |
93 # input is a list of bits to set and the value (0/1) |
92 # input is a list of bits to set and the value (0/1) |
173 |
172 |
174 # chomp; warn "<<$_>>\n"; |
173 # chomp; warn "<<$_>>\n"; |
175 return $self->{last_result} = new Quancom::Result($_); |
174 return $self->{last_result} = new Quancom::Result($_); |
176 } |
175 } |
177 |
176 |
|
177 sub TIEARRAY { |
|
178 my $class = shift; |
|
179 my $self = new Quancom @_; |
|
180 return $self; |
|
181 } |
|
182 |
|
183 sub STORE { |
|
184 my $self = shift; |
|
185 warn "@_\n"; |
|
186 my ($bit, $value) = @_; |
|
187 $self->set($bit + 1, $value)->ok and return $value; |
|
188 croak "can't set bit $bit to $value"; |
|
189 } |
|
190 |
|
191 sub FETCH { |
|
192 my $self = shift; |
|
193 warn "@_\n"; |
|
194 my $bit = $_[0]; |
|
195 my $value; |
|
196 defined($value = $self->get($bit + 1)) |
|
197 and return $value; |
|
198 |
|
199 croak "can't get bit $bit\n"; |
|
200 } |
|
201 |
|
202 sub PUSH { |
|
203 my $self = shift; |
|
204 warn "@_\n"; |
|
205 my @a; |
|
206 @a[0..62] = $self->get(2..64); |
|
207 $a[63] = $_[0]; |
|
208 $self->set(@a); |
|
209 return $self->FETCHSIZE; |
|
210 } |
|
211 |
|
212 sub FETCHSIZE { |
|
213 my $self = shift; |
|
214 return 64; |
|
215 } |
|
216 |
178 1; |
217 1; |
179 |
218 |
180 __END__ |
219 __END__ |
181 |
220 |
182 =head1 NAME |
221 =head1 NAME |