/[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 165 by dpavlin, Mon Aug 6 07:04:40 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    
12  use base qw(Class::Accessor VRac Z80 Screen Prefs);  use base qw(Class::Accessor VRac Z80 Screen Prefs Session);
13  __PACKAGE__->mk_accessors(qw(booted));  __PACKAGE__->mk_accessors(qw(booted));
14    
15  =head1 NAME  =head1 NAME
# Line 17  Galaksija - Galaksija emulator Line 18  Galaksija - Galaksija emulator
18    
19  =head1 VERSION  =head1 VERSION
20    
21  Version 0.00  Version 0.01
22    
23  =cut  =cut
24    
25  our $VERSION = '0.00';  our $VERSION = '0.01';
26    
27  =head1 SUMMARY  =head1 SUMMARY
28    
# Line 39  our $emu; Line 40  our $emu;
40    
41  sub run {  sub run {
42          my $self = shift;          my $self = shift;
43          warn "Galaksija calling upstream init\n";  
44            warn "Galaksija $Galaksija::VERSION emulation starting\n";
45    
46            $self->show_mem( 1 );
47            #$self->trace( 1 );
48    
49          $self->SUPER::init(          $self->SUPER::init(
50                  read => sub { $self->read( @_ ) },                  read => sub { $self->read( @_ ) },
51                  write => sub { $self->write( @_ ) },                  write => sub { $self->write( @_ ) },
52          );          );
53    
         warn "Galaksija $Galaksija::VERSION emulation starting\n";  
   
         warn "emulating ", $#mem, " bytes of memory\n";  
   
54          for my $a ( 0x1000 .. 0x2000 ) {          for my $a ( 0x1000 .. 0x2000 ) {
55                  $mem[$a] = 0xff;                  $mem[$a] = 0xff;
56          }          }
# Line 56  sub run { Line 58  sub run {
58          $self->open_screen;          $self->open_screen;
59          $self->load_rom({          $self->load_rom({
60                  0x0000, 'rom/Galaksija/ROM1.BIN',                  0x0000, 'rom/Galaksija/ROM1.BIN',
61                  0x2000, 'rom/Galaksija/ROM2.BIN',                  0x1000, 'rom/Galaksija/ROM2.BIN',
62  #               0xE000, 'rom/Galaksija/GAL_PLUS.BIN',  #               0xE000, 'rom/Galaksija/GAL_PLUS.BIN',
63          });          });
64    
# Line 64  sub run { Line 66  sub run {
66          $mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );          $mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );
67    
68          # display          # display
69          $mem[$_] = ' '  foreach ( 0x2800 .. 0x2a00 );          $mem[$_] = 0x20 foreach ( 0x2800 .. 0x2a00 );
70    
71          # 6116-ice          # 6116-ice
72          $mem[$_] = 0    foreach ( 0x2a00 .. 0x4000 );          $mem[$_] = 0    foreach ( 0x2a00 .. 0x4000 );
# Line 75  sub run { Line 77  sub run {
77          $self->trace( 0 );          $self->trace( 0 );
78          $self->debug( 0 );          $self->debug( 0 );
79    
80          warn "rendering video memory\n";          warn "rendering memory\n";
81          #$self->render_vram( @mem[ 0x2800 .. 0x2a00 ] );          $self->render_mem( @mem );
82    
83          #$self->sync;          #$self->sync;
84          $self->trace( $trace );          $self->trace( $trace );
# Line 89  sub run { Line 91  sub run {
91    
92          Z80::reset();          Z80::reset();
93    
94            my $hor_pos = 0;
95    
96          $self->loop( sub {          $self->loop( sub {
97                  Z80::exec( $_[0] );                  Z80::exec( $_[0] );
98                  #$self->render_vram;                  if ( $hor_pos != $mem[ 0x2ba8 ] ) {
99                            warn "scroll 0x2ba8", $self->hexdump( 0x2ba8 );
100                            $hor_pos = $mem[ 0x2ba8 ];
101                    }
102                    $self->render_vram;
103          });          });
104    
105  }  }
# Line 99  sub run { Line 107  sub run {
107    
108  =head1 Memory management  =head1 Memory management
109    
 Galaksija implements all I/O using mmap addresses. This was main reason why  
 L<Acme::6502> was just too slow to handle it.  
   
110  =cut  =cut
111    
112  =head2 read  =head2 read
# Line 112  Read from memory Line 117  Read from memory
117    
118  =cut  =cut
119    
 my $keyboard_none = 255;  
   
 my $keyboard = {};  
   
