/[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 163 by dpavlin, Sun Aug 5 20:02:14 2007 UTC revision 178 by dpavlin, Sat Sep 29 12:07:12 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 Session);  use base qw(Class::Accessor VRac Z80 Screen Prefs Session);
14  __PACKAGE__->mk_accessors(qw(booted));  __PACKAGE__->mk_accessors(qw(booted));
# 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 155  my @keymap = ( Line 158  my @keymap = (
158          'a' .. 'z',          'a' .. 'z',
159          qw/up down left right space/,          qw/up down left right space/,
160          '0' .. '9',          '0' .. '9',
161          ':', '"', ',', '=', '.', '/', 'enter', 'tab',          ':', '"', ',', '=', '.', '/', 'return', 'tab',
162          'left alt', 'delete', 'scroll lock', 'left shift'          'left alt', 'backspace', 'scroll lock', 'left shift'
163  );  );
164    
165  my $remap;  my $remap;
# Line 173  foreach my $key ( @keymap ) { Line 176  foreach my $key ( @keymap ) {
176    
177  sub key_down {  sub key_down {
178          my ( $self, $key ) = @_;          my ( $self, $key ) = @_;
179          warn "key down: $key ", $remap->{$key};          warn "registered key down: $key ", $remap->{$key};
180          $self->write( 0x2000 + $remap->{$key}, 0xfe );          $self->write( 0x2000 + $remap->{$key}, 0xfe );
181  }  }
182    
# Line 183  sub key_down { Line 186  sub key_down {
186    
187  sub key_up {  sub key_up {
188          my ( $self, $key ) = @_;          my ( $self, $key ) = @_;
189          warn "key up: $key ", $remap->{$key};          warn "registred key up: $key ", $remap->{$key};
190          $self->write( 0x2000 + $remap->{$key}, 0xff );          $self->write( 0x2000 + $remap->{$key}, 0xff );
191  }  }
192    
193  =head2 render_vram  =head2 render_vram
194    
195    Render characters as graphic
196    
197    =cut
198    
199    my $char_rom = 'rom/Galaksija/CHRGEN.BIN';
200    
201    my @chars = map { ord($_) } split(//, read_file( $char_rom ));
202    warn "loaded ", $#chars, " characters\n";
203    
204    my @char2pos;
205    
206    # maken from mess/video/galaxy.c
207    foreach my $char ( 0 .. 255 ) {
208            my $c = $char;
209            if ( ( $c > 63 && $c < 96 ) || ( $c > 127 && $c < 192 ) ) {
210                    $c -= 64;
211            } elsif ( $c > 191 ) {
212                    $c -= 128;
213            }
214            $char2pos[ $char ] = ( $c & 0x7f );
215    }
216    
217    warn dump( @char2pos );
218    
219    sub render_vram {
220            my $self = shift;
221    
222            my $t = time();
223    
224            my $addr = 0x2800;
225    
226            my @pixels = ("\x00") x ( 32 * 16 * 13 );
227            my $a = 0;
228    
229            for my $y ( 0 .. 15 ) {
230                    for my $x ( 0 .. 31 ) {
231                            my $c = $mem[ $addr++ ];
232                            $c = $char2pos[ $c ];
233                            for my $l ( 0 .. 12 ) {
234                                    my $o = $l << 5; # *32
235                                    my $co = ( $l << 7 ) | $c;
236                                    $pixels[ $a + $x + $o ] = $flip[ $chars[ $co ] ];
237                            }
238                    }
239                    $a += ( 32 * 13 ); # next line
240            }
241    
242            my $vram = SDL::Surface->new(
243                    -width => 256,
244                    -height => 256,
245                    -depth => 1,    # 1 bit per pixel
246                    -pitch => 32,   # bytes per line
247                    -from => pack("C*", @pixels),
248            );
249            $vram->set_colors( 0, $white, $black );
250    
251            $self->render_frame( $vram );
252    
253    #       $self->render_vram_text;
254    
255            printf("frame in %.2fs\n", time()-$t);
256    }
257    
258    
259    =head2 render_vram_text
260    
261  Simple hex dumper of text buffer  Simple hex dumper of text buffer
262    
263  =cut  =cut
264    
265  my $last_dump = '';  my $last_dump = '';
266    
267  sub render_vram {  sub render_vram_text {
268          my $self = shift;          my $self = shift;
269    
270          my $addr = 0x2800;          my $addr = 0x2800;
Legend:
Removed from v.163  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.26