| 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__ |