/[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 188 - (hide annotations)
Sun Sep 30 20:05:20 2007 UTC (11 years, 8 months ago) by dpavlin
File size: 5108 byte(s)
Galeb displays first graphics display (correct size, but inverted and
flipped)
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

  ViewVC Help
Powered by ViewVC 1.1.26