File Coverage

blib/lib/Graphics/Framebuffer/Mouse.pm
Criterion Covered Total %
statement 23 69 33.3
branch 0 14 0.0
condition 0 11 0.0
subroutine 7 12 58.3
pod 0 4 0.0
total 30 110 27.2


line stmt bran cond sub pod time code
1             package Graphics::Framebuffer::Mouse;
2              
3 1     1   7 use strict;
  1         2  
  1         32  
4 1     1   5 no strict 'vars'; # We have to map a variable as the screen. So strict is going to whine about what we do with it.
  1         3  
  1         23  
5 1     1   5 no warnings; # We have to be as quiet as possible
  1         2  
  1         42  
6              
7             use constant {
8 1         71 TRUE => 1,
9             FALSE => 0,
10 1     1   6 };
  1         2  
11              
12 1     1   6 use Time::HiRes qw(alarm);
  1         2  
  1         9  
13 1     1   141 use List::Util qw(min max);
  1         2  
  1         162  
14              
15             BEGIN {
16 1     1   7 require Exporter;
17 1         26 our @ISA = qw( Exporter );
18 1         3 our $VERSION = '0.03';
19 1         3 our @EXPORT = qw( initialize_mouse poll_mouse get_mouse set_mouse );
20 1         743 our @EXPORT_OK = qw();
21             }
22              
23             sub initialize_mouse {
24 0     0 0   my $self = shift;
25 0   0       my $mode = shift || 'ON';
26              
27 0 0         if ($mode =~ /1|ON|ENABLE|SHOW/i) {
28 0           $self->set_mouse({'x' => int($self->{'XRES'} / 2), 'y' => int($self->{'YRES'} / 2)});
29 0           my $save = $self->{'DRAW_MODE'};
30 0           $self->{'DRAW_MODE'} = $self->{'XOR_MODE'};
31             $self->plot(
32             {
33             'x' => $self->{'MOUSE_X'},
34 0           'y' => $self->{'MOUSE_Y'},
35             'pixel_size' => 5,
36             }
37             );
38 0           $self->{'DRAW_MODE'} = $save;
39             $SIG{'ALRM'} = sub {
40 0     0     alarm(0);
41 0           $self->poll_mouse();
42 0           alarm(.01);
43 0           };
44 0           alarm(.01);
45             } else {
46 0           alarm(0);
47 0           my $save = $self->{'DRAW_MODE'};
48 0           $self->{'DRAW_MODE'} = $self->{'XOR_MODE'};
49             $self->plot(
50             {
51             'x' => $self->{'MOUSE_X'},
52 0           'y' => $self->{'MOUSE_Y'},
53             'pixel_size' => 5,
54             }
55             );
56 0           $self->{'DRAW_MODE'} = $save;
57             }
58             }
59              
60             sub poll_mouse {
61 0     0 0   my $self = shift;
62 0 0         if (open(my $m,'<','/dev/input/mice')) {
    0          
63 0           binmode($m);
64 0           my $mouse = '';
65 0 0         if (sysread($m,$mouse,3)) {
66 0           my ($b,$x,$y) = unpack('c3',$mouse);
67 0           $self->{'MOUSE_BUTTON'} = $b;
68 0 0 0       if ($x != 0 && $y != 0) {
69 0           my $old_mode = $self->{'DRAW_MODE'};
70 0           $self->{'DRAW_MODE'} = $self->{'XOR_MODE'};
71             $self->plot(
72             {
73             'x' => $self->{'MOUSE_X'},
74 0           'y' => $self->{'MOUSE_Y'},
75             'pixel_size' => 5,
76             }
77             );
78 0           $self->{'MOUSE_X'} += $x;
79 0           $self->{'MOUSE_Y'} -= $y; # Mouse is in reverse
80 0           $self->{'MOUSE_X'} = min(max(0,$self->{'MOUSE_X'}),$self->{'XRES'});
81 0           $self->{'MOUSE_Y'} = min(max(0,$self->{'MOUSE_Y'}),$self->{'YRES'});
82             $self->plot(
83             {
84             'x' => $self->{'MOUSE_X'},
85 0           'y' => $self->{'MOUSE_Y'},
86             'pixel_size' => 5,
87             }
88             );
89 0           $self->{'DRAW_MODE'} = $old_mode;
90             }
91             }
92 0           close($m);
93             } elsif ($self->{'SHOW_ERRORS'}) {
94 0           print STDERR "Could not open mouse for polling\n";
95             }
96             }
97              
98             sub get_mouse {
99 0     0 0   my $self = shift;
100 0 0         if (wantarray) {
101 0           return($self->{'MOUSE_BUTTON'},$self->{'MOUSE_X'},$self->{'MOUSE_Y'});
102             } else {
103             return(
104             {
105             'button' => $self->{'MOUSE_BUTTON'},
106             'x' => $self->{'MOUSE_X'},
107 0           'y' => $self->{'MOUSE_Y'},
108             }
109             );
110             }
111             }
112              
113             sub set_mouse {
114 0     0 0   my $self = shift;
115 0           my $params = shift;
116              
117 0 0 0       return unless(defined($params) && exists($params->{'x'}) && exists($params->{'y'}));
      0        
118              
119 0           $self->{'MOUSE_X'} = $params->{'x'};
120 0           $self->{'MOUSE_Y'} = $params->{'y'};
121             }
122              
123             1;
124              
125             =head1 NAME
126              
127             Graphics::Framebuffer::Mouse
128              
129             =head1 DESCRIPTION
130              
131             See the "Graphics::Frambuffer" documentation, as methods within here are pulled into the main module
132              
133             =cut
134