File Coverage

blib/lib/Acme/KeyboardMarathon.pm
Criterion Covered Total %
statement 92 96 95.8
branch 8 14 57.1
condition 2 2 100.0
subroutine 9 9 100.0
pod 0 2 0.0
total 111 123 90.2


line stmt bran cond sub pod time code
1             package Acme::KeyboardMarathon;
2             $Acme::KeyboardMarathon::VERSION = '1.26';
3              
4 5     5   74303 use Carp;
  5         44  
  5         507  
5 5     5   3172 use Data::Dumper;
  5         37820  
  5         595  
6 5     5   8039 use Math::BigInt;
  5         153872  
  5         28  
7              
8 5     5   129841 use integer;
  5         13  
  5         24  
9 5     5   131 use warnings;
  5         12  
  5         173  
10 5     5   29 use strict;
  5         13  
  5         814  
11              
12             sub new {
13 10     10 0 4142 my @args = @_;
14 10         33 my $class = shift @args;
15 10         26 my $self = {};
16 10         25 bless($self,$class);
17              
18 10 50       39 croak("Odd number of arguments") if @args%2;
19 10         30 my %args = @args;
20 10   100     55 my $layout = delete $args{layout} || 'qwerty';
21 10 50       74 croak("Unsupported layout $layout")
22             unless $layout =~ /^(?:qwerty|dvorak)\z/;
23              
24 10 50       35 croak "Unknown options: " . join ", ", keys(%args) if keys %args;
25              
26             # all measures in 100ths of a cm
27              
28 10         18 my $depress_distance = 25;
29 10         18 my $shift_distance = 200;
30              
31             # horizontal distances
32              
33 10         94 $self->{k} = {};
34              
35 5     5   36 no warnings 'qw';
  5         10  
  5         4543  
36 10         29 map { $self->{k}->{$_} = 550 } ( '\\', '|' );
  20         67  
37 10         45 map { $self->{k}->{$_} = 500 } ( qw/6 ^ ` ~/ );
  40         85  
38 10         23 map { $self->{k}->{$_} = 450 } ( qw/= +/ );
  20         52  
39 10         28 map { $self->{k}->{$_} = 400 } ( qw/] 1 2 3 4 7 8 9 0 5 - _ ! @ # $ % & * ( ) }/ );
  220         439  
40 10         20 map { $self->{k}->{$_} = 350 } ( qw/B b/ );
  20         58  
41 10         21 map { $self->{k}->{$_} = 230 } ( qw/[ {/ );
  20         45  
42 10         36 map { $self->{k}->{$_} = 200 } ( qw/Q q W w G g H h E e R r T t Y y U u I i O o P p Z z X x C c V v N n M m , < > . \/ ? ' "/ );
  440         903  
43 10         28 map { $self->{k}->{$_} = 0 } ( qw/A a S s D d F f J j K k L l ; :/ );
  160         334  
44              
45 10 100       39 if ($layout eq 'dvorak') {
46 1         3 map { $self->{k}->{$_} = 550 } ( '\\', '|' );
  2         7  
47 1         4 map { $self->{k}->{$_} = 500 } ( qw/6 ^ ` ~/ );
  4         9  
48 1         1 map { $self->{k}->{$_} = 450 } ( qw/] }/ );
  2         5  
