viewvc.cgi/VRac/Galeb.pm

package Galeb;

use warnings;
use strict;

use Carp qw/confess/;
use File::Slurp;
use Data::Dump qw/dump/;
use M6502;
use Screen;

use base qw(Class::Accessor VRac M6502 Screen Prefs Session);
#__PACKAGE__->mk_accessors(qw());

=head1 NAME

Galeb - Galeb emulator

=head1 VERSION

Version 0.00

=cut

our $VERSION = '0.00';

=head1 SUMMARY

Emulator for Galeb 8-bit 6502 machine from Croatia

=cut

=head1 FUNCTIONS

=head2 run

Start emulator, open L<Screen>, load initial ROM images, and start emulator loop

=cut

our $emu;

sub run {
        my $self = shift;

        warn "Galeb calling upstream init\n";
        $self->SUPER::init(
                read => sub { $self->read( @_ ) },
                write => sub { $self->write( @_ ) },
        );

        warn "Galeb $Galeb::VERSION emulation starting\n";

        $self->scale( 2 );
        $self->show_mem( 1 );
        $self->load_session( 'sess/current' );

        $self->open_screen;
        $self->load_rom({
                0xc000 => 'rom/Galeb/BAS01.rom',
                0xc800 => 'rom/Galeb/BAS02.rom',
                0xd000 => 'rom/Galeb/BAS03.rom',
                0xd800 => 'rom/Galeb/BAS04.rom',
                0xf000 => 'rom/Galeb/EXMD.rom',
                0xf800 => 'rom/Galeb/MAKbug.rom',
        });

        $PC = $mem[ 0xfffc ];
        warn sprintf("starting from address at 0xfffc = 0x%04x", $PC);

        $emu = $self;

        my ( $trace, $debug ) = ( $self->trace, $self->debug );
        $self->trace( 0 );
        $self->debug( 0 );

        warn "rendering memory\n";
        $self->render_mem( @mem );

        M6502::reset();

        $self->loop( sub {
                my $run_for = shift;
                warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace;
                M6502::exec( $run_for );
                $self->render_vram;
        });
};


=head1 Helper functions

=head2 load_image

Load binary files, ROM images and Galeb Emulator files

  $emu->load_image( '/path/to/file', 0x1000 );

Returns true on success.

=cut

sub load_image {
        my $self = shift;
        my ( $path, $addr ) = @_;

        if ( ! -e $path ) {
                warn "ERROR: file $path doesn't exist\n";
                return;
        }

        my $size = -s $path || confess "no size for $path: $!";

        my $buff = read_file( $path );

        if ( $size == 65567 ) {
                $addr = 0;
                warn sprintf "loading Galaksija emulator 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
                $self->write_chunk( $addr, substr($buff,0x20) );
                return 1;
        }

        printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
        $self->write_chunk( $addr, $buff );
        return 1;
};


=head1 Memory management

=cut

=head2 read

Read from memory

  $byte = read( $address );

=cut

