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;

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

        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 $char_rom = 'rom/Galeb/CHRGEN.rom';

my @chars = map { ord($_) } split(//, read_file( $char_rom ));
warn "loaded ", $#chars, " characters from $char_rom\n";

my $last_dump = '';

my $x_size = 48;
my $y_size = 16;
my $c_h = 8;

sub screen_width { $x_size * 8 }
sub screen_height { $y_size * $c_h }

sub render_vram {
        my $self = shift;

        my $addr = 0xb000;

        my $dump;

        my @pixels = ("\x00") x ( $x_size * $y_size * 8 );

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

                foreach my $x ( 0 .. $x_size - 1 ) {
                        my $c = $mem[ $addr + 15 + $x ];
                        my $l = $x_size * $c_h;
                        foreach my $o ( 0 .. $c_h - 1 ) {
                                $pixels[ ( $y * $l ) + $x + ( $o * $x_size ) ] = $chars[ ( $c * $c_h ) + $o ];
                        }
                }

                $addr += 64;
        }

        if ( $dump ne $last_dump ) {
#               print $dump;
                $last_dump = $dump;

                my $vram = SDL::Surface->new(
                        -width => $x_size * 8,
                        -height => $y_size * $c_h,
                        -depth => 1,            # 1 bit per pixel
                        -pitch => $x_size,      # bytes per line
                        -from => pack("C*", @pixels),
                );
                $vram->set_colors( 0, $white, $black );

                $self->render_frame( $vram );
        }
}

=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	dpavlin	188	# $self->scale( 2 );
55	dpavlin	174	$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	dpavlin	188	# $self->trace( 1 );
74			# $self->debug( 1 );
75	dpavlin	174
76			warn "rendering memory\n";
77			$self->render_mem( @mem );
78
79			M6502::reset();
80
81			$self->loop( sub {
82			my $run_for = shift;
83			warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace;
84			M6502::exec( $run_for );
85			$self->render_vram;
86			});
87			};
88
89
90			=head1 Helper functions
91
92			=head2 load_image
93
94			Load binary files, ROM images and Galeb Emulator files
95
96			$emu->load_image( '/path/to/file', 0x1000 );
97
98			Returns true on success.
99
100			=cut
101
102			sub load_image {
103			my $self = shift;
104			my ( $path, $addr ) = @_;
105
106			if ( ! -e $path ) {
107			warn "ERROR: file $path doesn't exist\n";
108			return;
109			}
110
111			my $size = -s $path \|\| confess "no size for $path: $!";
112
113			my $buff = read_file( $path );
114
115			if ( $size == 65567 ) {
116			$addr = 0;
117			warn sprintf "loading Galaksija emulator 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
118			$self->write_chunk( $addr, substr($buff,0x20) );
119			return 1;
120			}
121
122			printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
123			$self->write_chunk( $addr, $buff );
124			return 1;
125			};
126
127
128			=head1 Memory management
129
130			=cut
131
132			=head2 read
133
134			Read from memory
135
136			$byte = read( $address );
137
138			=cut
139
140			sub read {
141			my $self = shift;
142			my ($addr) = @_;
143			return if ( $addr > 0xffff );
144			my $byte = $mem[$addr];
145			confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
146			warn sprintf("# Galeb::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
147
148			$self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
149			return $byte;
150			}
151
152			=head2 write
153
154			Write into emory
155
156			write( $address, $byte );
157
158			=cut
159
160			sub write {
161			my $self = shift;
162			my ($addr,$byte) = @_;
163			warn sprintf("# Galeb::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
164
165			if ( $addr > 0xc000 ) {
166			confess sprintf "write access 0x%04x > 0xc000 aborting\n", $addr;
167			}
168
169			$self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
170			$mem[$addr] = $byte;
171			return;
172			}
173
174			=head1 Architecture specific
175
176			=head2 render_vram
177
178			Render one frame of video ram
179
180			$self->render_vram;
181
182			=cut
183
184	dpavlin	188	my $char_rom = 'rom/Galeb/CHRGEN.rom';
185
186			my @chars = map { ord($_) } split(//, read_file( $char_rom ));
187			warn "loaded ", $#chars, " characters from $char_rom\n";
188
189	dpavlin	174	my $last_dump = '';
190
191	dpavlin	188	my $x_size = 48;
192			my $y_size = 16;
193			my $c_h = 8;
194
195			sub screen_width { $x_size * 8 }
196			sub screen_height { $y_size * $c_h }
197
198	dpavlin	174	sub render_vram {
199			my $self = shift;
200
201			my $addr = 0xb000;
202
203			my $dump;
204
205	dpavlin	188	my @pixels = ("\x00") x ( $x_size * $y_size * 8 );
206
207			for my $y ( 0 .. $y_size - 1 ) {
208	dpavlin	174	$dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr+15 .. $addr+62 ] );
209	dpavlin	188
210			foreach my $x ( 0 .. $x_size - 1 ) {
211			my $c = $mem[ $addr + 15 + $x ];
212			my $l = $x_size * $c_h;
213			foreach my $o ( 0 .. $c_h - 1 ) {
214			$pixels[ ( $y * $l ) + $x + ( $o * $x_size ) ] = $chars[ ( $c * $c_h ) + $o ];
215			}
216			}
217
218	dpavlin	174	$addr += 64;
219			}
220
221			if ( $dump ne $last_dump ) {
222	dpavlin	188	# print $dump;
223	dpavlin	174	$last_dump = $dump;
224	dpavlin	188
225			my $vram = SDL::Surface->new(
226			-width => $x_size * 8,
227			-height => $y_size * $c_h,
228			-depth => 1, # 1 bit per pixel
229			-pitch => $x_size, # bytes per line
230			-from => pack("C*", @pixels),
231			);
232			$vram->set_colors( 0, $white, $black );
233
234			$self->render_frame( $vram );
235	dpavlin	174	}
236			}
237
238			=head2 cpu_PC
239
240			Helper metod to set or get PC for current architecture
241
242			=cut
243
244			sub cpu_PC {
245			my ( $self, $addr ) = @_;
246			if ( defined($addr) ) {
247			$PC = $addr;
248			warn sprintf("running from PC %04x\n", $PC);
249			};
250			return $PC;
251			}
252
253			=head1 SEE ALSO
254
255			L<VRac>, L<M6502>, L<Screen>, L<Tape>
256
257			=head1 AUTHOR
258
259			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
260
261			=head1 ACKNOWLEDGEMENTS
262
263			See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
264			info about this machine (and even hardware implementation from 2007).
265
266			=head1 COPYRIGHT & LICENSE
267
268			Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
269
270			This program is free software; you can redistribute it and/or modify it
271			under the same terms as Perl itself.
272
273			=cut
274
275			1; # End of Galeb