120  sub read {  sub read {
121          my $self = shift;          my $self = shift;
122          my ($addr) = @_;          my ($addr) = @_;
# Line 123  sub read { Line 124  sub read {
124          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);
125          warn sprintf("# Galaksija::read(%04x) = %02x\n", $addr, $byte) if $self->trace;          warn sprintf("# Galaksija::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
126    
127            $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
128          return $byte;          return $byte;
129  }  }
130    
# Line 139  sub write { Line 141  sub write {
141          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
142          warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;          warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
143    
144            return if ( $addr > 0x4000 );
145    
146            $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
147          $mem[$addr] = $byte;          $mem[$addr] = $byte;
148          return;          return;
149  }  }
150    
151    =head1 Architecture specific
152    
153    =cut
154    
155    my @keymap = (
156            'a' .. 'z',
157            qw/up down left right space/,
158            '0' .. '9',
159            ':', '"', ',', '=', '.', '/', 'enter', 'tab',
160            'left alt', 'delete', 'scroll lock', 'left shift'
161    );
162    
163    my $remap;
164    my $o = 1;
165    
166    foreach my $key ( @keymap ) {
167            $remap->{$key} = $o;
168            $o++;
169    }
170    
171    =head2 key_down
172    
173    =cut
174    
175    sub key_down {
176            my ( $self, $key ) = @_;
177            warn "key down: $key ", $remap->{$key};
178            $self->write( 0x2000 + $remap->{$key}, 0xfe );
179    }
180    
181    =head2 key_up
182    
183    =cut
184    
185    sub key_up {
186            my ( $self, $key ) = @_;
187            warn "key up: $key ", $remap->{$key};
188            $self->write( 0x2000 + $remap->{$key}, 0xff );
189    }
190    
191    =head2 render_vram
192    
193    Render characters as graphic
194    
195    =cut
196    
197    my $char_rom = 'rom/Galaksija/CHRGEN.BIN';
198    
199    my @chars = map { ord($_) } split(//, read_file( $char_rom ));
200    warn "loaded ", $#chars, " characters\n";
201    
202    my @char2pos;
203    
204    # maken from mess/video/galaxy.c
205    foreach my $char ( 0 .. 255 ) {
206            my $c = $char;
207            if ( ( $c > 63 && $c < 96 ) || ( $c > 127 && $c < 192 ) ) {
208                    $c -= 64;
209            } elsif ( $c > 191 ) {
210                    $c -= 128;
211            }
212            $char2pos[ $char ] = ( $c & 0x7f );
213    }
214    
215    warn dump( @char2pos );
216    
217    sub render_vram {
218            my $self = shift;
219    
220            my $addr = 0x2800;
221    
222            my @pixels = ("\x00") x ( 32 * 16 * 13 );
223            my $a = 0;
224    
225            for my $y ( 0 .. 15 ) {
226                    for my $x ( 0 .. 31 ) {
227                            my $c = $mem[ $addr++ ];
228                            $c = $char2pos[ $c ];
229                            for my $l ( 0 .. 12 ) {
230                                    my $o = $l << 5; # *32
231                                    my $co = ( $l << 7 ) | $c;
232                                    $pixels[ $a + $x + $o ] = $flip[ $chars[ $co ] ];
233                            }
234                    }
235                    $a += ( 32 * 13 ); # next line
236            }
237    
238            my $vram = SDL::Surface->new(
239                    -width => 256,
240                    -height => 256,
241                    -depth => 1,    # 1 bit per pixel
242                    -pitch => 32,   # bytes per line
243                    -from => pack("C*", @pixels),
244            );
245            $vram->set_colors( 0, $black, $white );
246    
247            $self->render_frame( $vram );
248    
249    #       $self->render_vram_text;
250    }
251    
252    
253    =head2 render_vram_text
254    
255    Simple hex dumper of text buffer
256    
257    =cut
258    
259    my $last_dump = '';
260    
261    sub render_vram_text {
262            my $self = shift;
263    
264            my $addr = 0x2800;
265    
266            my $dump;
267    
268            for my $y ( 0 .. 15 ) {
269    #               $dump .= sprintf "%2d: %s\n",$y, join('', map { sprintf("%02x ",$_) } @mem[ $addr .. $addr+31 ] );
270                    $dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr .. $addr+31 ] );
271                    $addr += 32;
272            }
273    
274            if ( $mem[ 0x2bb0 ] ) {
275                    warn "scroll", $self->hexdump( 0x2bb0 );
276            }
277    
278            if ( $dump ne $last_dump ) {
279                    print $dump;
280                    $last_dump = $dump;
281            }
282    }
283    
284    =head2 cpu_PC
285    
286    Helper metod to set or get PC for current architecture
287    
288    =cut
289    
290    sub cpu_PC {
291            my ( $self, $addr ) = @_;
292            if ( defined($addr) ) {
293                    $PC = $addr;
294                    warn sprintf("running from PC %04x\n", $PC);
295            };
296            return $PC;
297    }
298    
299    =head1 SEE ALSO
300    
301    L<VRac>, L<Screen>, L<Z80>
302    
303  =head1 AUTHOR  =head1 AUTHOR
304    
305  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
306    
307  =head1 BUGS  =head1 BUGS
308    
309    Galaksija Plus isn't emulated. I don't have additional rom, but I would
310    B<love> to have support for this machine. So if you have ROM for Galaksija
311    Plus, get in touch!
312    
313  =head1 ACKNOWLEDGEMENTS  =head1 ACKNOWLEDGEMENTS
314    
315  See also L<> which is source of all  Based on Galaxy emulator L<http://emulator.galaksija.org/> for Windows which
316  info about this machine (and even hardware implementation from 2007).  is in turn based on DOS version by Miodrag Jevremoviæ
317    L<http://solair.eunet.yu/~jovkovic/galaxy/>.
318    
319  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
320    
Legend:
Removed from v.130  
changed lines
  Added in v.165
  ViewVC Help
Powered by ViewVC 1.1.26