/[VRac]/Orao.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /Orao.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 103 by dpavlin, Thu Aug 2 18:01:51 2007 UTC revision 105 by dpavlin, Thu Aug 2 21:55:06 2007 UTC
# Line 8  use lib './lib'; Line 8  use lib './lib';
8  #use Time::HiRes qw(time);  #use Time::HiRes qw(time);
9  use File::Slurp;  use File::Slurp;
10  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
 use List::Util qw/first/;  
11  use M6502;  use M6502;
12    
13  use base qw(Class::Accessor M6502 Screen Prefs);  use base qw(Class::Accessor M6502 Screen Prefs);
# Line 32  Emulator or Orao 8-bit 6502 machine popu Line 31  Emulator or Orao 8-bit 6502 machine popu
31    
32  =cut  =cut
33    
 my @kbd_ports = (  
     0x87FC,0x87FD,0x87FA,0x87FB,0x87F6,0x87F7,  
     0x87EE,0x87EF,0x87DE,0x87DF,0x87BE,0x87BF,  
     0x877E,0x877F,0x86FE,0x86FF,0x85FE,0x85FF,  
     0x83FE,0x83FF,  
 );  
   
34  =head1 FUNCTIONS  =head1 FUNCTIONS
35    
36  =head2 boot  =head2 boot
# Line 307  Read from memory Line 299  Read from memory
299    
300  =cut  =cut
301    
302    my $keyboard_none = 255;
303    
304  my $keyboard = {  my $keyboard = {
305          0x87FC => {          0x87FC => {
306                  'right'         => 16,                  'right'         => 16,
# Line 319  my $keyboard = { Line 313  my $keyboard = {
313                  my ( $self, $key ) = @_;                  my ( $self, $key ) = @_;
314                  if ( $key eq 'return' ) {                  if ( $key eq 'return' ) {
315                          M6502::_write( 0xfc, 13 );                          M6502::_write( 0xfc, 13 );
316                            warn "return\n";
317                          return 0;                          return 0;
318                  } elsif ( $self->key_down( 'left ctrl' ) || $self->key_down( 'right ctrl' ) ) {                  } elsif ( $key =~ m/ ctrl/ || $self->key_down( 'left ctrl' ) || $self->key_down( 'right ctrl' ) ) {
319                            warn "ctrl\n";
320                          return 16;                          return 16;
321                  }                  }
322                    return $keyboard_none;
323          },          },
324          0x87FA => {          0x87FA => {
325                  'f4' => 16,                  'f4' => 16,
# Line 335  my $keyboard = { Line 332  my $keyboard = {
332                  if ( $key eq 'space' ) {                  if ( $key eq 'space' ) {
333                          return 32;                          return 32;
334                  } elsif ( $self->key_down( 'left shift' ) || $self->key_down( 'right shift' ) ) {                  } elsif ( $self->key_down( 'left shift' ) || $self->key_down( 'right shift' ) ) {
335                            warn "shift\n";
336                          return 16;                          return 16;
337                  }                  }
338                    return $keyboard_none;
339          },          },
340          0x87F6 => {          0x87F6 => {
341                  '6' => 16,                  '6' => 16,
342                  't' => 128,                  't' => 128,
343                  'z' => 192,                  'y' => 192,     # hr: z
344                  'r' => 224,                  'r' => 224,
345          },          },
346          0x87F7 => {          0x87F7 => {
# Line 375  my $keyboard = { Line 374  my $keyboard = {
374                  'l' => 224,                  'l' => 224,
375          },          },
376          0x87BF => {          0x87BF => {
377                  ',' => 32,                  ',' => 32,      # <
378                  '.' => 16,                  '.' => 16,      # >
379          },          },
380          0x877E => {          0x877E => {
381                  'y' => 16,                  'z' => 16,      # hr:y
382                  's' => 128,                  's' => 128,
383                  'a' => 192,                  'a' => 192,
384                  'd' => 224,                  'd' => 224,
# Line 399  my $keyboard = { Line 398  my $keyboard = {
398                  'v' => 16,                  'v' => 16,
399          },          },
400          0x85FE => {          0x85FE => {
401                  ';' => sub { $_[0]->key_down('left shift') ? 16 : 224 },                  '<' => 16,              # :
402                  '\\' => 128,                  '\\' => 128,    # ¾
403                  '\'' => 192,                  '\'' => 192,    # æ
404  #               ';' => 224,                  ';' => 224,             # è
                 '8' => 16,      # FIXME?  
405          },          },
406          0x85FF => {          0x85FF => {
407                  '/' => 32,                  '/' => 32,
408                  '6' => 16,      # FIXME?                  'f11' => 16,    # ^
409          },          },
410          0x83FE => {          0x83FE => {
411                  ';' => 16,                  'f12' => 16,    # ;
412                  '[' => 128,                  '[' => 128,             # ¹
413                  ']' => 192,                  ']' => 192,             # ð
414                  'p' => 224,                  'p' => 224,
                 '=' => 16,      # FIXME?  
415          },          },
416          0x83FF => {          0x83FF => {
417                  '-' => 32,                  '-' => 32,
# Line 422  my $keyboard = { Line 419  my $keyboard = {
419          },          },
420  };  };
421    
 my $keyboard_none = 255;  
   
422  sub read {  sub read {
423          my $self = shift;          my $self = shift;
424          my ($addr) = @_;          my ($addr) = @_;
# Line 433  sub read { Line 428  sub read {
428    
429          # keyboard          # keyboard
430    
431          if ( first { $addr == $_ } @kbd_ports ) {          if ( defined( $keyboard->{$addr} ) ) {
432                  warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;                  warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;
433                  my $key = $self->key_pressed;                  my $key = $self->key_pressed;
434                  if ( defined($key) ) {                  if ( defined($key) ) {
# Line 441  sub read { Line 436  sub read {
436                          my $r = $keyboard->{$addr} || confess "no definition for keyboard port found";                          my $r = $keyboard->{$addr} || confess "no definition for keyboard port found";
437                          if ( ref($r) eq 'CODE' ) {                          if ( ref($r) eq 'CODE' ) {
438                                  $ret = $r->($self, $key);                                  $ret = $r->($self, $key);
439                          } elsif ( $ret = $r->{$key} ) {                          } elsif ( defined($r->{$key}) ) {
440                                    $ret = $r->{$key};
441                                  if ( ref($ret) eq 'CODE' ) {                                  if ( ref($ret) eq 'CODE' ) {
442                                          $ret = $ret->($self);                                          $ret = $ret->($self);
                                         warn "executed $key and got: $ret\n";  
                                 } else {  
                                         warn sprintf("keyboard port: %04x key: '%s' code: %02x\n", $addr, $key, $ret);  
443                                  }                                  }
                                 $mem[$addr] = $ret;  
                                 warn "keypress: $key = $ret\n";  
                                 return $ret;  
444                          } else {                          } else {
445                                  warn sprintf("keyboard port: %04x unknown key: '%s'\n", $addr, $key) if $debug;                                  warn sprintf("keyboard port: %04x unknown key: '%s'\n", $addr, $key) if $debug;
446                          }                          }
447                          warn sprintf("keyboard port: %04x %s\n",$addr,dump( $r )) if $self->trace;                          warn sprintf("keyboard port: %04x key:%s code:%d\n",$addr,$key,$ret) if ( $ret != $keyboard_none );
448                            return $ret;
449                  }                  }
450                  return $keyboard_none;                  return $keyboard_none;
451          }          }

Legend:
Removed from v.103  
changed lines
  Added in v.105

  ViewVC Help
Powered by ViewVC 1.1.26