view release on metacpan or  search on metacpan

lib/Acme/Mobile/Therbligs.pm  view on Meta::CPAN

=cut

sub new {
  my $class = shift;
  my $self  = { };
  bless $self, $class;
  $self->_initialize(@_);
  return $self;
}

my $Default;

sub _initialize {
  my $self = shift;
  my $fh   = shift;
  my $rule = shift || { };

  $self->{SAME_KEY}         = $rule->{SAME_KEY}         || DEFAULT_SAME_KEY;
  $self->{NO_SENTENCE_CAPS} = $rule->{NO_SENTENCE_CAPS} || 0;
  $self->{NO_SHIFT_CAPS}    = $rule->{NO_SHIFT_CAPS}    || 0;

  unless (defined $Default) {
    $Default = join("", <DATA>, "\n");
  }

  my $file = (defined $fh) ? join("", <$fh>, "\n") : $Default;
  my $keys = Load($file);

  $self->{KEYPAD} = $keys;

  foreach my $key (0..9) {
    croak "Missing $key key",
      unless (exists $keys->{$key});
  }

  $self->{CHAR}   = { };

  foreach my $key (keys %$keys) {
    my $thurb = 1;
    foreach my $char (split //, $keys->{$key}) {
      $self->{CHAR}->{$char} = [$key, $thurb++];
    }
  }

  return $self;
}

my $Self;

{
  $Self = __PACKAGE__->new(undef, {
    SAME_KEY         => DEFAULT_SAME_KEY,
    NO_SENTENCE_CAPS => 0,
    NO_SHIFT_CAPS    => 0,
  });
}

=item count_therbligs

  $count = count_therbligs($message, $case_flag);

  $count = $obj->count_therbligs($message, $case_flag);

Returns the number of "therbligs" (keystrokes) used to generate the
message.  A therblig is either a keystroke, or the pause when one has
to wait in order to enter multiple letters from the same key (such as
with the word "high").

The default number of therbligs for waiting in the same key is
C<1>. There is no way to change that value for this version.

When C<$case_flag> is true, the number of therbligs includes
keystrokes to toggle the shift key.  It assumes that the first letter
of the message or a sentence is capitalized.  (If C<$case_flag> is
unspecified, it is assumed to be false.)

=cut

sub count_therbligs {
  my $self  = shift;
  my $text  = shift;
  my $case  = shift;
  my $debug = shift;                    # for diagnostics

  unless (ref($self)) {
    ($debug, $case, $text, $self) = ($case, $text, $self, $Self);
  }

  my $last  = "";                       # last character
  my $shift = 0;                        # shift flag
  my $start = $case;                    # sentence start flag
  my $thurb = 0;                        # therblig count

  foreach my $char (split //, $text) {

    if ($debug) {
      print STDERR
	"# last=$last char=$char start=$start shift=$shift thurb=$thurb\n";
    }

    unless ($self->{NO_SHIFT_CAPS}) {

      # Note: it assumes characters are lower-case rather than
      # upper-case without shifting.

      if ($char ne lc($char)) {
	if ($case) {
	  unless ($shift||$start) {
	    $shift = 1;
	    $thurb ++;
	  }
	}
	$char = lc($char);
      } elsif ($case) {
	if ((!$self->{NO_SENTENCE_CAPS}) && $start && ($char =~ /[\w]/)) { 
	  $thurb += 2;		        # 2 shifts for initial lowercase
	}
	if ($shift && ($char =~ /[\w]/)) {
	  $shift = 0;
	  $thurb ++;
	}
      }

      unless ($self->{NO_SENTENCE_CAPS}) {
	$start = 0, if ($char =~ /[\w]/);
	$start = 1, if ($char =~ /[\.\!\?]/);
      }
    }

    croak "Unknown character: $char",
      unless (exists $self->{CHAR}->{$char});
    $thurb += $self->{CHAR}->{$char}->[1];
    $thurb += $self->{SAME_KEY},
      if ($self->{CHAR}->{$char}->[0] eq ($self->{CHAR}->{$last}->[0]||""));

    $last = $char;
  }

  if ($debug) {
    print STDERR
      "# last=$last char= start=$start shift=$shift thurb=$thurb\n";
  }

  return $thurb;
}


=back

=head1 AUTHOR