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; # import

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 $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',
                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 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();

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

}


=head1 Memory management

=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;

        $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;

        $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
        $mem[$addr] = $byte;
        return;
}

=head1 Architecture specific

=head2 render_vram

Simple hex dumper of text buffer

=cut

sub render_vram {
        my $self = shift;

        my $addr = 0x2800;

        print ""; # FIXME auch!
        for my $y ( 0 .. 15 ) {
                printf "%2d: %s\n",$y, join('', map { sprintf("%02x ",$_) } @mem[ $addr .. $addr+31 ] );
                $addr += 32;
        }
}

=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> >>

Based on Galaxy Win emulator L<http://emulator.galaksija.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	dpavlin	130	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	dpavlin	131	use Z80; # import
10	dpavlin	130
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	dpavlin	131
43			warn "Galaksija $Galaksija::VERSION emulation starting\n";
44
45			$self->show_mem( 1 );
46	dpavlin	137	#$self->trace( 1 );
47	dpavlin	131
48	dpavlin	130	$self->SUPER::init(
49			read => sub { $self->read( @_ ) },
50			write => sub { $self->write( @_ ) },
51			);
52
53			for my $a ( 0x1000 .. 0x2000 ) {
54			$mem[$a] = 0xff;
55			}
56
57			$self->open_screen;
58			$self->load_rom({
59			0x0000, 'rom/Galaksija/ROM1.BIN',
60			0x2000, 'rom/Galaksija/ROM2.BIN',
61			# 0xE000, 'rom/Galaksija/GAL_PLUS.BIN',
62			});
63
64			# keyboard
65			$mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );
66
67			# display
68			$mem[$_] = ' ' foreach ( 0x2800 .. 0x2a00 );
69
70			# 6116-ice
71			$mem[$_] = 0 foreach ( 0x2a00 .. 0x4000 );
72
73			$emu = $self;
74
75			my ( $trace, $debug ) = ( $self->trace, $self->debug );
76			$self->trace( 0 );
77			$self->debug( 0 );
78
79	dpavlin	137	warn "rendering memory\n";
80			$self->render_mem( @mem );
81	dpavlin	130
82			#$self->sync;
83			$self->trace( $trace );
84			$self->debug( $debug );
85
86			warn "Galaksija boot finished",
87			$self->trace ? ' trace' : '',
88			$self->debug ? ' debug' : '',
89			"\n";
90
91			Z80::reset();
92
93			$self->loop( sub {
94			Z80::exec( $_[0] );
95	dpavlin	137	$self->render_vram;
96	dpavlin	130	});
97
98			}
99
100
101			=head1 Memory management
102
103			=cut
104
105			=head2 read
106
107			Read from memory
108
109			$byte = read( $address );
110
111			=cut
112
113			my $keyboard_none = 255;
114
115			my $keyboard = {};
116
117			sub read {
118			my $self = shift;
119			my ($addr) = @_;
120			my $byte = $mem[$addr];
121			confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
122			warn sprintf("# Galaksija::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
123
124	dpavlin	137	$self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
125	dpavlin	130	return $byte;
126			}
127
128			=head2 write
129
130			Write into emory
131
132			write( $address, $byte );
133
134			=cut
135
136			sub write {
137			my $self = shift;
138			my ($addr,$byte) = @_;
139			warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
140
141	dpavlin	137	$self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
142	dpavlin	130	$mem[$addr] = $byte;
143			return;
144			}
145
146	dpavlin	137	=head1 Architecture specific
147
148			=head2 render_vram
149
150			Simple hex dumper of text buffer
151
152			=cut
153
154			sub render_vram {
155			my $self = shift;
156
157			my $addr = 0x2800;
158
159			print ""; # FIXME auch!
160			for my $y ( 0 .. 15 ) {
161			printf "%2d: %s\n",$y, join('', map { sprintf("%02x ",$_) } @mem[ $addr .. $addr+31 ] );
162			$addr += 32;
163			}
164			}
165
166	dpavlin	131	=head2 cpu_PC
167
168			Helper metod to set or get PC for current architecture
169
170			=cut
171
172			sub cpu_PC {
173			my ( $self, $addr ) = @_;
174			if ( defined($addr) ) {
175			$PC = $addr;
176			warn sprintf("running from PC %04x\n", $PC);
177			};
178			return $PC;
179			}
180
181	dpavlin	137	=head1 SEE ALSO
182
183			L<VRac>, L<Screen>, L<Z80>
184
185	dpavlin	130	=head1 AUTHOR
186
187			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
188
189	dpavlin	137	Based on Galaxy Win emulator L<http://emulator.galaksija.org/>
190
191	dpavlin	130	=head1 BUGS
192
193			=head1 ACKNOWLEDGEMENTS
194
195			See also L<> which is source of all
196			info about this machine (and even hardware implementation from 2007).
197
198			=head1 COPYRIGHT & LICENSE
199
200			Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
201
202			This program is free software; you can redistribute it and/or modify it
203			under the same terms as Perl itself.
204
205			=cut
206
207			1; # End of Galaksija