viewvc.cgi/VRac/Galaksija.pm

package Galaksija;

use warnings;
use strict;

use Carp qw/confess/;
use File::Slurp;
use Data::Dump qw/dump/;
use Z80 qw'@mem';

use base qw(Class::Accessor VRac Z80 Screen Prefs);
__PACKAGE__->mk_accessors(qw(booted));

=head1 NAME

Galaksija - Galaksija emulator

=head1 VERSION

Version 0.00

=cut

our $VERSION = '0.00';

=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 calling upstream init\n";
        $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;
        }

        $self->open_screen;
        $self->load_rom({
                0x0000, 'rom/Galaksija/ROM1.BIN',
                0x2000, 'rom/Galaksija/ROM2.BIN',
#               0xE000, 'rom/Galaksija/GAL_PLUS.BIN',
        });

        # keyboard
        $mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );

        # display
        $mem[$_] = ' '  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 video memory\n";
        #$self->render_vram( @mem[ 0x2800 .. 0x2a00 ] );

        #$self->sync;
        $self->trace( $trace );
        $self->debug( $debug );

        warn "Galaksija boot finished",
                $self->trace ? ' trace' : '',
                $self->debug ? ' debug' : '',
                "\n";

        Z80::reset();

        $self->loop( sub {
                Z80::exec( $_[0] );
                #$self->render_vram;
        });

}


=head1 Memory management

Galaksija implements all I/O using mmap addresses. This was main reason why
L<Acme::6502> was just too slow to handle it.

=cut

=head2 read

Read from memory

  $byte = read( $address );

=cut

my $keyboard_none = 255;

my $keyboard = {};

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;

        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;

        $mem[$addr] = $byte;
        return;
}

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 BUGS

=head1 ACKNOWLEDGEMENTS

See also L<> which is source of all
info about this machine (and even hardware implementation from 2007).

=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
1	package Galaksija;
2
3	use warnings;
4	use strict;
5
6	use Carp qw/confess/;
7	use File::Slurp;
8	use Data::Dump qw/dump/;
9	use Z80 qw'@mem';
10
11	use base qw(Class::Accessor VRac Z80 Screen Prefs);
12	__PACKAGE__->mk_accessors(qw(booted));
13
14	=head1 NAME
15
16	Galaksija - Galaksija emulator
17
18	=head1 VERSION
19
20	Version 0.00
21
22	=cut
23
24	our $VERSION = '0.00';
25
26	=head1 SUMMARY
27
28	Emulator of Galaksija 8-bit Z80 machine popular in former Yugoslavia
29
30	=cut
31
32	=head1 FUNCTIONS
33
34	=head2 run
35
36	=cut
37
38	our $emu;
39
40	sub run {
41	my $self = shift;
42	warn "Galaksija calling upstream init\n";
43	$self->SUPER::init(
44	read => sub { $self->read( @_ ) },
45	write => sub { $self->write( @_ ) },
46	);
47
48	warn "Galaksija $Galaksija::VERSION emulation starting\n";
49
50	warn "emulating ", $#mem, " bytes of memory\n";
51
52	for my $a ( 0x1000 .. 0x2000 ) {
53	$mem[$a] = 0xff;
54	}
55
56	$self->open_screen;
57	$self->load_rom({
58	0x0000, 'rom/Galaksija/ROM1.BIN',
59	0x2000, 'rom/Galaksija/ROM2.BIN',
60	# 0xE000, 'rom/Galaksija/GAL_PLUS.BIN',
61	});
62
63	# keyboard
64	$mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );
65
66	# display
67	$mem[$_] = ' ' foreach ( 0x2800 .. 0x2a00 );
68
69	# 6116-ice
70	$mem[$_] = 0 foreach ( 0x2a00 .. 0x4000 );
71
72	$emu = $self;
73
74	my ( $trace, $debug ) = ( $self->trace, $self->debug );
75	$self->trace( 0 );
76	$self->debug( 0 );
77
78	warn "rendering video memory\n";
79	#$self->render_vram( @mem[ 0x2800 .. 0x2a00 ] );
80
81	#$self->sync;
82	$self->trace( $trace );
83	$self->debug( $debug );
84
85	warn "Galaksija boot finished",
86	$self->trace ? ' trace' : '',
87	$self->debug ? ' debug' : '',
88	"\n";
89
90	Z80::reset();
91
92	$self->loop( sub {
93	Z80::exec( $_[0] );
94	#$self->render_vram;
95	});
96
97	}
98
99
100	=head1 Memory management
101
102	Galaksija implements all I/O using mmap addresses. This was main reason why
103	L<Acme::6502> was just too slow to handle it.
104
105	=cut
106
107	=head2 read
108
109	Read from memory
110
111	$byte = read( $address );
112
113	=cut
114
115	my $keyboard_none = 255;
116
117	my $keyboard = {};
118
119	sub read {
120	my $self = shift;
121	my ($addr) = @_;
122	my $byte = $mem[$addr];
123	confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
124	warn sprintf("# Galaksija::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
125
126	return $byte;
127	}
128
129	=head2 write
130
131	Write into emory
132
133	write( $address, $byte );
134
135	=cut
136
137	sub write {
138	my $self = shift;
139	my ($addr,$byte) = @_;
140	warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
141
142	$mem[$addr] = $byte;
143	return;
144	}
145
146	=head1 AUTHOR
147
148	Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
149
150	=head1 BUGS
151
152	=head1 ACKNOWLEDGEMENTS
153
154	See also L<> which is source of all
155	info about this machine (and even hardware implementation from 2007).
156
157	=head1 COPYRIGHT & LICENSE
158
159	Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
160
161	This program is free software; you can redistribute it and/or modify it
162	under the same terms as Perl itself.
163
164	=cut
165
166	1; # End of Galaksija