/[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 168 by dpavlin, Mon Aug 6 09:19:19 2007 UTC revision 185 by dpavlin, Sun Sep 30 19:47:32 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;  use Z80;
10  use Screen;  use Screen;
11    use Time::HiRes qw/time/;
12    
13  use base qw(Class::Accessor VRac Z80 Screen Prefs Session);  use base qw(Class::Accessor VRac Z80 Screen Prefs Session);
14  __PACKAGE__->mk_accessors(qw(booted));  __PACKAGE__->mk_accessors(qw(booted));
# Line 94  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 124  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 160  my @keymap = ( Line 167  my @keymap = (
167          'left alt', 'backspace', 'scroll lock', 'left shift'          'left alt', 'backspace', 'scroll lock', 'left shift'
168  );  );
169    
170  my $remap;  my $remap_key2addr;
171  my $o = 1;  my $o = 1;
172    
173  foreach my $key ( @keymap ) {  foreach my $key ( @keymap ) {
174          $remap->{$key} = $o;          $remap_key2addr->{$key} = 0x2000 + $o;
175          $o++;          $o++;
176  }  }
177    
178    printf("keymap is mmaped 0x%04x - 0x%04x\n", 0x2000, $o);
179    
180  =head2 key_down  =head2 key_down
181    
182  =cut  =cut
183    
184  sub key_down {  sub key_down {
185          my ( $self, $key ) = @_;          my ( $self, $key ) = @_;
186          warn "key down: $key ", $remap->{$key};          if ( ! defined( $remap_key2addr->{$key} ) ) {
187          $self->write( 0x2000 + $remap->{$key}, 0xfe );                  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  =head2 key_up
# Line 184  sub key_down { Line 197  sub key_down {
197    
198  sub key_up {  sub key_up {
199          my ( $self, $key ) = @_;          my ( $self, $key ) = @_;
200          warn "key up: $key ", $remap->{$key};          if ( ! defined( $remap_key2addr->{$key} ) ) {
201          $self->write( 0x2000 + $remap->{$key}, 0xff );                  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
# Line 197  Render characters as graphic Line 214  Render characters as graphic
214  my $char_rom = 'rom/Galaksija/CHRGEN.BIN';  my $char_rom = 'rom/Galaksija/CHRGEN.BIN';
215    
216  my @chars = map { ord($_) } split(//, read_file( $char_rom ));  my @chars = map { ord($_) } split(//, read_file( $char_rom ));
217  warn "loaded ", $#chars, " characters\n";  warn "loaded ", $#chars, " bytes from $char_rom\n";
218    
219  my @char2pos;  my @char2pos;
220    
# Line 212  foreach my $char ( 0 .. 255 ) { Line 229  foreach my $char ( 0 .. 255 ) {
229          $char2pos[ $char ] = ( $c & 0x7f );          $char2pos[ $char ] = ( $c & 0x7f );
230  }  }
231    
232  warn dump( @char2pos );  #warn "## chars2pos = ",dump( @char2pos );
233    
234    sub screen_width { 256 }
235    sub screen_height { 16 * 13 }
236    
237  sub render_vram {  sub render_vram {
238          my $self = shift;          my $self = shift;
239    
240            my $t = time();
241    
242          my $addr = 0x2800;          my $addr = 0x2800;
243    
244          my @pixels = ("\x00") x ( 32 * 16 * 13 );          my @pixels = ("\x00") x ( 32 * 16 * 13 );
# Line 236  sub render_vram { Line 258  sub render_vram {
258          }          }
259    
260          my $vram = SDL::Surface->new(          my $vram = SDL::Surface->new(
261                  -width => 256,                  -width => $self->screen_width,
262                  -height => 256,                  -height => $self->screen_height,
263                  -depth => 1,    # 1 bit per pixel                  -depth => 1,    # 1 bit per pixel
264                  -pitch => 32,   # bytes per line                  -pitch => 32,   # bytes per line
265                  -from => pack("C*", @pixels),                  -from => pack("C*", @pixels),
# Line 247  sub render_vram { Line 269  sub render_vram {
269          $self->render_frame( $vram );          $self->render_frame( $vram );
270    
271  #       $self->render_vram_text;  #       $self->render_vram_text;
272    
273            printf("frame in %.2fs\n", time()-$t) if $self->debug;
274  }  }
275    
276    
Legend:
Removed from v.168  
changed lines
  Added in v.185
  ViewVC Help
Powered by ViewVC 1.1.26