/[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 164 by dpavlin, Mon Aug 6 06:38:18 2007 UTC
# Line 7  use Carp qw/confess/; Line 7  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; # import
10    use Screen qw/$white $black/;
11    
12  use base qw(Class::Accessor VRac Z80 Screen Prefs Session);  use base qw(Class::Accessor VRac Z80 Screen Prefs Session);
13  __PACKAGE__->mk_accessors(qw(booted));  __PACKAGE__->mk_accessors(qw(booted));
# Line 57  sub run { Line 58  sub run {
58          $self->open_screen;          $self->open_screen;
59          $self->load_rom({          $self->load_rom({
60                  0x0000, 'rom/Galaksija/ROM1.BIN',                  0x0000, 'rom/Galaksija/ROM1.BIN',
61                  0x2000, 'rom/Galaksija/ROM2.BIN',                  0x1000, 'rom/Galaksija/ROM2.BIN',
62  #               0xE000, 'rom/Galaksija/GAL_PLUS.BIN',  #               0xE000, 'rom/Galaksija/GAL_PLUS.BIN',
63          });          });
64    
# Line 189  sub key_up { Line 190  sub key_up {
190    
191  =head2 render_vram  =head2 render_vram
192    
193    Render characters as graphic
194    
195    =cut
196    
197    my $char_rom = 'rom/Galaksija/CHRGEN.BIN';
198    
199    my @chars = map { ord($_) } split(//, read_file( $char_rom ));
200    warn "loaded ", $#chars, " characters\n";
201    
202    my @char2pos;
203    
204    # maken from mess/video/galaxy.c
205    foreach my $char ( 0 .. 255 ) {
206            my $c = $char;
207            if ( ( $c > 63 && $c < 96 ) || ( $c > 127 && $c < 192 ) ) {
208                    $c -= 64;
209            } elsif ( $c > 191 ) {
210                    $c -= 128;
211            }
212            $char2pos[ $char ] = ( $c & 0x7f );
213    }
214    
215    warn dump( @char2pos );
216    
217    sub render_vram {
218            my $self = shift;
219    
220            my $addr = 0x2800;
221    
222            my @pixels = ("\x00") x ( 32 * 16 * 13 );
223            my $a = 0;
224    
225            for my $y ( 0 .. 15 ) {
226                    for my $x ( 0 .. 31 ) {
227                            my $c = $mem[ $addr++ ];
228                            $c = $char2pos[ $c ];
229                            for my $l ( 0 .. 12 ) {
230                                    my $o = $l << 5; # *32
231                                    my $co = ( $l << 7 ) | $c;
232                                    $pixels[ $a + $x + $o ] = $chars[ $co ];
233                            }
234                    }
235                    $a += ( 32 * 13 ); # next line
236            }
237    
238            my $vram = SDL::Surface->new(
239                    -width => 256,
240                    -height => 256,
241                    -depth => 1,    # 1 bit per pixel
242                    -pitch => 32,   # bytes per line
243                    -from => pack("C*", @pixels),
244            );
245            $vram->set_colors( 0, $black, $white );
246    
247            $self->render_frame( $vram );
248    
249    #       $self->render_vram_text;
250    }
251    
252    
253    =head2 render_vram_text
254    
255  Simple hex dumper of text buffer  Simple hex dumper of text buffer
256    
257  =cut  =cut
258    
259  my $last_dump = '';  my $last_dump = '';
260    
261  sub render_vram {  sub render_vram_text {
262          my $self = shift;          my $self = shift;
263    
264          my $addr = 0x2800;          my $addr = 0x2800;

Legend:
Removed from v.163  
changed lines
  Added in v.164

  ViewVC Help
Powered by ViewVC 1.1.26