/[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 148 by dpavlin, Sun Aug 5 14:08:01 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; # import
10    
11  use base qw(Class::Accessor VRac Z80 Screen Prefs);  use base qw(Class::Accessor VRac Z80 Screen Prefs);
12  __PACKAGE__->mk_accessors(qw(booted));  __PACKAGE__->mk_accessors(qw(booted));
# Line 39  our $emu; Line 39  our $emu;
39    
40  sub run {  sub run {
41          my $self = shift;          my $self = shift;
42          warn "Galaksija calling upstream init\n";  
43            warn "Galaksija $Galaksija::VERSION emulation starting\n";
44    
45            $self->show_mem( 1 );
46            #$self->trace( 1 );
47    
48          $self->SUPER::init(          $self->SUPER::init(
49                  read => sub { $self->read( @_ ) },                  read => sub { $self->read( @_ ) },
50                  write => sub { $self->write( @_ ) },                  write => sub { $self->write( @_ ) },
51          );          );
52    
         warn "Galaksija $Galaksija::VERSION emulation starting\n";  
   
         warn "emulating ", $#mem, " bytes of memory\n";  
   
53          for my $a ( 0x1000 .. 0x2000 ) {          for my $a ( 0x1000 .. 0x2000 ) {
54                  $mem[$a] = 0xff;                  $mem[$a] = 0xff;
55          }          }
# Line 64  sub run { Line 65  sub run {
65          $mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );          $mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );
66    
67          # display          # display
68          $mem[$_] = ' '  foreach ( 0x2800 .. 0x2a00 );          $mem[$_] = 0x20 foreach ( 0x2800 .. 0x2a00 );
69    
70          # 6116-ice          # 6116-ice
71          $mem[$_] = 0    foreach ( 0x2a00 .. 0x4000 );          $mem[$_] = 0    foreach ( 0x2a00 .. 0x4000 );
# Line 75  sub run { Line 76  sub run {
76          $self->trace( 0 );          $self->trace( 0 );
77          $self->debug( 0 );          $self->debug( 0 );
78    
79          warn "rendering video memory\n";          warn "rendering memory\n";
80          #$self->render_vram( @mem[ 0x2800 .. 0x2a00 ] );          $self->render_mem( @mem );
81    
82          #$self->sync;          #$self->sync;
83          $self->trace( $trace );          $self->trace( $trace );
# Line 89  sub run { Line 90  sub run {
90    
91          Z80::reset();          Z80::reset();
92    
93            my $hor_pos = 0;
94    
95          $self->loop( sub {          $self->loop( sub {
96                  Z80::exec( $_[0] );                  Z80::exec( $_[0] );
97                  #$self->render_vram;                  if ( $hor_pos != $mem[ 0x2ba8 ] ) {
98                            warn "scroll 0x2ba8", $self->hexdump( 0x2ba8 );
99                            $hor_pos = $mem[ 0x2ba8 ];
100                    }
101                    $self->render_vram;
102          });          });
103    
104  }  }
# Line 99  sub run { Line 106  sub run {
106    
107  =head1 Memory management  =head1 Memory management
108    
 Galaksija implements all I/O using mmap addresses. This was main reason why  
 L<Acme::6502> was just too slow to handle it.  
   
109  =cut  =cut
110    
111  =head2 read  =head2 read
# Line 112  Read from memory Line 116  Read from memory
116    
117  =cut  =cut
118    
 my $keyboard_none = 255;  
   
119  my $keyboard = {};  my $keyboard = {};
120    
121  sub read {  sub read {
# Line 123  sub read { Line 125  sub read {
125          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);
126          warn sprintf("# Galaksija::read(%04x) = %02x\n", $addr, $byte) if $self->trace;          warn sprintf("# Galaksija::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
127    
128            $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
129          return $byte;          return $byte;
130  }  }
131    
# Line 139  sub write { Line 142  sub write {
142          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
143          warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;          warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
144    
145            return if ( $addr > 0x4000 );
146    
147            $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
148          $mem[$addr] = $byte;          $mem[$addr] = $byte;
149          return;          return;
150  }  }
151    
152    =head1 Architecture specific
153    
154    =head2 render_vram
155    
156    Simple hex dumper of text buffer
157    
158    =cut
159    
160    my $last_dump = '';
161    
162    sub render_vram {
163            my $self = shift;
164    
165            my $addr = 0x2800;
166    
167            my $dump;
168    
169            for my $y ( 0 .. 15 ) {
170    #               $dump .= sprintf "%2d: %s\n",$y, join('', map { sprintf("%02x ",$_) } @mem[ $addr .. $addr+31 ] );
171                    $dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr .. $addr+31 ] );
172                    $addr += 32;
173            }
174    
175            if ( $mem[ 0x2bb0 ] ) {
176                    warn "scroll", $self->hexdump( 0x2bb0 );
177            }
178    
179            if ( $dump ne $last_dump ) {
180                    print $dump;
181                    $last_dump = $dump;
182            }
183    }
184    
185    =head2 cpu_PC
186    
187    Helper metod to set or get PC for current architecture
188    
189    =cut
190    
191    sub cpu_PC {
192            my ( $self, $addr ) = @_;
193            if ( defined($addr) ) {
194                    $PC = $addr;
195                    warn sprintf("running from PC %04x\n", $PC);
196            };
197            return $PC;
198    }
199    
200    =head1 SEE ALSO
201    
202    L<VRac>, L<Screen>, L<Z80>
203    
204  =head1 AUTHOR  =head1 AUTHOR
205    
206  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
207    
208  =head1 BUGS  =head1 BUGS
209    
210    Galaksija Plus isn't emulated. I don't have additional rom, but I would
211    B<love> to have support for this machine. So if you have ROM for Galaksija
212    Plus, get in touch!
213    
214  =head1 ACKNOWLEDGEMENTS  =head1 ACKNOWLEDGEMENTS
215    
216  See also L<> which is source of all  Based on Galaxy emulator L<http://emulator.galaksija.org/> for Windows which
217  info about this machine (and even hardware implementation from 2007).  is in turn based on DOS version by Miodrag Jevremoviæ
218    L<http://solair.eunet.yu/~jovkovic/galaxy/>.
219    
220  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
221    
Legend:
Removed from v.130  
changed lines
  Added in v.148
  ViewVC Help
Powered by ViewVC 1.1.26