/[VRac]/Galaksija.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

Contents of /Galaksija.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 178 - (show annotations)
Sat Sep 29 12:07:12 2007 UTC (11 years, 8 months ago) by dpavlin
File size: 5803 byte(s)
more debugging and some stats about speed using Time::HiRes
1 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 use Z80;
10 use Screen;
11 use Time::HiRes qw/time/;
12
13 use base qw(Class::Accessor VRac Z80 Screen Prefs Session);
14 __PACKAGE__->mk_accessors(qw(booted));
15
16 =head1 NAME
17
18 Galaksija - Galaksija emulator
19
20 =head1 VERSION
21
22 Version 0.01
23
24 =cut
25
26 our $VERSION = '0.01';
27
28 =head1 SUMMARY
29
30 Emulator of Galaksija 8-bit Z80 machine popular in former Yugoslavia
31
32 =cut
33
34 =head1 FUNCTIONS
35
36 =head2 run
37
38 =cut
39
40 our $emu;
41
42 sub run {
43 my $self = shift;
44
45 warn "Galaksija $Galaksija::VERSION emulation starting\n";
46
47 $self->show_mem( 1 );
48 #$self->trace( 1 );
49
50 $self->SUPER::init(
51 read => sub { $self->read( @_ ) },
52 write => sub { $self->write( @_ ) },
53 );
54
55 for my $a ( 0x1000 .. 0x2000 ) {
56 $mem[$a] = 0xff;
57 }
58
59 $self->open_screen;
60 $self->load_rom({
61 0x0000, 'rom/Galaksija/ROM1.BIN',
62 0x1000, 'rom/Galaksija/ROM2.BIN',
63 # 0xE000, 'rom/Galaksija/GAL_PLUS.BIN',
64 });
65
66 # keyboard
67 $mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );
68
69 # display
70 $mem[$_] = 0x20 foreach ( 0x2800 .. 0x2a00 );
71
72 # 6116-ice
73 $mem[$_] = 0 foreach ( 0x2a00 .. 0x4000 );
74
75 $emu = $self;
76
77 my ( $trace, $debug ) = ( $self->trace, $self->debug );
78 $self->trace( 0 );
79 $self->debug( 0 );
80
81 warn "rendering memory\n";
82 $self->render_mem( @mem );
83
84 #$self->sync;
85 $self->trace( $trace );
86 $self->debug( $debug );
87
88 warn "Galaksija boot finished",
89 $self->trace ? ' trace' : '',
90 $self->debug ? ' debug' : '',
91 "\n";
92
93 Z80::reset();
94
95 my $hor_pos = 0;
96
97 $self->loop( sub {
98 my $run_for = shift;
99 Z80::exec( $run_for );
100 if ( $hor_pos != $mem[ 0x2ba8 ] ) {
101 warn "scroll 0x2ba8", $self->hexdump( 0x2ba8 );
102 $hor_pos = $mem[ 0x2ba8 ];
103 }
104 $self->render_vram;
105 });
106
107 }
108
109
110 =head1 Memory management
111
112 =cut
113
114 =head2 read
115
116 Read from memory
117
118 $byte = read( $address );
119
120 =cut
121
122 sub read {
123 my $self = shift;
124 my ($addr) = @_;
125 my $byte = $mem[$addr];
126 confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
127 warn sprintf("# Galaksija::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
128
129 $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
130 return $byte;
131 }
132
133 =head2 write
134
135 Write into emory
136
137 write( $address, $byte );
138
139 =cut
140
141 sub write {
142 my $self = shift;
143 my ($addr,$byte) = @_;
144 warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
145
146 return if ( $addr > 0x4000 );
147
148 $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
149 $mem[$addr] = $byte;
150 return;
151 }
152
153 =head1 Architecture specific
154
155 =cut
156
157 my @keymap = (
158 'a' .. 'z',
159 qw/up down left right space/,
160 '0' .. '9',
161 ':', '"', ',', '=', '.', '/', 'return', 'tab',
162 'left alt', 'backspace', 'scroll lock', 'left shift'
163 );
164
165 my $remap;
166 my $o = 1;
167
168 foreach my $key ( @keymap ) {
169 $remap->{$key} = $o;
170 $o++;
171 }
172
173 =head2 key_down
174
175 =cut
176
177 sub key_down {
178 my ( $self, $key ) = @_;
179 warn "registered key down: $key ", $remap->{$key};
180 $self->write( 0x2000 + $remap->{$key}, 0xfe );
181 }
182
183 =head2 key_up
184
185 =cut
186
187 sub key_up {
188 my ( $self, $key ) = @_;
189 warn "registred key up: $key ", $remap->{$key};
190 $self->write( 0x2000 + $remap->{$key}, 0xff );
191 }
192
193 =head2 render_vram
194
195 Render characters as graphic
196
197 =cut
198
199 my $char_rom = 'rom/Galaksija/CHRGEN.BIN';
200
201 my @chars = map { ord($_) } split(//, read_file( $char_rom ));
202 warn "loaded ", $#chars, " characters\n";
203
204 my @char2pos;
205
206 # maken from mess/video/galaxy.c
207 foreach my $char ( 0 .. 255 ) {
208 my $c = $char;
209 if ( ( $c > 63 && $c < 96 ) || ( $c > 127 && $c < 192 ) ) {
210 $c -= 64;
211 } elsif ( $c > 191 ) {
212 $c -= 128;
213 }
214 $char2pos[ $char ] = ( $c & 0x7f );
215 }
216
217 warn dump( @char2pos );
218
219 sub render_vram {
220 my $self = shift;
221
222 my $t = time();
223
224 my $addr = 0x2800;
225
226 my @pixels = ("\x00") x ( 32 * 16 * 13 );
227 my $a = 0;
228
229 for my $y ( 0 .. 15 ) {
230 for my $x ( 0 .. 31 ) {
231 my $c = $mem[ $addr++ ];
232 $c = $char2pos[ $c ];
233 for my $l ( 0 .. 12 ) {
234 my $o = $l << 5; # *32
235 my $co = ( $l << 7 ) | $c;
236 $pixels[ $a + $x + $o ] = $flip[ $chars[ $co ] ];
237 }
238 }
239 $a += ( 32 * 13 ); # next line
240 }
241
242 my $vram = SDL::Surface->new(
243 -width => 256,
244 -height => 256,
245 -depth => 1, # 1 bit per pixel
246 -pitch => 32, # bytes per line
247 -from => pack("C*", @pixels),
248 );
249 $vram->set_colors( 0, $white, $black );
250
251 $self->render_frame( $vram );
252
253 # $self->render_vram_text;
254
255 printf("frame in %.2fs\n", time()-$t);
256 }
257
258
259 =head2 render_vram_text
260
261 Simple hex dumper of text buffer
262
263 =cut
264
265 my $last_dump = '';
266
267 sub render_vram_text {
268 my $self = shift;
269
270 my $addr = 0x2800;
271
272 my $dump;
273
274 for my $y ( 0 .. 15 ) {
275 # $dump .= sprintf "%2d: %s\n",$y, join('', map { sprintf("%02x ",$_) } @mem[ $addr .. $addr+31 ] );
276 $dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr .. $addr+31 ] );
277 $addr += 32;
278 }
279
280 if ( $mem[ 0x2bb0 ] ) {
281 warn "scroll", $self->hexdump( 0x2bb0 );
282 }
283
284 if ( $dump ne $last_dump ) {
285 print $dump;
286 $last_dump = $dump;
287 }
288 }
289
290 =head2 cpu_PC
291
292 Helper metod to set or get PC for current architecture
293
294 =cut
295
296 sub cpu_PC {
297 my ( $self, $addr ) = @_;
298 if ( defined($addr) ) {
299 $PC = $addr;
300 warn sprintf("running from PC %04x\n", $PC);
301 };
302 return $PC;
303 }
304
305 =head1 SEE ALSO
306
307 L<VRac>, L<Screen>, L<Z80>
308
309 =head1 AUTHOR
310
311 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
312
313 =head1 BUGS
314
315 Galaksija Plus isn't emulated. I don't have additional rom, but I would
316 B<love> to have support for this machine. So if you have ROM for Galaksija
317 Plus, get in touch!
318
319 =head1 ACKNOWLEDGEMENTS
320
321 Based on Galaxy emulator L<http://emulator.galaksija.org/> for Windows which
322 is in turn based on DOS version by Miodrag Jevremoviæ
323 L<http://solair.eunet.yu/~jovkovic/galaxy/>.
324
325 =head1 COPYRIGHT & LICENSE
326
327 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
328
329 This program is free software; you can redistribute it and/or modify it
330 under the same terms as Perl itself.
331
332 =cut
333
334 1; # End of Galaksija

  ViewVC Help
Powered by ViewVC 1.1.26