/[VRac]/Galeb.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /Galeb.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 214 - (hide annotations)
Tue Apr 15 13:03:19 2008 UTC (11 years, 2 months ago) by dpavlin
File size: 5139 byte(s)
move reset in right place
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 dpavlin 214 M6502::reset();
47    
48 dpavlin 174 warn "Galeb calling upstream init\n";
49     $self->SUPER::init(
50     read => sub { $self->read( @_ ) },
51     write => sub { $self->write( @_ ) },
52     );
53    
54     warn "Galeb $Galeb::VERSION emulation starting\n";
55    
56 dpavlin 188 # $self->scale( 2 );
57 dpavlin 174 $self->show_mem( 1 );
58     $self->load_session( 'sess/current' );
59    
60     $self->open_screen;
61     $self->load_rom({
62     0xc000 => 'rom/Galeb/BAS01.rom',
63     0xc800 => 'rom/Galeb/BAS02.rom',
64     0xd000 => 'rom/Galeb/BAS03.rom',
65     0xd800 => 'rom/Galeb/BAS04.rom',
66     0xf000 => 'rom/Galeb/EXMD.rom',
67     0xf800 => 'rom/Galeb/MAKbug.rom',
68     });
69    
70     $PC = $mem[ 0xfffc ];
71     warn sprintf("starting from address at 0xfffc = 0x%04x", $PC);
72    
73     $emu = $self;
74    
75 dpavlin 188 # $self->trace( 1 );
76     # $self->debug( 1 );
77 dpavlin 174
78     warn "rendering memory\n";
79     $self->render_mem( @mem );
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 dpavlin 189 # flip, invert
187     my @chars = map { $flip[ ord($_) ] ^ 0xff } split(//, read_file( $char_rom ));
188 dpavlin 188 warn "loaded ", $#chars, " characters from $char_rom\n";
189    
190 dpavlin 174 my $last_dump = '';
191    
192 dpavlin 188 my $x_size = 48;
193     my $y_size = 16;
194     my $c_h = 8;
195    
196     sub screen_width { $x_size * 8 }
197     sub screen_height { $y_size * $c_h }
198    
199 dpavlin 174 sub render_vram {
200     my $self = shift;
201    
202     my $addr = 0xb000;
203    
204     my $dump;
205    
206 dpavlin 188 my @pixels = ("\x00") x ( $x_size * $y_size * 8 );
207    
208     for my $y ( 0 .. $y_size - 1 ) {
209 dpavlin 174 $dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr+15 .. $addr+62 ] );
210 dpavlin 188
211     foreach my $x ( 0 .. $x_size - 1 ) {
212     my $c = $mem[ $addr + 15 + $x ];
213     my $l = $x_size * $c_h;
214     foreach my $o ( 0 .. $c_h - 1 ) {
215     $pixels[ ( $y * $l ) + $x + ( $o * $x_size ) ] = $chars[ ( $c * $c_h ) + $o ];
216     }
217     }
218    
219 dpavlin 174 $addr += 64;
220     }
221    
222     if ( $dump ne $last_dump ) {
223 dpavlin 188 # print $dump;
224 dpavlin 174 $last_dump = $dump;
225 dpavlin 188
226     my $vram = SDL::Surface->new(
227     -width => $x_size * 8,
228     -height => $y_size * $c_h,
229     -depth => 1, # 1 bit per pixel
230     -pitch => $x_size, # bytes per line
231     -from => pack("C*", @pixels),
232     );
233     $vram->set_colors( 0, $white, $black );
234    
235     $self->render_frame( $vram );
236 dpavlin 174 }
237     }
238    
239     =head2 cpu_PC
240    
241     Helper metod to set or get PC for current architecture
242    
243     =cut
244    
245     sub cpu_PC {
246     my ( $self, $addr ) = @_;
247     if ( defined($addr) ) {
248     $PC = $addr;
249     warn sprintf("running from PC %04x\n", $PC);
250     };
251     return $PC;
252     }
253    
254     =head1 SEE ALSO
255    
256     L<VRac>, L<M6502>, L<Screen>, L<Tape>
257    
258     =head1 AUTHOR
259    
260     Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
261    
262     =head1 ACKNOWLEDGEMENTS
263    
264     See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
265     info about this machine (and even hardware implementation from 2007).
266    
267     =head1 COPYRIGHT & LICENSE
268    
269     Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
270    
271     This program is free software; you can redistribute it and/or modify it
272     under the same terms as Perl itself.
273    
274     =cut
275    
276     1; # End of Galeb

  ViewVC Help
Powered by ViewVC 1.1.26