/[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 140 by dpavlin, Sun Aug 5 01:02:59 2007 UTC revision 181 by dpavlin, Sun Sep 30 18:19:57 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; # import  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 57  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 93  sub run { Line 95  sub run {
95          my $hor_pos = 0;          my $hor_pos = 0;
96    
97          $self->loop( sub {          $self->loop( sub {
98                  Z80::exec( $_[0] );                  my $run_for = shift;
99                    Z80::exec( $run_for );
100                  if ( $hor_pos != $mem[ 0x2ba8 ] ) {                  if ( $hor_pos != $mem[ 0x2ba8 ] ) {
101                          warn "scroll 0x2ba8", $self->hexdump( 0x2ba8 );                          warn "scroll 0x2ba8", $self->hexdump( 0x2ba8 );
102                          $hor_pos = $mem[ 0x2ba8 ];                          $hor_pos = $mem[ 0x2ba8 ];
# Line 116  Read from memory Line 119  Read from memory
119    
120  =cut  =cut
121    
 my $keyboard = {};  
   
122  sub read {  sub read {
123          my $self = shift;          my $self = shift;
124          my ($addr) = @_;          my ($addr) = @_;
# Line 125  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            if ( $addr >= 0x2000 && $addr <= 0x2036 ) {
130    #               printf("## keyread 0x%04x = %02x\n", $addr, $byte);
131                    $self->key_pressed( 1 );        # force process of events
132            }
133    
134          $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;          $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
135          return $byte;          return $byte;
136  }  }
# Line 151  sub write { Line 157  sub write {
157    
158  =head1 Architecture specific  =head1 Architecture specific
159    
160    =cut
161    
162    my @keymap = (
163            'a' .. 'z',
164            qw/up down left right space/,
165            '0' .. '9',
166            ':', '"', ',', '=', '.', '/', 'return', 'tab',
167            'left alt', 'backspace', 'scroll lock', 'left shift'
168    );
169    
170    my $remap_key2addr;
171    my $o = 1;
172    
173    foreach my $key ( @keymap ) {
174            $remap_key2addr->{$key} = 0x2000 + $o;
175            $o++;
176    }
177    
178    printf("keymap is mmaped 0x%04x - 0x%04x\n", 0x2000, $o);
179    
180    =head2 key_down
181    
182    =cut
183    
184    sub key_down {
185            my ( $self, $key ) = @_;
186            if ( ! defined( $remap_key2addr->{$key} ) ) {
187                    warn "unknown key pressed: $key [ignoring]\n";
188                    return;
189            }
190            printf("registered key down: $key address: %04x\n", $remap_key2addr->{$key} );
191            $self->write( $remap_key2addr->{$key}, 0xfe );
192    }
193    
194    =head2 key_up
195    
196    =cut
197    
198    sub key_up {
199            my ( $self, $key ) = @_;
200            if ( ! defined( $remap_key2addr->{$key} ) ) {
201                    warn "unknown key released: $key [ignoring]\n";
202                    return;
203            }
204            warn "registred key up: $key ", $remap_key2addr->{$key};
205            $self->write( $remap_key2addr->{$key}, 0xff );
206    }
207    
208  =head2 render_vram  =head2 render_vram
209    
210    Render characters as graphic
211    
212    =cut
213    
214    my $char_rom = 'rom/Galaksija/CHRGEN.BIN';
215    
216    my @chars = map { ord($_) } split(//, read_file( $char_rom ));
217    warn "loaded ", $#chars, " characters\n";
218    
219    my @char2pos;
220    
221    # maken from mess/video/galaxy.c
222    foreach my $char ( 0 .. 255 ) {
223            my $c = $char;
224            if ( ( $c > 63 && $c < 96 ) || ( $c > 127 && $c < 192 ) ) {
225                    $c -= 64;
226            } elsif ( $c > 191 ) {
227                    $c -= 128;
228            }
229            $char2pos[ $char ] = ( $c & 0x7f );
230    }
231    
232    #warn "## chars2pos = ",dump( @char2pos );
233    
234    sub render_vram {
235            my $self = shift;
236    
237            my $t = time();
238    
239            my $addr = 0x2800;
240    
241            my @pixels = ("\x00") x ( 32 * 16 * 13 );
242            my $a = 0;
243    
244            for my $y ( 0 .. 15 ) {
245                    for my $x ( 0 .. 31 ) {
246                            my $c = $mem[ $addr++ ];
247                            $c = $char2pos[ $c ];
248                            for my $l ( 0 .. 12 ) {
249                                    my $o = $l << 5; # *32
250                                    my $co = ( $l << 7 ) | $c;
251                                    $pixels[ $a + $x + $o ] = $flip[ $chars[ $co ] ];
252                            }
253                    }
254                    $a += ( 32 * 13 ); # next line
255            }
256    
257            my $vram = SDL::Surface->new(
258                    -width => 256,
259                    -height => 256,
260                    -depth => 1,    # 1 bit per pixel
261                    -pitch => 32,   # bytes per line
262                    -from => pack("C*", @pixels),
263            );
264            $vram->set_colors( 0, $white, $black );
265    
266            $self->render_frame( $vram );
267    
268    #       $self->render_vram_text;
269    
270            printf("frame in %.2fs\n", time()-$t) if $self->debug;
271    }
272    
273    
274    =head2 render_vram_text
275    
276  Simple hex dumper of text buffer  Simple hex dumper of text buffer
277    
278  =cut  =cut
279    
280  my $last_dump = '';  my $last_dump = '';
281    
282  sub render_vram {  sub render_vram_text {
283          my $self = shift;          my $self = shift;
284    
285          my $addr = 0x2800;          my $addr = 0x2800;
# Line 205  L<VRac>, L<Screen>, L<Z80> Line 325  L<VRac>, L<Screen>, L<Z80>
325    
326  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
327    
 Based on Galaxy Win emulator L<http://emulator.galaksija.org/>  
   
328  =head1 BUGS  =head1 BUGS
329    
330    Galaksija Plus isn't emulated. I don't have additional rom, but I would
331    B<love> to have support for this machine. So if you have ROM for Galaksija
332    Plus, get in touch!
333    
334  =head1 ACKNOWLEDGEMENTS  =head1 ACKNOWLEDGEMENTS
335    
336  See also L<> which is source of all  Based on Galaxy emulator L<http://emulator.galaksija.org/> for Windows which
337  info about this machine (and even hardware implementation from 2007).  is in turn based on DOS version by Miodrag Jevremoviæ
338    L<http://solair.eunet.yu/~jovkovic/galaxy/>.
339    
340  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
341    
Legend:
Removed from v.140  
changed lines
  Added in v.181
  ViewVC Help
Powered by ViewVC 1.1.26