File Coverage

blib/lib/HiPi/Utils/BitBuffer.pm
Criterion Covered Total %
statement 12 106 11.3
branch 0 34 0.0
condition 0 39 0.0
subroutine 4 15 26.6
pod 0 9 0.0
total 16 203 7.8


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Utils::BitBuffer
3             # Description : Bit Buffers
4             # Copyright : Copyright (c) 2018 Mark Dootson
5             # License : This is free software; you can redistribute it and/or modify it under
6             # the same terms as the Perl 5 programming language system itself.
7             #########################################################################################
8              
9             package HiPi::Utils::BitBuffer;
10              
11             #########################################################################################
12              
13 1     1   7 use strict;
  1         1  
  1         29  
14 1     1   5 use warnings;
  1         2  
  1         31  
15 1     1   542 use Bit::Vector;
  1         1074  
  1         48  
16 1     1   8 use parent qw( HiPi::Class );
  1         2  
  1         4  
17              
18             our $VERSION ='0.81';
19              
20             __PACKAGE__->create_accessors ( qw( buffer y_buffer width height autoresize ) );
21              
22             sub new {
23 0     0 0   my ( $class, %userparams ) = @_;
24            
25 0           my %params = (
26             width => 8,
27             height => 8,
28             autoresize => 0,
29             );
30            
31             # get user params
32 0           foreach my $key( keys (%userparams) ) {
33 0           $params{$key} = $userparams{$key};
34             }
35            
36 0           my $buffer = _create_new_buffer( $params{width}, $params{height} );
37            
38 0           $params{buffer} = $buffer;
39 0           my $self = $class->SUPER::new( %params );
40            
41 0           return $self;
42             }
43              
44             sub _create_new_buffer {
45 0     0     my($w,$h, $val) = @_;
46 0   0       $val ||= 0;
47 0           my @buffer = ();
48 0           for ( my $i = 0; $i < $h; $i++ ) {
49 0           my $row = Bit::Vector->new( $w );
50 0           push @buffer, $row;
51             }
52            
53 0           return \@buffer;
54             }
55              
56             sub set_bit {
57 0     0 0   my ($self, $x, $y, $val) = @_;
58 0 0 0       return if( $x < 0 || $y < 0 );
59            
60             # check if buffer needs resizing
61 0 0         if( $self->autoresize ) {
62 0           my ($neww, $newh) = (0,0);
63 0 0         if( $x >= $self->width ) {
64 0           $neww = $x + 1;
65             }
66 0 0         if( $y >= $self->height ) {
67 0           $newh = $y + 1;
68             }
69 0 0 0       if( $neww || $newh ) {
70 0   0       $self->_reset_buffer( $neww || $self->width, $newh || $self->height );
      0        
71             }
72             } else {
73 0 0 0       return if( $x >= $self->width || $y >= $self->height );
74             }
75            
76             # set the bit
77 0 0         if($val) {
78 0           $self->buffer->[$y]->Bit_On($x);
79             } else {
80 0           $self->buffer->[$y]->Bit_Off($x);
81             }
82 0           return;
83             }
84              
85             sub get_bit {
86 0     0 0   my($self, $x, $y) = @_;
87 0 0 0       return 0 if( $x < 0 || $x >= $self->width || $y < 0 || $y >= $self->height );
      0        
      0        
88 0           return 0 + $self->buffer->[$y]->contains( $x );
89             }
90              
91             sub _reset_buffer {
92 0     0     my( $self, $w, $h ) = @_;
93            
94             # change the width ? extend each column vector
95 0 0         if( $w > $self->width ) {
96 0           for my $vector ( @{ $self->buffer } ) {
  0            
97 0           $vector->Resize( $w );
98             }
99 0           $self->width( $w );
100             }
101            
102             # change the height ? - add a new bit vector for every row
103 0 0         if( $h > $self->height ) {
104 0           for (my $i = 0; $i < $h - $self->height; $i++) {
105 0           push @{ $self->buffer }, Bit::Vector->new( $self->width );
  0            
106             }
107 0           $self->height( $h );
108             }
109            
110 0           return;
111             }
112              
113             sub clear {
114 0     0 0   my ( $self ) = @_;
115 0           for (my $row = 0; $row < $self->height; $row ++) {
116 0           $self->buffer->[$row]->Empty;
117             }
118             }
119              
120             sub fill {
121 0     0 0   my ( $self ) = @_;
122 0           for (my $row = 0; $row < $self->height; $row ++) {
123 0           $self->buffer->[$row]->Fill;
124             }
125             }
126              
127             sub clone_buffer {
128 0     0 0   my $self = shift;
129 0           my $class = ref( $self );
130            
131 0           my $clone = $class->new(
132             width => $self->width,
133             height => $self->height,
134             autoresize => $self->autoresize,
135             );
136            
137 0           my @newbuffer = ();
138 0           for (my $i = 0; $i < $self->height; $i ++ ) {
139 0           push @newbuffer, $self->buffer->[$i]->Clone;
140             }
141 0           $clone->buffer( \@newbuffer );
142            
143 0           return $clone;
144             }
145              
146             sub scroll_x_y {
147 0     0 0   my($self, $scrollx, $scrolly) = @_;
148 0           $scrollx %= $self->width;
149 0           $scrolly %= $self->height;
150 0 0 0       return unless($scrollx || $scrolly);
151 0 0         if( $scrolly ) {
152 0           my @vals = splice( @{ $self->buffer }, 0, $scrolly );
  0            
153 0           push @{ $self->buffer }, @vals;
  0            
154             }
155 0 0         if( $scrollx ) {
156 0           for ( my $y = 0; $y < $self->height; $y ++ ) {
157 0           $self->buffer->[$y]->Interval_Substitute($self->buffer->[$y],$self->buffer->[$y]->Size,$scrollx,0,$scrollx);
158 0           $self->buffer->[$y]->Interval_Substitute($self->buffer->[$y],0,$scrollx,0,0);
159             }
160             }
161 0           return;
162             }
163              
164             sub mirror {
165 0     0 0   my ($self, $shapex) = @_;
166 0   0       $shapex //= 0;
167 0           $shapex = abs($shapex);
168 0 0         $shapex = $self->width if $shapex > $self->width;
169 0           for ( my $y = 0; $y < $self->height; $y ++ ) {
170 0           $self->buffer->[$y]->Reverse($self->buffer->[$y]);
171             }
172 0 0 0       $self->scroll_x_y( $self->width - $shapex, 0 ) if $shapex && $shapex != $self->width;
173 0           return;
174             }
175              
176             sub flip {
177 0     0 0   my ($self, $shapex, $shapey) = @_;
178 0   0       $shapey //= 0;
179 0           $shapey = abs($shapey);
180 0 0         $shapey = $self->height if $shapey > $self->height;
181 0           my @newbuff;
182 0           for (my $i = 0; $i < $self->height; $i ++) {
183 0           unshift( @newbuff, $self->buffer->[$i] );
184             }
185            
186 0 0 0       if( $shapey && $shapey != $self->height ) {
187 0           my @vals = splice( @newbuff, 0, $self->height - $shapey );
188 0           push @newbuff, @vals;
189             }
190            
191 0           $self->buffer( \@newbuff );
192 0           $self->mirror( $shapex, 0 );
193 0           return;
194             }
195              
196             1;