/[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 137 by dpavlin, Sat Aug 4 22:40:14 2007 UTC revision 163 by dpavlin, Sun Aug 5 20:02:14 2007 UTC
# Line 8  use File::Slurp; Line 8  use File::Slurp;
8  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
9  use Z80; # import  use Z80; # import
10    
11  use base qw(Class::Accessor VRac Z80 Screen Prefs);  use base qw(Class::Accessor VRac Z80 Screen Prefs Session);
12  __PACKAGE__->mk_accessors(qw(booted));  __PACKAGE__->mk_accessors(qw(booted));
13    
14  =head1 NAME  =head1 NAME
# Line 17  Galaksija - Galaksija emulator Line 17  Galaksija - Galaksija emulator
17    
18  =head1 VERSION  =head1 VERSION
19    
20  Version 0.00  Version 0.01
21    
22  =cut  =cut
23    
24  our $VERSION = '0.00';  our $VERSION = '0.01';
25    
26  =head1 SUMMARY  =head1 SUMMARY
27    
# Line 65  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 90  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                    if ( $hor_pos != $mem[ 0x2ba8 ] ) {
98                            warn "scroll 0x2ba8", $self->hexdump( 0x2ba8 );
99                            $hor_pos = $mem[ 0x2ba8 ];
100                    }
101                  $self->render_vram;                  $self->render_vram;
102          });          });
103    
# Line 110  Read from memory Line 116  Read from memory
116    
117  =cut  =cut
118    
 my $keyboard_none = 255;  
   
 my $keyboard = {};  
   
119  sub read {  sub read {
120          my $self = shift;          my $self = shift;
121          my ($addr) = @_;          my ($addr) = @_;
# Line 138  sub write { Line 140  sub write {
140          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
141          warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;          warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
142    
143            return if ( $addr > 0x4000 );
144    
145          $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;          $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
146          $mem[$addr] = $byte;          $mem[$addr] = $byte;
147          return;          return;
# Line 145  sub write { Line 149  sub write {
149    
150  =head1 Architecture specific  =head1 Architecture specific
151    
152    =cut
153    
154    my @keymap = (
155            'a' .. 'z',
156            qw/up down left right space/,
157            '0' .. '9',
158            ':', '"', ',', '=', '.', '/', 'enter', 'tab',
159            'left alt', 'delete', 'scroll lock', 'left shift'
160    );
161    
162    my $remap;
163    my $o = 1;
164    
165    foreach my $key ( @keymap ) {
166            $remap->{$key} = $o;
167            $o++;
168    }
169    
170    =head2 key_down
171    
172    =cut
173    
174    sub key_down {
175            my ( $self, $key ) = @_;
176            warn "key down: $key ", $remap->{$key};
177            $self->write( 0x2000 + $remap->{$key}, 0xfe );
178    }
179    
180    =head2 key_up
181    
182    =cut
183    
184    sub key_up {
185            my ( $self, $key ) = @_;
186            warn "key up: $key ", $remap->{$key};
187            $self->write( 0x2000 + $remap->{$key}, 0xff );
188    }
189    
190  =head2 render_vram  =head2 render_vram
191    
192  Simple hex dumper of text buffer  Simple hex dumper of text buffer
193    
194  =cut  =cut
195    
196    my $last_dump = '';
197    
198  sub render_vram {  sub render_vram {
199          my $self = shift;          my $self = shift;
200    
201          my $addr = 0x2800;          my $addr = 0x2800;
202    
203          print " "; # FIXME auch!          my $dump;
204    
205          for my $y ( 0 .. 15 ) {          for my $y ( 0 .. 15 ) {
206                  printf "%2d: %s\n",$y, join('', map { sprintf("%02x ",$_) } @mem[ $addr .. $addr+31 ] );  #               $dump .= sprintf "%2d: %s\n",$y, join('', map { sprintf("%02x ",$_) } @mem[ $addr .. $addr+31 ] );
207                    $dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr .. $addr+31 ] );
208                  $addr += 32;                  $addr += 32;
209          }          }
210    
211            if ( $mem[ 0x2bb0 ] ) {
212                    warn "scroll", $self->hexdump( 0x2bb0 );
213            }
214    
215            if ( $dump ne $last_dump ) {
216                    print $dump;
217                    $last_dump = $dump;
218            }
219  }  }
220    
221  =head2 cpu_PC  =head2 cpu_PC
# Line 186  L<VRac>, L<Screen>, L<Z80> Line 241  L<VRac>, L<Screen>, L<Z80>
241    
242  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
243    
 Based on Galaxy Win emulator L<http://emulator.galaksija.org/>  
   
244  =head1 BUGS  =head1 BUGS
245    
246    Galaksija Plus isn't emulated. I don't have additional rom, but I would
247    B<love> to have support for this machine. So if you have ROM for Galaksija
248    Plus, get in touch!
249    
250  =head1 ACKNOWLEDGEMENTS  =head1 ACKNOWLEDGEMENTS
251    
252  See also L<> which is source of all  Based on Galaxy emulator L<http://emulator.galaksija.org/> for Windows which
253  info about this machine (and even hardware implementation from 2007).  is in turn based on DOS version by Miodrag Jevremoviæ
254    L<http://solair.eunet.yu/~jovkovic/galaxy/>.
255    
256  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
257    
Legend:
Removed from v.137  
changed lines
  Added in v.163
  ViewVC Help
Powered by ViewVC 1.1.26