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

  ViewVC Help
Powered by ViewVC 1.1.26