--- Galaksija.pm 2007/08/04 20:34:59 130 +++ Galaksija.pm 2007/09/29 12:07:12 178 @@ -6,9 +6,11 @@ use Carp qw/confess/; use File::Slurp; use Data::Dump qw/dump/; -use Z80 qw'@mem'; +use Z80; +use Screen; +use Time::HiRes qw/time/; -use base qw(Class::Accessor VRac Z80 Screen Prefs); +use base qw(Class::Accessor VRac Z80 Screen Prefs Session); __PACKAGE__->mk_accessors(qw(booted)); =head1 NAME @@ -17,11 +19,11 @@ =head1 VERSION -Version 0.00 +Version 0.01 =cut -our $VERSION = '0.00'; +our $VERSION = '0.01'; =head1 SUMMARY @@ -39,16 +41,17 @@ sub run { my $self = shift; - warn "Galaksija calling upstream init\n"; + + warn "Galaksija $Galaksija::VERSION emulation starting\n"; + + $self->show_mem( 1 ); + #$self->trace( 1 ); + $self->SUPER::init( read => sub { $self->read( @_ ) }, write => sub { $self->write( @_ ) }, ); - warn "Galaksija $Galaksija::VERSION emulation starting\n"; - - warn "emulating ", $#mem, " bytes of memory\n"; - for my $a ( 0x1000 .. 0x2000 ) { $mem[$a] = 0xff; } @@ -56,7 +59,7 @@ $self->open_screen; $self->load_rom({ 0x0000, 'rom/Galaksija/ROM1.BIN', - 0x2000, 'rom/Galaksija/ROM2.BIN', + 0x1000, 'rom/Galaksija/ROM2.BIN', # 0xE000, 'rom/Galaksija/GAL_PLUS.BIN', }); @@ -64,7 +67,7 @@ $mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 ); # display - $mem[$_] = ' ' foreach ( 0x2800 .. 0x2a00 ); + $mem[$_] = 0x20 foreach ( 0x2800 .. 0x2a00 ); # 6116-ice $mem[$_] = 0 foreach ( 0x2a00 .. 0x4000 ); @@ -75,8 +78,8 @@ $self->trace( 0 ); $self->debug( 0 ); - warn "rendering video memory\n"; - #$self->render_vram( @mem[ 0x2800 .. 0x2a00 ] ); + warn "rendering memory\n"; + $self->render_mem( @mem ); #$self->sync; $self->trace( $trace ); @@ -89,9 +92,16 @@ Z80::reset(); + my $hor_pos = 0; + $self->loop( sub { - Z80::exec( $_[0] ); - #$self->render_vram; + my $run_for = shift; + Z80::exec( $run_for ); + if ( $hor_pos != $mem[ 0x2ba8 ] ) { + warn "scroll 0x2ba8", $self->hexdump( 0x2ba8 ); + $hor_pos = $mem[ 0x2ba8 ]; + } + $self->render_vram; }); } @@ -99,9 +109,6 @@ =head1 Memory management -Galaksija implements all I/O using mmap addresses. This was main reason why -L was just too slow to handle it. - =cut =head2 read @@ -112,10 +119,6 @@ =cut -my $keyboard_none = 255; - -my $keyboard = {}; - sub read { my $self = shift; my ($addr) = @_; @@ -123,6 +126,7 @@ confess sprintf("can't find memory at address %04x",$addr) unless defined($byte); warn sprintf("# Galaksija::read(%04x) = %02x\n", $addr, $byte) if $self->trace; + $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem; return $byte; } @@ -139,20 +143,184 @@ my ($addr,$byte) = @_; warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace; + return if ( $addr > 0x4000 ); + + $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem; $mem[$addr] = $byte; return; } +=head1 Architecture specific + +=cut + +my @keymap = ( + 'a' .. 'z', + qw/up down left right space/, + '0' .. '9', + ':', '"', ',', '=', '.', '/', 'return', 'tab', + 'left alt', 'backspace', 'scroll lock', 'left shift' +); + +my $remap; +my $o = 1; + +foreach my $key ( @keymap ) { + $remap->{$key} = $o; + $o++; +} + +=head2 key_down + +=cut + +sub key_down { + my ( $self, $key ) = @_; + warn "registered key down: $key ", $remap->{$key}; + $self->write( 0x2000 + $remap->{$key}, 0xfe ); +} + +=head2 key_up + +=cut + +sub key_up { + my ( $self, $key ) = @_; + warn "registred key up: $key ", $remap->{$key}; + $self->write( 0x2000 + $remap->{$key}, 0xff ); +} + +=head2 render_vram + +Render characters as graphic + +=cut + +my $char_rom = 'rom/Galaksija/CHRGEN.BIN'; + +my @chars = map { ord($_) } split(//, read_file( $char_rom )); +warn "loaded ", $#chars, " characters\n"; + +my @char2pos; + +# maken from mess/video/galaxy.c +foreach my $char ( 0 .. 255 ) { + my $c = $char; + if ( ( $c > 63 && $c < 96 ) || ( $c > 127 && $c < 192 ) ) { + $c -= 64; + } elsif ( $c > 191 ) { + $c -= 128; + } + $char2pos[ $char ] = ( $c & 0x7f ); +} + +warn dump( @char2pos ); + +sub render_vram { + my $self = shift; + + my $t = time(); + + my $addr = 0x2800; + + my @pixels = ("\x00") x ( 32 * 16 * 13 ); + my $a = 0; + + for my $y ( 0 .. 15 ) { + for my $x ( 0 .. 31 ) { + my $c = $mem[ $addr++ ]; + $c = $char2pos[ $c ]; + for my $l ( 0 .. 12 ) { + my $o = $l << 5; # *32 + my $co = ( $l << 7 ) | $c; + $pixels[ $a + $x + $o ] = $flip[ $chars[ $co ] ]; + } + } + $a += ( 32 * 13 ); # next line + } + + my $vram = SDL::Surface->new( + -width => 256, + -height => 256, + -depth => 1, # 1 bit per pixel + -pitch => 32, # bytes per line + -from => pack("C*", @pixels), + ); + $vram->set_colors( 0, $white, $black ); + + $self->render_frame( $vram ); + +# $self->render_vram_text; + + printf("frame in %.2fs\n", time()-$t); +} + + +=head2 render_vram_text + +Simple hex dumper of text buffer + +=cut + +my $last_dump = ''; + +sub render_vram_text { + my $self = shift; + + my $addr = 0x2800; + + my $dump; + + for my $y ( 0 .. 15 ) { +# $dump .= sprintf "%2d: %s\n",$y, join('', map { sprintf("%02x ",$_) } @mem[ $addr .. $addr+31 ] ); + $dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr .. $addr+31 ] ); + $addr += 32; + } + + if ( $mem[ 0x2bb0 ] ) { + warn "scroll", $self->hexdump( 0x2bb0 ); + } + + if ( $dump ne $last_dump ) { + print $dump; + $last_dump = $dump; + } +} + +=head2 cpu_PC + +Helper metod to set or get PC for current architecture + +=cut + +sub cpu_PC { + my ( $self, $addr ) = @_; + if ( defined($addr) ) { + $PC = $addr; + warn sprintf("running from PC %04x\n", $PC); + }; + return $PC; +} + +=head1 SEE ALSO + +L, L, L + =head1 AUTHOR Dobrica Pavlinusic, C<< >> =head1 BUGS +Galaksija Plus isn't emulated. I don't have additional rom, but I would +B to have support for this machine. So if you have ROM for Galaksija +Plus, get in touch! + =head1 ACKNOWLEDGEMENTS -See also L<> which is source of all -info about this machine (and even hardware implementation from 2007). +Based on Galaxy emulator L for Windows which +is in turn based on DOS version by Miodrag Jevremoviæ +L. =head1 COPYRIGHT & LICENSE