package Galaksija;
use warnings;
use strict;
use Carp qw/confess/;
use File::Slurp;
use Data::Dump qw/dump/;
use Z80;
use Screen;
use Time::HiRes qw/time/;
use base qw(Class::Accessor VRac Z80 Screen Prefs Session);
__PACKAGE__->mk_accessors(qw(booted));
=head1 NAME
Galaksija - Galaksija emulator
=head1 VERSION
Version 0.01
=cut
our $VERSION = '0.01';
=head1 SUMMARY
Emulator of Galaksija 8-bit Z80 machine popular in former Yugoslavia
=cut
=head1 FUNCTIONS
=head2 run
=cut
our $emu;
sub run {
my $self = shift;
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( @_ ) },
);
for my $a ( 0x1000 .. 0x2000 ) {
$mem[$a] = 0xff;
}
$self->open_screen;
$self->load_rom({
0x0000, 'rom/Galaksija/ROM1.BIN',
0x1000, 'rom/Galaksija/ROM2.BIN',
# 0xE000, 'rom/Galaksija/GAL_PLUS.BIN',
});
# keyboard
$mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );
# display
$mem[$_] = 0x20 foreach ( 0x2800 .. 0x2a00 );
# 6116-ice
$mem[$_] = 0 foreach ( 0x2a00 .. 0x4000 );
$emu = $self;
my ( $trace, $debug ) = ( $self->trace, $self->debug );
$self->trace( 0 );
$self->debug( 0 );
warn "rendering memory\n";
$self->render_mem( @mem );
#$self->sync;
$self->trace( $trace );
$self->debug( $debug );
warn "Galaksija boot finished",
$self->trace ? ' trace' : '',
$self->debug ? ' debug' : '',
"\n";
Z80::reset();
my $hor_pos = 0;
$self->loop( sub {
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;
});
}
=head1 Memory management
=cut
=head2 read
Read from memory
$byte = read( $address );
=cut
sub read {
my $self = shift;
my ($addr) = @_;
my $byte = $mem[$addr];
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;
if ( $addr >= 0x2000 && $addr <= 0x2036 ) {
# printf("## keyread 0x%04x = %02x\n", $addr, $byte);
$self->key_pressed( 1 ); # force process of events
}
$self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
return $byte;
}
=head2 write
Write into emory
write( $address, $byte );
=cut
sub write {
my $self = shift;
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_key2addr;
my $o = 1;
foreach my $key ( @keymap ) {
$remap_key2addr->{$key} = 0x2000 + $o;
$o++;
}
printf("keymap is mmaped 0x%04x - 0x%04x\n", 0x2000, $o);
=head2 key_down
=cut
sub key_down {
my ( $self, $key ) = @_;
if ( ! defined( $remap_key2addr->{$key} ) ) {
warn "unknown key pressed: $key [ignoring]\n";
return;
}
printf("registered key down: $key address: %04x\n", $remap_key2addr->{$key} );
$self->write( $remap_key2addr->{$key}, 0xfe );
}
=head2 key_up
=cut
sub key_up {
my ( $self, $key ) = @_;
if ( ! defined( $remap_key2addr->{$key} ) ) {
warn "unknown key released: $key [ignoring]\n";
return;
}
warn "registred key up: $key ", $remap_key2addr->{$key};
$self->write( $remap_key2addr->{$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, " bytes from $char_rom\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 "## chars2pos = ",dump( @char2pos );
sub screen_width { 256 }
sub screen_height { 16 * 13 }
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 => $self->screen_width,
-height => $self->screen_height,
-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) if $self->debug;
}
=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<VRac>, L<Screen>, L<Z80>
=head1 AUTHOR
Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
=head1 BUGS
Galaksija Plus isn't emulated. I don't have additional rom, but I would
B<love> to have support for this machine. So if you have ROM for Galaksija
Plus, get in touch!
=head1 ACKNOWLEDGEMENTS
Based on Galaxy emulator L<http://emulator.galaksija.org/> for Windows which
is in turn based on DOS version by Miodrag Jevremoviæ
L<http://solair.eunet.yu/~jovkovic/galaxy/>.
=head1 COPYRIGHT & LICENSE
Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of Galaksija
RSS Feed