sub read {
        my $self = shift;
        my ($addr) = @_;
        return if ( $addr > 0xffff );
        my $byte = $mem[$addr];
        confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
        warn sprintf("# Galeb::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("# Galeb::write(%04x,%02x)\n", $addr, $byte) if $self->trace;

        if ( $addr > 0xc000 ) {
                confess sprintf "write access 0x%04x > 0xc000 aborting\n", $addr;
        }

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

=head1 Architecture specific

=head2 render_vram

Render one frame of video ram

  $self->render_vram;

=cut

my $last_dump = '';

sub render_vram {
        my $self = shift;

        my $addr = 0xb000;

        my $dump;

        for my $y ( 0 .. 15 ) {
                $dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr+15 .. $addr+62 ] );
                $addr += 64;
        }

        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<M6502>, L<Screen>, L<Tape>

=head1 AUTHOR

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

=head1 ACKNOWLEDGEMENTS

See also L<http://www.foing.hr/~fng_josip/orao.htm> 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 Galeb
1	dpavlin	174	package Galeb;
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 M6502;
10			use Screen;
11
12			use base qw(Class::Accessor VRac M6502 Screen Prefs Session);
13			#__PACKAGE__->mk_accessors(qw());
14
15			=head1 NAME
16
17			Galeb - Galeb emulator
18
19			=head1 VERSION
20
21			Version 0.00
22
23			=cut
24
25			our $VERSION = '0.00';
26
27			=head1 SUMMARY
28
29			Emulator for Galeb 8-bit 6502 machine from Croatia
30
31			=cut
32
33			=head1 FUNCTIONS
34
35			=head2 run
36
37			Start emulator, open L<Screen>, load initial ROM images, and start emulator loop
38
39			=cut
40
41			our $emu;
42
43			sub run {
44			my $self = shift;
45
46			warn "Galeb calling upstream init\n";
47			$self->SUPER::init(
48			read => sub { $self->read( @_ ) },
49			write => sub { $self->write( @_ ) },
50			);
51
52			warn "Galeb $Galeb::VERSION emulation starting\n";
53
54			$self->scale( 2 );
55			$self->show_mem( 1 );
56			$self->load_session( 'sess/current' );
57
58			$self->open_screen;
59			$self->load_rom({
60			0xc000 => 'rom/Galeb/BAS01.rom',
61			0xc800 => 'rom/Galeb/BAS02.rom',
62			0xd000 => 'rom/Galeb/BAS03.rom',
63			0xd800 => 'rom/Galeb/BAS04.rom',
64			0xf000 => 'rom/Galeb/EXMD.rom',
65			0xf800 => 'rom/Galeb/MAKbug.rom',
66			});
67
68			$PC = $mem[ 0xfffc ];
69			warn sprintf("starting from address at 0xfffc = 0x%04x", $PC);
70
71			$emu = $self;
72
73			my ( $trace, $debug ) = ( $self->trace, $self->debug );
74			$self->trace( 0 );
75			$self->debug( 0 );
76
77			warn "rendering memory\n";
78			$self->render_mem( @mem );
79
80			M6502::reset();
81
82			$self->loop( sub {
83			my $run_for = shift;
84			warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace;
85			M6502::exec( $run_for );
86			$self->render_vram;
87			});
88			};
89
90
91			=head1 Helper functions
92
93			=head2 load_image
94
95			Load binary files, ROM images and Galeb Emulator files
96
97			$emu->load_image( '/path/to/file', 0x1000 );
98
99			Returns true on success.
100
101			=cut
102
103			sub load_image {
104			my $self = shift;
105			my ( $path, $addr ) = @_;
106
107			if ( ! -e $path ) {
108			warn "ERROR: file $path doesn't exist\n";
109			return;
110			}
111
112			my $size = -s $path \|\| confess "no size for $path: $!";
113
114			my $buff = read_file( $path );
115
116			if ( $size == 65567 ) {
117			$addr = 0;
118			warn sprintf "loading Galaksija emulator 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
119			$self->write_chunk( $addr, substr($buff,0x20) );
120			return 1;
121			}
122
123			printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
124			$self->write_chunk( $addr, $buff );
125			return 1;
126			};
127
128
129			=head1 Memory management
130
131			=cut
132
133			=head2 read
134
135			Read from memory
136
137			$byte = read( $address );
138
139			=cut
140
141			sub read {
142			my $self = shift;
143			my ($addr) = @_;
144			return if ( $addr > 0xffff );
145			my $byte = $mem[$addr];
146			confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
147			warn sprintf("# Galeb::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
148
149			$self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
150			return $byte;
151			}
152
153			=head2 write
154
155			Write into emory
156
157			write( $address, $byte );
158
159			=cut
160
161			sub write {
162			my $self = shift;
163			my ($addr,$byte) = @_;
164			warn sprintf("# Galeb::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
165
166			if ( $addr > 0xc000 ) {
167			confess sprintf "write access 0x%04x > 0xc000 aborting\n", $addr;
168			}
169
170			$self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
171			$mem[$addr] = $byte;
172			return;
173			}
174
175			=head1 Architecture specific
176
177			=head2 render_vram
178
179			Render one frame of video ram
180
181			$self->render_vram;
182
183			=cut
184
185			my $last_dump = '';
186
187			sub render_vram {
188			my $self = shift;
189
190			my $addr = 0xb000;
191
192			my $dump;
193
194			for my $y ( 0 .. 15 ) {
195			$dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr+15 .. $addr+62 ] );
196			$addr += 64;
197			}
198
199			if ( $dump ne $last_dump ) {
200			print $dump;
201			$last_dump = $dump;
202			}
203			}
204
205			=head2 cpu_PC
206
207			Helper metod to set or get PC for current architecture
208
209			=cut
210
211			sub cpu_PC {
212			my ( $self, $addr ) = @_;
213			if ( defined($addr) ) {
214			$PC = $addr;
215			warn sprintf("running from PC %04x\n", $PC);
216			};
217			return $PC;
218			}
219
220			=head1 SEE ALSO
221
222			L<VRac>, L<M6502>, L<Screen>, L<Tape>
223
224			=head1 AUTHOR
225
226			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
227
228			=head1 ACKNOWLEDGEMENTS
229
230			See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
231			info about this machine (and even hardware implementation from 2007).
232
233			=head1 COPYRIGHT & LICENSE
234
235			Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
236
237			This program is free software; you can redistribute it and/or modify it
238			under the same terms as Perl itself.
239
240			=cut
241
242			1; # End of Galeb