--- Screen.pm 2007/08/05 19:44:20 161 +++ Screen.pm 2007/08/06 11:40:21 171 @@ -14,7 +14,7 @@ use Data::Dump qw/dump/; use Exporter 'import'; -our @EXPORT = qw'$white $black'; +our @EXPORT = qw'$white $black @flip'; use base qw(Class::Accessor Prefs); __PACKAGE__->mk_accessors(qw(app event)); @@ -245,6 +245,7 @@ =cut my $pending_key; +my $key_active; my $run_for = 2000; sub key_pressed { @@ -262,9 +263,11 @@ if ( $state ) { $pending_key = $key; $self->key_down( $key ); + $key_active->{$key} = 1; } else { undef $pending_key; $self->key_up( $key ); + $key_active->{$key} = 0; } } return $pending_key; @@ -286,12 +289,14 @@ warn "SDL_KEYDOWN ($type) = '$k'", $just_checking ? ' fake' : '', "\n"; $pending_key = $k; $self->key_down( $k ); + $key_active->{$k} = 1; $self->record_session('key_pressed', { $k => 1 }); } } elsif ( $type == SDL_KEYUP ) { my $up = $event->key_name(); warn "SDL_KEYUP ($type) = '$up'", $just_checking ? ' fake' : '', "\n"; $self->key_up( $up ); + $key_active->{$up} = 0; $self->record_session('key_pressed', { $up => 0 }); undef $pending_key; } @@ -301,6 +306,28 @@ return $pending_key; } +=head2 key_active + +Is key currently pressed on keyboard or in session? + + $self->key_active( 'left shift', 'right shift', 'a' ); + +=cut + +sub key_active { + my $self = shift; + my @keys = @_; + confess "Regexp is no longer supported" if ref($_[0]) eq 'Regexp'; + + my $active = 0; + foreach my $key ( @keys ) { + $active++ if $key_active->{$key}; + } + + warn "## key_active(",dump(@keys),") = $active\n" if $active; + return $active; +} + =head2 loop Implement CPU run for C<$run_run> cycles inside SDL event loop @@ -326,6 +353,23 @@ } } +# helper array to flip bytes for display +our @flip; + +foreach my $i ( 0 .. 255 ) { + my $t = 0; + $i & 0b00000001 and $t = $t | 0b10000000; + $i & 0b00000010 and $t = $t | 0b01000000; + $i & 0b00000100 and $t = $t | 0b00100000; + $i & 0b00001000 and $t = $t | 0b00010000; + $i & 0b00010000 and $t = $t | 0b00001000; + $i & 0b00100000 and $t = $t | 0b00000100; + $i & 0b01000000 and $t = $t | 0b00000010; + $i & 0b10000000 and $t = $t | 0b00000001; + #warn "$i = $t\n"; + $flip[$i] = $t; +} + =head1 SEE ALSO L is sample implementation using this module