49 1         3 map { $self->{k}->{$_} = 400 } ( qw/+ = 1 2 3 4 7 8 9 0 5 [ { ! @ # $ % & * ( )/ );
  22         34  
50 1         2 map { $self->{k}->{$_} = 350 } ( qw/X x/ );
  2         4  
51 1         10 map { $self->{k}->{$_} = 230 } ( qw/? \// );
  2         5  
52 1         6 map { $self->{k}->{$_} = 200 } ( qw/" ' < , I i D d > . P p Y y F f G g C c R r L l : ; Q q J j K k B b M m W w V v Z z - _/ );
  44         67  
53 1         4 map { $self->{k}->{$_} = 0 } ( qw/A a O o E e U u H h T t N n S s/ );
  16         24  
54             }
55              
56 10         25 $self->{k}->{"\n"} = 400;
57 10         23 $self->{k}->{"\t"} = 230;
58 10         20 $self->{k}->{' '} = 0;
59              
60             # Add the depress distance
61 10         17 for my $key ( keys %{$self->{k}} ) {
  10         185  
62 970         1396 $self->{k}->{$key} += $depress_distance;
63             }
64              
65             # Add shift distance
66 10         68 for my $key ( qw/! @ # $ % ^ & * ( ) _ + < > ? : " { } | ~ '/, 'A' .. 'Z' ) {
67 480         804 $self->{k}->{$key} += $shift_distance;
68             }
69              
70             # override
71 10         26 $self->{k}->{"\a"} = 0; # alarm
72 10         23 $self->{k}->{"\b"} = 0; # backspace
73 10         23 $self->{k}->{"\e"} = 0; # escape
74 10         23 $self->{k}->{"\f"} = 0; # form feed
75 10         24 $self->{k}->{"\r"} = 0; # carriage return
76              
77 10         90 return $self;
78             }
79              
80             # split is 2m27.476s for 9.3megs of text (9754400 chars)
81             sub distance {
82 8     8 0 102 my $k = shift->{k};
83              
84 8         55 my $bint = Math::BigInt->bzero;
85 8         355 my $int = 0;
86              
87 8         39 for my $i (0 .. $#_) {
88 8 50       26 croak "FAR OUT! A REFERENCE: $_[$i]" if ref $_[$i];
89              
90 8         41764 for ( split '', $_[$i] ) {
91 195467 50       337763 unless ( defined $k->{$_} ) {
92 0         0 carp 'WHOAH! I DON\'T KNOW WHAT THIS IS: [' . sprintf('%2.2x',ord($_)) . " : $_] assigning it a 2.5 cm distance\n";
93              
94 0         0 $k->{$_} = 250;
95             }
96              
97 195467         257632 $int += $k->{$_};
98              
99             # Hold the value in a native int until it reaches an unsafe limit.
100             # Then add to the BigInt, this avoids repeated slow calls to badd.
101             #
102             # To play it safe, this value is the max signed 32bit int minus
103             # the max distance a key can be (| - 550), i.e.
104             # 2 ** 31 - 551 = 2_147_483_097
105 195467 50       348070 if ( $int >= 2_147_483_097 ) {
106 0         0 $bint->badd($int);
107              
108 0         0 $int = 0;
109             }
110             }
111             }
112              
113             # Add whatever remaining value we have in the native int.
114 8         65 $bint->badd($int);
115              
116 8         1777 $bint->bdiv(100);
117              
118 8         1745 return $bint->bstr;
119             }
120              
121             # substr is 2m30.419s
122             #sub distance {
123             # my $self = shift @_;
124             # my $distance = Math::BigInt->bzero();
125             # for my $i (0 .. $#_) {
126             # croak "FAR OUT! A REFERENCE: $_[$i]" if ref $_[$i];
127             # my $length = length($_[$i]) - 1;
128             # for my $s ( 0 .. $length ) {
129             # my $char = substr($_[$i],$s,1);
130             # unless ( defined $self->{k}->{$char} ) {
131             # carp "WHOAH! I DON'T KNOW WHAT THIS IS: [$char] at $s assigning it a 2.5 cm distance\n";
132             # $self->{k}->{$char} = 250;
133             # }
134             # $distance += $self->{k}->{$char};
135             # }
136             # }
137             # $distance /= 100;
138             # return $distance->bstr();
139             #}
140              
141             # Regex is 2m32.690s
142             #sub distance {
143             # my $self = shift @_;
144             # my $distance = Math::BigInt->bzero();
145             # for my $i (0 .. $#_) {
146             # croak "FAR OUT! A REFERENCE: $_[$i]" if ref $_[$i];
147             # while ( $_[$i] =~ /(.)/gs ) {
148             # my $char = $1;
149             # unless ( defined $self->{k}->{$char} ) {
150             # carp "WHOAH! I DON'T KNOW WHAT THIS IS: [$char] assigning it a 2.5 cm distance\n";
151             # $self->{k}->{$char} = 250;
152             # }
153             # $distance += $self->{k}->{$char};
154             # }
155             # }
156             # $distance /= 100;
157             # return $distance->bstr();
158             #}
159              
160              
161             1;
162             __END__