/[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 185 - (show annotations)
Sun Sep 30 19:47:32 2007 UTC (16 years, 6 months ago) by dpavlin
File size: 6436 byte(s)
report correct screen_width and screen_height to Screen
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 if ( $addr >= 0x2000 && $addr <= 0x2036 ) {
130 # printf("## keyread 0x%04x = %02x\n", $addr, $byte);
131 $self->key_pressed( 1 ); # force process of events
132 }
133
134 $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
135 return $byte;
136 }
137
138 =head2 write
139
140 Write into emory
141
142 write( $address, $byte );
143
144 =cut
145
146 sub write {
147 my $self = shift;
148 my ($addr,$byte) = @_;
149 warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
150
151 return if ( $addr > 0x4000 );
152
153 $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
154 $mem[$addr] = $byte;
155 return;
156 }
157
158 =head1 Architecture specific
159
160 =cut
161
162 my @keymap = (
163 'a' .. 'z',
164 qw/up down left right space/,
165 '0' .. '9',
166 ':', '"', ',', '=', '.', '/', 'return', 'tab',
167 'left alt', 'backspace', 'scroll lock', 'left shift'
168 );
169
170 my $remap_key2addr;
171 my $o = 1;
172
173 foreach my $key ( @keymap ) {
174 $remap_key2addr->{$key} = 0x2000 + $o;
175 $o++;
176 }
177
178 printf("keymap is mmaped 0x%04x - 0x%04x\n", 0x2000, $o);
179
180 =head2 key_down
181
182 =cut
183
184 sub key_down {
185 my ( $self, $key ) = @_;
186 if ( ! defined( $remap_key2addr->{$key} ) ) {
187 warn "unknown key pressed: $key [ignoring]\n";
188 return;
189 }
190 printf("registered key down: $key address: %04x\n", $remap_key2addr->{$key} );
191 $self->write( $remap_key2addr->{$key}, 0xfe );
192 }
193
194 =head2 key_up
195
196 =cut
197
198 sub key_up {
199 my ( $self, $key ) = @_;
200 if ( ! defined( $remap_key2addr->{$key} ) ) {
201 warn "unknown key released: $key [ignoring]\n";
202 return;
203 }
204 warn "registred key up: $key ", $remap_key2addr->{$key};
205 $self->write( $remap_key2addr->{$key}, 0xff );
206 }
207
208 =head2 render_vram
209
210 Render characters as graphic
211
212 =cut
213
214 my $char_rom = 'rom/Galaksija/CHRGEN.BIN';
215
216 my @chars = map { ord($_) } split(//, read_file( $char_rom ));
217 warn "loaded ", $#chars, " bytes from $char_rom\n";
218
219 my @char2pos;
220
221 # maken from mess/video/galaxy.c
222 foreach my $char ( 0 .. 255 ) {
223 my $c = $char;
224 if ( ( $c > 63 && $c < 96 ) || ( $c > 127 && $c < 192 ) ) {
225 $c -= 64;
226 } elsif ( $c > 191 ) {
227 $c -= 128;
228 }
229 $char2pos[ $char ] = ( $c & 0x7f );
230 }
231
232 #warn "## chars2pos = ",dump( @char2pos );
233
234 sub screen_width { 256 }
235 sub screen_height { 16 * 13 }
236
237 sub render_vram {
238 my $self = shift;
239
240 my $t = time();
241
242 my $addr = 0x2800;
243
244 my @pixels = ("\x00") x ( 32 * 16 * 13 );
245 my $a = 0;
246
247 for my $y ( 0 .. 15 ) {
248 for my $x ( 0 .. 31 ) {
249 my $c = $mem[ $addr++ ];
250 $c = $char2pos[ $c ];
251 for my $l ( 0 .. 12 ) {
252 my $o = $l << 5; # *32
253 my $co = ( $l << 7 ) | $c;
254 $pixels[ $a + $x + $o ] = $flip[ $chars[ $co ] ];
255 }
256 }
257 $a += ( 32 * 13 ); # next line
258 }
259
260 my $vram = SDL::Surface->new(
261 -width => $self->screen_width,
262 -height => $self->screen_height,
263 -depth => 1, # 1 bit per pixel
264 -pitch => 32, # bytes per line
265 -from => pack("C*", @pixels),
266 );
267 $vram->set_colors( 0, $white, $black );
268
269 $self->render_frame( $vram );
270
271 # $self->render_vram_text;
272
273 printf("frame in %.2fs\n", time()-$t) if $self->debug;
274 }
275
276
277 =head2 render_vram_text
278
279 Simple hex dumper of text buffer
280
281 =cut
282
283 my $last_dump = '';
284
285 sub render_vram_text {
286 my $self = shift;
287
288 my $addr = 0x2800;
289
290 my $dump;
291
292 for my $y ( 0 .. 15 ) {
293 # $dump .= sprintf "%2d: %s\n",$y, join('', map { sprintf("%02x ",$_) } @mem[ $addr .. $addr+31 ] );
294 $dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr .. $addr+31 ] );
295 $addr += 32;
296 }
297
298 if ( $mem[ 0x2bb0 ] ) {
299 warn "scroll", $self->hexdump( 0x2bb0 );
300 }
301
302 if ( $dump ne $last_dump ) {
303 print $dump;
304 $last_dump = $dump;
305 }
306 }
307
308 =head2 cpu_PC
309
310 Helper metod to set or get PC for current architecture
311
312 =cut
313
314 sub cpu_PC {
315 my ( $self, $addr ) = @_;
316 if ( defined($addr) ) {
317 $PC = $addr;
318 warn sprintf("running from PC %04x\n", $PC);
319 };
320 return $PC;
321 }
322
323 =head1 SEE ALSO
324
325 L<VRac>, L<Screen>, L<Z80>
326
327 =head1 AUTHOR
328
329 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
330
331 =head1 BUGS
332
333 Galaksija Plus isn't emulated. I don't have additional rom, but I would
334 B<love> to have support for this machine. So if you have ROM for Galaksija
335 Plus, get in touch!
336
337 =head1 ACKNOWLEDGEMENTS
338
339 Based on Galaxy emulator L<http://emulator.galaksija.org/> for Windows which
340 is in turn based on DOS version by Miodrag Jevremoviæ
341 L<http://solair.eunet.yu/~jovkovic/galaxy/>.
342
343 =head1 COPYRIGHT & LICENSE
344
345 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
346
347 This program is free software; you can redistribute it and/or modify it
348 under the same terms as Perl itself.
349
350 =cut
351
352 1; # End of Galaksija

  ViewVC Help
Powered by ViewVC 1.1.26