line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
######################################################################################### |
2
|
|
|
|
|
|
|
# Package HiPi::Interface::MonoOLED::DisplayBuffer |
3
|
|
|
|
|
|
|
# Description : Control Monochrome OLEDs |
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::Interface::MonoOLED::DisplayBuffer; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
######################################################################################### |
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
28
|
|
14
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
15
|
1
|
|
|
1
|
|
5
|
use parent qw( HiPi::Graphics::DrawingContext ); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
5
|
|
16
|
1
|
|
|
1
|
|
57
|
use Carp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
490
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
__PACKAGE__->create_ro_accessors( qw( rows cols bytes_per_col buffer ) ); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $VERSION ='0.81'; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub new { |
23
|
0
|
|
|
0
|
0
|
|
my( $class, %params) = @_; |
24
|
0
|
|
|
|
|
|
$params{bytes_per_col} = $params{rows} >> 3; |
25
|
0
|
|
|
|
|
|
my @data = ( 0 ) x ( $params{cols} * $params{bytes_per_col} ); |
26
|
0
|
|
|
|
|
|
$params{buffer} = \@data; |
27
|
0
|
|
|
|
|
|
my $self = $class->SUPER::new( %params ); |
28
|
0
|
|
|
|
|
|
return $self; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub clear_buffer { |
32
|
0
|
|
|
0
|
0
|
|
my ($self, $on) = @_; |
33
|
0
|
|
|
|
|
|
for (my $i = 0; $i < @{ $self->buffer }; $i ++) { |
|
0
|
|
|
|
|
|
|
34
|
0
|
|
|
|
|
|
$self->buffer->[$i] = $on; |
35
|
|
|
|
|
|
|
} |
36
|
0
|
|
|
|
|
|
return; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub draw_pixel { |
40
|
0
|
|
|
0
|
0
|
|
my($self, $x, $y, $on) = @_; |
41
|
|
|
|
|
|
|
|
42
|
0
|
0
|
0
|
|
|
|
return if( $x < 0 || $x >= $self->cols || $y < 0 || $y >= $self->rows ); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
43
|
|
|
|
|
|
|
|
44
|
0
|
|
0
|
|
|
|
$on //= 1; |
45
|
|
|
|
|
|
|
|
46
|
0
|
0
|
|
|
|
|
if($self->pen_inverted) { |
47
|
0
|
0
|
|
|
|
|
$on = ( $on ) ? 0 : 1; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
0
|
|
|
|
|
|
my $mem_col = $x; |
51
|
0
|
|
|
|
|
|
my $mem_row = $y >> 3; |
52
|
0
|
|
|
|
|
|
my $bit_mask = 1 << ($y % 8); |
53
|
0
|
|
|
|
|
|
my $offset = $mem_row * $self->cols + $mem_col; |
54
|
|
|
|
|
|
|
|
55
|
0
|
0
|
|
|
|
|
if($on) { |
56
|
0
|
|
|
|
|
|
$self->buffer->[$offset] |= $bit_mask; |
57
|
|
|
|
|
|
|
} else { |
58
|
0
|
|
|
|
|
|
$self->buffer->[$offset] &= ( 0xFF - $bit_mask ); |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# noops for buffer context |
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
0
|
0
|
|
sub rotate { carp q(you cannot call 'rotate' on the main display); } |
65
|
|
|
|
|
|
|
|
66
|
0
|
|
|
0
|
0
|
|
sub rotated_text { carp q(you cannot call 'rotate_text' on the main display); } |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
0
|
0
|
|
sub clear_context { carp q(you cannot call 'clear_context' on the main display); } |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
1; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
__END__ |