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

  ViewVC Help
Powered by ViewVC 1.1.26