--- M6502/Orao.pm 2007/08/02 13:58:26 96 +++ M6502/Orao.pm 2007/08/03 10:29:33 109 @@ -8,10 +8,9 @@ #use Time::HiRes qw(time); use File::Slurp; use Data::Dump qw/dump/; -use List::Util qw/first/; use M6502; -use base qw(Class::Accessor M6502 Screen Prefs); +use base qw(Class::Accessor M6502 Screen Prefs Tape); __PACKAGE__->mk_accessors(qw(booted)); =head1 NAME @@ -32,13 +31,6 @@ =cut -my @kbd_ports = ( - 0x87FC,0x87FD,0x87FA,0x87FB,0x87F6,0x87F7, - 0x87EE,0x87EF,0x87DE,0x87DF,0x87BE,0x87BF, - 0x877E,0x877F,0x86FE,0x86FF,0x85FE,0x85FF, - 0x83FE,0x83FF, -); - =head1 FUNCTIONS =head2 boot @@ -71,8 +63,10 @@ 0x1000 => 'dump/SCRINV.BIN', # should be 0x6000, but oraoemu has 2 byte prefix 0x5FFE => 'dump/screen.dmp', - 0xC000 => 'rom/BAS12.ROM', - 0xE000 => 'rom/CRT12.ROM', +# 0xC000 => 'rom/BAS12.ROM', +# 0xE000 => 'rom/CRT12.ROM', + 0xC000 => 'rom/BAS13.ROM', + 0xE000 => 'rom/CRT13.ROM', }); # $PC = 0xDD11; # BC @@ -88,7 +82,8 @@ $self->trace( 0 ); $self->debug( 0 ); - $self->render( @mem[ 0x6000 .. 0x7fff ] ); + warn "rendering video memory\n"; + $self->render_vram( @mem[ 0x6000 .. 0x7fff ] ); if ( $self->show_mem ) { @@ -107,11 +102,6 @@ 0xE000, 0xFFFF, 'sistemski ROM', ); - } else { - - warn "rendering video memory\n"; - $self->render( @mem[ 0x6000 .. 0x7fff ] ); - } $self->sync; $self->trace( $trace ); @@ -182,10 +172,7 @@ $t = $end if ( $end < $t ); warn sprintf("refresh video ram %04x-%04x\n", $f, $t); -# foreach my $a ( $f .. $t ) { -# $self->vram( $a - 0x6000 , $mem[ $a ] ); -# } - $self->render( @mem[ 0x6000 .. 0x7fff ] ); + $self->render_vram( @mem[ 0x6000 .. 0x7fff ] ); $self->render_mem( @mem ) if $self->show_mem; } @@ -305,6 +292,126 @@ =cut +my $keyboard_none = 255; + +my $keyboard = { + 0x87FC => { + 'right' => 16, + 'down' => 128, + 'up' => 192, + 'left' => 224, + 'backspace' => 224, + }, + 0x87FD => sub { + my ( $self, $key ) = @_; + if ( $key eq 'return' ) { + M6502::_write( 0xfc, 13 ); + warn "return\n"; + return 0; + } elsif ( $key =~ m/ ctrl/ || $self->key_down( 'left ctrl' ) || $self->key_down( 'right ctrl' ) ) { + warn "ctrl\n"; + return 16; + } + return $keyboard_none; + }, + 0x87FA => { + 'f4' => 16, + 'f3' => 128, + 'f2' => 192, + 'f1' => 224, + }, + 0x87FB => sub { + my ( $self, $key ) = @_; + if ( $key eq 'space' ) { + return 32; + } elsif ( $self->key_down( 'left shift' ) || $self->key_down( 'right shift' ) ) { + warn "shift\n"; + return 16; + } + return $keyboard_none; + }, + 0x87F6 => { + '6' => 16, + 't' => 128, + 'y' => 192, # hr: z + 'r' => 224, + }, + 0x87F7 => { + '5' => 32, + '4' => 16, + }, + 0x87EE => { + '7' => 16, + 'u' => 128, + 'i' => 192, + 'o' => 224, + }, + 0x87EF => { + '8' => 32, + '9' => 16, + }, + 0x87DE => { + '1' => 16, + 'w' => 128, + 'q' => 192, + 'e' => 224, + }, + 0x87DF => { + '2' => 32, + '3' => 16, + }, + 0x87BE => { + 'm' => 16, + 'k' => 128, + 'j' => 192, + 'l' => 224, + }, + 0x87BF => { + ',' => 32, # < + '.' => 16, # > + }, + 0x877E => { + 'z' => 16, # hr:y + 's' => 128, + 'a' => 192, + 'd' => 224, + }, + 0x877F => { + 'x' => 32, + 'c' => 16, + }, + 0x86FE => { + 'n' => 16, + 'g' => 128, + 'h' => 192, + 'f' => 224, + }, + 0x86FF => { + 'b' => 32, + 'v' => 16, + }, + 0x85FE => { + '<' => 16, # : + '\\' => 128, # ¾ + '\'' => 192, # æ + ';' => 224, # è + }, + 0x85FF => { + '/' => 32, + 'f11' => 16, # ^ + }, + 0x83FE => { + 'f12' => 16, # ; + '[' => 128, # ¹ + ']' => 192, # ð + 'p' => 224, + }, + 0x83FF => { + '-' => 32, + '0' => 16, + }, +}; + sub read { my $self = shift; my ($addr) = @_; @@ -314,53 +421,30 @@ # keyboard - if ( first { $addr == $_ } @kbd_ports ) { - warn sprintf("keyboard port: %04x\n",$addr); - } elsif ( $addr == 0x87fc ) { - warn "0x87fc - arrows/back\n"; -=for pascal - if VKey=VK_RIGHT then Result:=16; - if VKey=VK_DOWN then Result:=128; - if VKey=VK_UP then Result:=192; - if VKey=VK_LEFT then Result:=224; - if Ord(KeyPressed)=VK_BACK then Result:=224; -=cut - } elsif ( $addr == 0x87fd ) { - warn "0x87fd - enter\n"; -=for pascal - if KeyPressed=Chr(13) then begin - Mem[$FC]:=13; - Result:=0; - end; -=cut - } elsif ( $addr == 0x87fa ) { - warn "0x87fa = F1 - F4\n"; -=for pascal - if VKey=VK_F4 then Result:=16; - if VKey=VK_F3 then Result:=128; - if VKey=VK_F2 then Result:=192; - if VKey=VK_F1 then Result:=224; -=cut - } elsif ( $addr == 0x87fb ) { - warn "0x87fb\n"; -=for pascal - if KeyPressed=Chr(32) then Result:=32; - if KeyPressed='"' then Result:=16; - if KeyPressed='!' then Result:=16; - if KeyPressed='$' then Result:=16; - if KeyPressed='%' then Result:=16; - if KeyPressed='&' then Result:=16; - if KeyPressed='(' then Result:=16; - if KeyPressed=')' then Result:=16; - if KeyPressed='=' then Result:=16; - if KeyPressed='#' then Result:=16; - if KeyPressed='+' then Result:=16; - if KeyPressed='*' then Result:=16; - if KeyPressed='?' then Result:=16; - if KeyPressed='<' then Result:=16; - if KeyPressed='>' then Result:=16; - if VKey=191 then Result:=16; -=cut + if ( defined( $keyboard->{$addr} ) ) { + warn sprintf("keyboard port: %04x\n",$addr) if $self->trace; + my $key = $self->key_pressed; + if ( defined($key) ) { + my $ret = $keyboard_none; + my $r = $keyboard->{$addr} || confess "no definition for keyboard port found"; + if ( ref($r) eq 'CODE' ) { + $ret = $r->($self, $key); + } elsif ( defined($r->{$key}) ) { + $ret = $r->{$key}; + if ( ref($ret) eq 'CODE' ) { + $ret = $ret->($self); + } + } else { + warn sprintf("keyboard port: %04x unknown key: '%s'\n", $addr, $key) if $debug; + } + warn sprintf("keyboard port: %04x key:%s code:%d\n",$addr,$key,$ret) if ( $ret != $keyboard_none ); + return $ret; + } + return $keyboard_none; + } + + if ( $addr == 0x87ff ) { + return $self->read_tape; } $self->mmap_pixel( $addr, 0, $byte, 0 ); @@ -380,10 +464,6 @@ my ($addr,$byte) = @_; warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace; - if ( $addr >= 0x6000 && $addr < 0x8000 ) { - $self->vram( $addr - 0x6000 , $byte ); - } - if ( $addr == 0x8800 ) { warn sprintf "sound ignored: %x\n", $byte; } @@ -415,7 +495,7 @@ my $self = shift; $self->app->sync; my $a = shift; - print STDERR $self->hexdump( $a ), + print $self->hexdump( $a ), $last ? "[$last] " : '', "> "; my $in = ; @@ -464,6 +544,7 @@ __USAGE__ warn $self->dump_R; + $last = ''; } elsif ( $c =~ m/^e/i ) { $a = $v if defined($v); my $to = shift @v; @@ -502,7 +583,7 @@ print "run_for $run_for instructions\n"; $show_R = 1; last; - } elsif ( $c =~ m/^(u|j)/ ) { + } elsif ( $c =~ m/^(u|j)/i ) { my $to = $v || $a; printf "set pc to %04x\n", $to; $PC = $to; # remember for restart @@ -510,11 +591,20 @@ $last = "r $run_for"; $show_R = 1; last; - } elsif ( $c =~ m/^t/ ) { + } elsif ( $c =~ m/^tape/ ) { + if ( ! $v ) { + warn "ERROR: please specify tape name!\n"; + } elsif ( ! -e $v ) { + warn "ERROR: tape $v: $!\n"; + } else { + $self->load_tape( $v ); + } + $last = ''; + } elsif ( $c =~ m/^t/i ) { $self->trace( not $self->trace ); print "trace ", $self->trace ? 'on' : 'off', "\n"; $last = ''; - } elsif ( $c =~ m/^d/ ) { + } elsif ( $c =~ m/^d/i ) { $self->debug( not $self->debug ); print "debug ", $self->debug ? 'on' : 'off', "\n"; $last = '';