/[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

Diff of /Galaksija.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 130 by dpavlin, Sat Aug 4 20:34:59 2007 UTC revision 178 by dpavlin, Sat Sep 29 12:07:12 2007 UTC
# Line 6  use strict; Line 6  use strict;
6  use Carp qw/confess/;  use Carp qw/confess/;
7  use File::Slurp;  use File::Slurp;
8  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
9  use Z80 qw'@mem';  use Z80;
10    use Screen;
11    use Time::HiRes qw/time/;
12    
13  use base qw(Class::Accessor VRac Z80 Screen Prefs);  use base qw(Class::Accessor VRac Z80 Screen Prefs Session);
14  __PACKAGE__->mk_accessors(qw(booted));  __PACKAGE__->mk_accessors(qw(booted));
15    
16  =head1 NAME  =head1 NAME
# Line 17  Galaksija - Galaksija emulator Line 19  Galaksija - Galaksija emulator
19    
20  =head1 VERSION  =head1 VERSION
21    
22  Version 0.00  Version 0.01
23    
24  =cut  =cut
25    
26  our $VERSION = '0.00';  our $VERSION = '0.01';
27    
28  =head1 SUMMARY  =head1 SUMMARY
29    
# Line 39  our $emu; Line 41  our $emu;
41    
42  sub run {  sub run {
43          my $self = shift;          my $self = shift;
44          warn "Galaksija calling upstream init\n";  
45            warn "Galaksija $Galaksija::VERSION emulation starting\n";
46    
47            $self->show_mem( 1 );
48            #$self->trace( 1 );
49    
50          $self->SUPER::init(          $self->SUPER::init(
51                  read => sub { $self->read( @_ ) },                  read => sub { $self->read( @_ ) },
52                  write => sub { $self->write( @_ ) },                  write => sub { $self->write( @_ ) },
53          );          );
54    
         warn "Galaksija $Galaksija::VERSION emulation starting\n";  
   
         warn "emulating ", $#mem, " bytes of memory\n";  
   
55          for my $a ( 0x1000 .. 0x2000 ) {          for my $a ( 0x1000 .. 0x2000 ) {
56                  $mem[$a] = 0xff;                  $mem[$a] = 0xff;
57          }          }
# Line 56  sub run { Line 59  sub run {
59          $self->open_screen;          $self->open_screen;
60          $self->load_rom({          $self->load_rom({
61                  0x0000, 'rom/Galaksija/ROM1.BIN',                  0x0000, 'rom/Galaksija/ROM1.BIN',
62                  0x2000, 'rom/Galaksija/ROM2.BIN',                  0x1000, 'rom/Galaksija/ROM2.BIN',
63  #               0xE000, 'rom/Galaksija/GAL_PLUS.BIN',  #               0xE000, 'rom/Galaksija/GAL_PLUS.BIN',
64          });          });
65    
# Line 64  sub run { Line 67  sub run {
67          $mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );          $mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );
68    
69          # display          # display
70          $mem[$_] = ' '  foreach ( 0x2800 .. 0x2a00 );          $mem[$_] = 0x20 foreach ( 0x2800 .. 0x2a00 );
71    
72          # 6116-ice          # 6116-ice
73          $mem[$_] = 0    foreach ( 0x2a00 .. 0x4000 );          $mem[$_] = 0    foreach ( 0x2a00 .. 0x4000 );
# Line 75  sub run { Line 78  sub run {
78          $self->trace( 0 );          $self->trace( 0 );
79          $self->debug( 0 );          $self->debug( 0 );
80    
81          warn "rendering video memory\n";          warn "rendering memory\n";
82          #$self->render_vram( @mem[ 0x2800 .. 0x2a00 ] );          $self->render_mem( @mem );
83    
84          #$self->sync;          #$self->sync;
85          $self->trace( $trace );          $self->trace( $trace );
# Line 89  sub run { Line 92  sub run {
92    
93          Z80::reset();          Z80::reset();
94    
95            my $hor_pos = 0;
96    
97          $self->loop( sub {          $self->loop( sub {
98                  Z80::exec( $_[0] );                  my $run_for = shift;
99                  #$self->render_vram;                  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  }  }
# Line 99  sub run { Line 109  sub run {
109    
110  =head1 Memory management  =head1 Memory management
111    
 Galaksija implements all I/O using mmap addresses. This was main reason why  
 L<Acme::6502> was just too slow to handle it.  
   
112  =cut  =cut
113    
114  =head2 read  =head2 read
# Line 112  Read from memory Line 119  Read from memory
119    
120  =cut  =cut
121    
 my $keyboard_none = 255;  
   
 my $keyboard = {};  
   
122  sub read {  sub read {
123          my $self = shift;          my $self = shift;
124          my ($addr) = @_;          my ($addr) = @_;
# Line 123  sub read { Line 126  sub read {
126          confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);          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;          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;          return $byte;
131  }  }
132    
# Line 139  sub write { Line 143  sub write {
143          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
144          warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;          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;          $mem[$addr] = $byte;
150          return;          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  =head1 AUTHOR
310    
311  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
312    
313  =head1 BUGS  =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  =head1 ACKNOWLEDGEMENTS
320    
321  See also L<> which is source of all  Based on Galaxy emulator L<http://emulator.galaksija.org/> for Windows which
322  info about this machine (and even hardware implementation from 2007).  is in turn based on DOS version by Miodrag Jevremoviæ
323    L<http://solair.eunet.yu/~jovkovic/galaxy/>.
324    
325  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
326    
Legend:
Removed from v.130  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.26