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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 213 - (show annotations)
Mon Apr 14 21:27:19 2008 UTC (10 years, 11 months ago) by dpavlin
File size: 9878 byte(s)
now we render memory when refreshing screen, so even with perl
flipping of chars on screen we are still fast :-)
1 package Orao;
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 '0.0.3';
10 use Screen;
11
12 use base qw(Class::Accessor VRac M6502 Screen Prefs Tape Session);
13 #__PACKAGE__->mk_accessors(qw());
14
15 =head1 NAME
16
17 Orao - Orao emulator
18
19 =head1 VERSION
20
21 Version 0.06
22
23 =cut
24
25 our $VERSION = '0.06';
26
27 =head1 SUMMARY
28
29 Emulator for Orao 8-bit 6502 machine popular in Croatia (especially schools)
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 M6502::reset();
47 $self->_init_callbacks;
48
49 warn "Orao calling upstream init\n";
50 $self->SUPER::init(
51 read => sub { $self->read( @_ ) },
52 write => sub { $self->write( @_ ) },
53 );
54
55 warn "Orao $Orao::VERSION emulation starting\n";
56
57 warn "emulating ", $#mem, " bytes of memory\n";
58
59 # $self->scale( 2 );
60 $self->show_mem( 1 );
61 $self->load_session( 'sess/current' );
62
63 $self->open_screen;
64 $self->load_rom({
65 # 0x1000 => 'dump/SCRINV.BIN',
66 # should be 0x6000, but oraoemu has 2 byte prefix
67 # 0x5FFE => '/home/dpavlin/orao/dump/screen.dmp',
68 # 0xC000 => 'rom/Orao/BAS12.ROM',
69 # 0xE000 => 'rom/Orao/CRT12.ROM',
70 0xC000 => 'rom/Orao/BAS13.ROM',
71 0xE000 => 'rom/Orao/CRT13.ROM',
72 });
73
74 # $PC = 0xDD11; # BC
75 # $PC = 0xC274; # MC
76
77 $PC = 0xff89;
78
79 $emu = $self;
80
81 # $self->prompt( 0x1000 );
82
83 my ( $trace, $debug ) = ( $self->trace, $self->debug );
84 $self->trace( 0 );
85 $self->debug( 0 );
86
87 warn "rendering memory\n";
88 $self->render_mem( M6502::mem_peek_region(0x0000,0xffff) );
89
90 if ( $self->show_mem ) {
91
92 my @mmap = (
93 0x0000, 0x03FF, 'nulti blok',
94 0x0400, 0x5FFF, 'korisnièki RAM (23K)',
95 0x6000, 0x7FFF, 'video RAM',
96 0x8000, 0x9FFF, 'sistemske lokacije',
97 0xA000, 0xAFFF, 'ekstenzija',
98 0xB000, 0xBFFF, 'DOS',
99 0xC000, 0xDFFF, 'BASIC ROM',
100 0xE000, 0xFFFF, 'sistemski ROM',
101 );
102
103 print "Orao memory map:";
104
105 while ( @mmap ) {
106 my ( $from, $to, $desc ) = splice(@mmap, 0, 3);
107 printf("%04x-%04x %s\n", $from, $to, $desc);
108 }
109
110 }
111
112 $self->trace( $trace );
113 $self->debug( $debug );
114
115 warn "Orao boot finished",
116 $self->trace ? ' trace' : '',
117 $self->debug ? ' debug' : '',
118 "\n";
119
120 # $self->load_tape( 'tapes/Orao/bdash.tap' );
121 # $self->load_tape( 'tapes/Orao/crtanje.tap' );
122 # $self->load_tape( 'tapes/Orao/jjack.tap', 0x168 );
123 $self->load_tape( 'tapes/Orao/muzika.tap', 0x168 );
124
125 $self->render_vram;
126
127 $self->loop( sub {
128 my $run_for = shift;
129 warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace;
130 M6502::exec( $run_for );
131 $self->render_vram;
132 $self->render_mem( M6502::mem_peek_region(0x0000,0xffff) ) if $self->show_mem;
133 });
134 };
135
136
137 =head1 Helper functions
138
139 =head2 write_chunk
140
141 Write chunk directly into memory, updateing vram if needed
142
143 $emu->write_chunk( 0x1000, $chunk_data );
144
145 =cut
146
147 sub write_chunk {
148 my $self = shift;
149 my ( $addr, $chunk ) = @_;
150 $self->SUPER::write_chunk( $addr, $chunk );
151 my $end = $addr + length($chunk);
152 my ( $f, $t ) = ( 0x6000, 0x7fff );
153
154 if ( $end < $f || $addr >= $t ) {
155 warn "skip vram update\n";
156 return;
157 };
158
159 $f = $addr if ( $addr > $f );
160 $t = $end if ( $end < $t );
161
162 warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
163 $self->render_vram;
164 $self->render_mem( @mem );
165 }
166
167 =head2 load_image
168
169 Load binary files, ROM images and Orao Emulator files
170
171 $emu->load_image( '/path/to/file', 0x1000 );
172
173 Returns true on success.
174
175 =cut
176
177 sub load_image {
178 my $self = shift;
179 my ( $path, $addr ) = @_;
180
181 if ( ! -e $path ) {
182 warn "ERROR: file $path doesn't exist\n";
183 return;
184 }
185
186 my $size = -s $path || confess "no size for $path: $!";
187
188 my $buff = read_file( $path );
189
190 if ( $size == 65538 ) {
191 $addr = 0;
192 warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
193 $self->write_chunk( $addr, substr($buff,2) );
194 return 1;
195 } elsif ( $size == 32800 ) {
196 $addr = 0;
197 warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
198 $self->write_chunk( $addr, substr($buff,0x20) );
199 return 1;
200 }
201
202 printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
203 $self->write_chunk( $addr, $buff );
204 return 1;
205 };
206
207
208 =head1 Memory management
209
210 Orao implements all I/O using mmap addresses. This was main reason why
211 L<Acme::6502> was just too slow to handle it.
212
213 =cut
214
215 =head2 read
216
217 Read from memory
218
219 $byte = read( $address );
220
221 =cut
222
223 my $keyboard_none = 255;
224
225 my $keyboard = {
226 0x87FC => {
227 'right' => 16,
228 'down' => 128,
229 'up' => 192,
230 'left' => 224,
231 'backspace' => 224,
232 },
233 0x87FD => sub {
234 my $self = shift;
235 if ( $self->key_active('return') ) {
236 # M6502::_write( 0xfc, 13 );
237 warn "return\n";
238 return 0;
239 } elsif ( $self->key_active('left ctrl','right ctrl') ) {
240 warn "ctrl\n";
241 return 16;
242 }
243 return $keyboard_none;
244 },
245 0x87FA => {
246 'f4' => 16,
247 'f3' => 128,
248 'f2' => 192,
249 'f1' => 224,
250 },
251 0x87FB => sub {
252 my $self = shift;
253 if ( $self->key_active('space') ) {
254 warn "space\n";
255 return 32;
256 } elsif ( $self->key_active('left shift','right shift') ) {
257 warn "shift\n";
258 return 16;
259 # } elsif ( $self->tape ) {
260 # warn "has tape!";
261 # return 0;
262 }
263 return $keyboard_none;
264 },
265 0x87F6 => {
266 '6' => 16,
267 't' => 128,
268 'y' => 192, # hr: z
269 'r' => 224,
270 },
271 0x87F7 => {
272 '5' => 32,
273 '4' => 16,
274 },
275 0x87EE => {
276 '7' => 16,
277 'u' => 128,
278 'i' => 192,
279 'o' => 224,
280 },
281 0x87EF => {
282 '8' => 32,
283 '9' => 16,
284 },
285 0x87DE => {
286 '1' => 16,
287 'w' => 128,
288 'q' => 192,
289 'e' => 224,
290 },
291 0x87DF => {
292 '2' => 32,
293 '3' => 16,
294 },
295 0x87BE => {
296 'm' => 16,
297 'k' => 128,
298 'j' => 192,
299 'l' => 224,
300 },
301 0x87BF => {
302 ',' => 32, # <
303 '.' => 16, # >
304 },
305 0x877E => {
306 'z' => 16, # hr:y
307 's' => 128,
308 'a' => 192,
309 'd' => 224,
310 },
311 0x877F => {
312 'x' => 32,
313 'c' => 16,
314 },
315 0x86FE => {
316 'n' => 16,
317 'g' => 128,
318 'h' => 192,
319 'f' => 224,
320 },
321 0x86FF => {
322 'b' => 32,
323 'v' => 16,
324 },
325 0x85FE => {
326 '<' => 16, # :
327 '\\' => 128, # ¾
328 '\'' => 192, # æ
329 ';' => 224, # è
330 },
331 0x85FF => {
332 '/' => 32,
333 'f11' => 16, # ^
334 },
335 0x83FE => {
336 'f12' => 16, # ;
337 '[' => 128, # ¹
338 ']' => 192, # ð
339 'p' => 224,
340 },
341 0x83FF => {
342 '-' => 32,
343 '0' => 16,
344 },
345 };
346
347 sub read {
348 my $self = shift;
349 my ($addr) = @_;
350 die "address over 64k: $addr" if ( $addr > 0xffff );
351 my $byte = $mem[$addr];
352 confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
353 warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
354
355 # keyboard
356
357 if ( defined( $keyboard->{$addr} ) ) {
358 warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;
359
360 my $ret = $keyboard_none;
361 my $r = $keyboard->{$addr} || confess "no definition for keyboard port found";
362 if ( ref($r) eq 'CODE' ) {
363 $ret = $r->($self);
364 } else {
365 foreach my $k ( keys %$r ) {
366 my $return = 0;
367 if ( $self->key_active($k) ) {
368 warn "key '$k' is active\n";
369 $return ||= $r->{$k};
370 }
371 $ret = $return if $return;
372 }
373 }
374 warn sprintf("keyboard port: %04x code: %d\n",$addr,$ret) if ( $ret != $keyboard_none );
375 return $ret;
376 }
377
378 if ( $addr == 0x87ff ) {
379 return $self->read_tape;
380 }
381
382 # $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
383 return $byte;
384 }
385
386 =head2 write
387
388 Write into emory
389
390 write( $address, $byte );
391
392 =cut
393
394 sub write {
395 my $self = shift;
396 my ($addr,$byte) = @_;
397 warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
398
399 if ( $addr == 0x8800 ) {
400 $self->write_tape( $byte );
401 warn sprintf "sound ignored: %x\n", $byte;
402 }
403
404 if ( $addr > 0xafff ) {
405 confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
406 }
407
408 $self->render_vram if ( $addr >= 0x6000 && $addr <= 0x7fff );
409
410 $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
411 # $mem[$addr] = $byte;
412 return;
413 }
414
415 =head1 Architecture specific
416
417 =head2 render_vram
418
419 Render one frame of video ram
420
421 $self->render_vram;
422
423 =cut
424
425 sub render_vram {
426 my $self = shift;
427
428 # my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);
429 # my $pixels = pack("C*", map { $flip[$_] } $self->ram( 0x6000, 0x7fff ));
430 # my $pixels = M6502::mem_peek_region( 0x6000, 0x7fff );
431 my $pixels = pack('C*', map { $flip[$_] } unpack('C*', M6502::mem_peek_region( 0x6000, 0x7fff ) ) );
432
433 my $vram = SDL::Surface->new(
434 -width => 256,
435 -height => 256,
436 -depth => 1, # 1 bit per pixel
437 -pitch => 32, # bytes per line
438 -from => $pixels,
439 );
440 $vram->set_colors( 0, $black, $white );
441
442 $self->render_frame( $vram );
443 }
444
445 =head2 cpu_PC
446
447 Helper metod to set or get PC for current architecture
448
449 =cut
450
451 sub cpu_PC {
452 my ( $self, $addr ) = @_;
453 if ( defined($addr) ) {
454 $PC = $addr;
455 warn sprintf("running from PC %04x\n", $PC);
456 };
457 return $PC;
458 }
459
460
461 =head2 _init_callbacks
462
463 Mark memory areas for which we want to get callbacks to perl
464
465 =cut
466
467 sub _init_callbacks {
468 my $self = shift;
469 warn "set calbacks to perl for memory areas...\n";
470
471 # don't call for anything
472 M6502::set_all_callbacks( 0x00 );
473
474 # video ram
475 # M6502::set_write_callback( $_ ) foreach ( 0x6000 .. 0x7fff );
476 # keyboard
477 M6502::set_read_callback( $_ ) foreach ( keys %$keyboard );
478 # tape
479 M6502::set_read_callback( 0x87ff );
480 M6502::set_write_callback( 0x8800 );
481
482 my $map = '';
483 foreach ( 0 .. 0xffff ) {
484 my $cb = M6502::get_callback( $_ );
485 $map .= sprintf( "%04x: %02x\n", $_, $cb ) if $cb;
486 }
487 warn "callback map:\n$map\n";
488 }
489
490 =head1 SEE ALSO
491
492 L<VRac>, L<M6502>, L<Screen>, L<Tape>
493
494 =head1 AUTHOR
495
496 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
497
498 =head1 ACKNOWLEDGEMENTS
499
500 See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
501 info about this machine (and even hardware implementation from 2007).
502
503 =head1 COPYRIGHT & LICENSE
504
505 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
506
507 This program is free software; you can redistribute it and/or modify it
508 under the same terms as Perl itself.
509
510 =cut
511
512 1; # End of Orao

  ViewVC Help
Powered by ViewVC 1.1.26