315 |
'left' => 224, |
'left' => 224, |
316 |
'backspace' => 224, |
'backspace' => 224, |
317 |
}, |
}, |
318 |
0x87FD => { |
0x87FD => sub { |
319 |
'return' => sub { |
my ( $self, $key ) = @_; |
320 |
M6502::write( 0xfc, 13 ); |
if ( $key eq 'return' ) { |
321 |
|
M6502::_write( 0xfc, 13 ); |
322 |
return 0; |
return 0; |
323 |
}, |
} elsif ( $self->key_down( 'left ctrl' ) || $self->key_down( 'right ctrl' ) ) { |
324 |
'left ctrl' => 16, |
return 16; |
325 |
'right ctrl' => 16, |
} |
326 |
}, |
}, |
327 |
0x87FA => { |
0x87FA => { |
328 |
'f4' => 16, |
'f4' => 16, |
330 |
'f2' => 192, |
'f2' => 192, |
331 |
'f1' => 224, |
'f1' => 224, |
332 |
}, |
}, |
333 |
0x87FB => { |
0x87FB => sub { |
334 |
'space' => 32, |
my ( $self, $key ) = @_; |
335 |
'left shift' => 16, |
if ( $key eq 'space' ) { |
336 |
'right shift' => 16, |
return 32; |
337 |
|
} elsif ( $self->key_down( 'left shift' ) || $self->key_down( 'right shift' ) ) { |
338 |
|
return 16; |
339 |
|
} |
340 |
}, |
}, |
341 |
0x87F6 => { |
0x87F6 => { |
342 |
'6' => 16, |
'6' => 16, |
396 |
}, |
}, |
397 |
0x86FF => { |
0x86FF => { |
398 |
'b' => 32, |
'b' => 32, |
399 |
'c' => 16, |
'v' => 16, |
400 |
}, |
}, |
401 |
0x85FE => { |
0x85FE => { |
402 |
':' => 16, |
';' => sub { $_[0]->key_down('left shift') ? 16 : 224 }, |
403 |
'\\' => 128, |
'\\' => 128, |
404 |
'\'' => 192, |
'\'' => 192, |
405 |
';' => 224, |
# ';' => 224, |
406 |
'8' => 16, # FIXME? |
'8' => 16, # FIXME? |
407 |
}, |
}, |
408 |
0x85FF => { |
0x85FF => { |
422 |
}, |
}, |
423 |
}; |
}; |
424 |
|
|
425 |
|
my $keyboard_none = 255; |
426 |
|
|
427 |
sub read { |
sub read { |
428 |
my $self = shift; |
my $self = shift; |
437 |
warn sprintf("keyboard port: %04x\n",$addr) if $self->trace; |
warn sprintf("keyboard port: %04x\n",$addr) if $self->trace; |
438 |
my $key = $self->key_pressed; |
my $key = $self->key_pressed; |
439 |
if ( defined($key) ) { |
if ( defined($key) ) { |
440 |
|
my $ret = $keyboard_none; |
441 |
my $r = $keyboard->{$addr} || confess "no definition for keyboard port found"; |
my $r = $keyboard->{$addr} || confess "no definition for keyboard port found"; |
442 |
if ( my $ret = $r->{$key} ) { |
if ( ref($r) eq 'CODE' ) { |
443 |
|
$ret = $r->($self, $key); |
444 |
|
} elsif ( $ret = $r->{$key} ) { |
445 |
if ( ref($ret) eq 'CODE' ) { |
if ( ref($ret) eq 'CODE' ) { |
446 |
$ret = $ret->(); |
$ret = $ret->($self); |
447 |
warn "executed $key and got: $ret\n"; |
warn "executed $key and got: $ret\n"; |
448 |
} else { |
} else { |
449 |
warn sprintf("keyboard port: %04x key: '%s' code: %02x\n", $addr, $key, $ret); |
warn sprintf("keyboard port: %04x key: '%s' code: %02x\n", $addr, $key, $ret); |
450 |
} |
} |
451 |
$mem[$addr] = $ret; |
$mem[$addr] = $ret; |
452 |
|
warn "keypress: $key = $ret\n"; |
453 |
return $ret; |
return $ret; |
454 |
} else { |
} else { |
455 |
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; |
456 |
} |
} |
457 |
warn sprintf("keyboard port: %04x %s\n",$addr,dump( $r )) if $self->trace; |
warn sprintf("keyboard port: %04x %s\n",$addr,dump( $r )) if $self->trace; |
458 |
} |
} |
459 |
|
return $keyboard_none; |
460 |
} |
} |
461 |
|
|
462 |
$self->mmap_pixel( $addr, 0, $byte, 0 ); |
$self->mmap_pixel( $addr, 0, $byte, 0 ); |