/[VRac]/Screen.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 /Screen.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 171 by dpavlin, Mon Aug 6 11:40:21 2007 UTC revision 183 by dpavlin, Sun Sep 30 19:31:14 2007 UTC
# Line 17  use Exporter 'import'; Line 17  use Exporter 'import';
17  our @EXPORT = qw'$white $black @flip';  our @EXPORT = qw'$white $black @flip';
18    
19  use base qw(Class::Accessor Prefs);  use base qw(Class::Accessor Prefs);
20  __PACKAGE__->mk_accessors(qw(app event));  __PACKAGE__->mk_accessors(qw(app event screen_width screen_height));
21    
22  =head1 NAME  =head1 NAME
23    
24  Screen - simulated 256*256 pixels monochrome screen using SDL  Screen - simulated monochrome screen using SDL
25    
26  =head1 Architecture dependent  =head1 Architecture dependent
27    
28  You may override following methods if you want to implement keyboard on each  You may override following methods if you want to implement keyboard on each
29  keypress event. Alternative is to use <read> hook and trap memory access.  keypress event. Alternative is to use <read> hook and trap memory access.
30    
31    =head2 screen_width
32    
33    Width of emulated screen (256 by default)
34    
35    =head2 screen_height
36    
37    Height of emulated screen (256 by default)
38    
39  =head2 key_down  =head2 key_down
40    
41    $self->key_down( 'a' );    $self->key_down( 'a' );
# Line 68  sub open_screen { Line 76  sub open_screen {
76                  warn "using default unscaled display\n";                  warn "using default unscaled display\n";
77          }          }
78    
79            $self->screen_width( 256 ) unless defined $self->screen_width;
80            $self->screen_height( 256 ) unless defined $self->screen_height;
81    
82          $app = SDL::App->new(          $app = SDL::App->new(
83                  -width  => 256 * $self->scale + ( $self->show_mem ? 256 : 0 ),                  -width  => $self->screen_width * $self->scale + ( $self->show_mem ? 256 : 0 ),
84                  -height => 256 * $self->scale,                  -height => $self->screen_height * $self->scale,
85                  -depth  => 16,                  -depth  => 16,
86                  -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,                  -flags=>SDL_DOUBLEBUF | SDL_HWSURFACE | SDL_HWACCEL,
87          );          );
# Line 83  sub open_screen { Line 94  sub open_screen {
94          my $event = SDL::Event->new();          my $event = SDL::Event->new();
95          $self->event( $event );          $self->event( $event );
96    
97          warn "# created SDL::App\n";          warn "# created SDL::App with screen ", $self->screen_width, "x", $self->screen_height, "\n";
98  }  }
99    
100  our $white      = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff );  our $white      = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff );
# Line 105  sub mem_xy { Line 116  sub mem_xy {
116          my $self = shift;          my $self = shift;
117          my $offset = shift;          my $offset = shift;
118          my $x = $offset & 0xff;          my $x = $offset & 0xff;
119          $x += 256 * $self->scale;          $x += $self->screen_width * $self->scale;
120          my $y = $offset >> 8;          my $y = $offset >> 8;
121          return ($x,$y);          return ($x,$y);
122  }  }
# Line 181  sub render_frame { Line 192  sub render_frame {
192    
193          my $scale = $self->scale || confess "no scale?";          my $scale = $self->scale || confess "no scale?";
194    
195          my $rect        = SDL::Rect->new( -x => 0, -y => 0, -width => 256 * $scale, -height => 256 * $scale );          my $rect        = SDL::Rect->new( -x => 0, -y => 0, -width => $self->screen_width * $scale, -height => $self->screen_height * $scale
196          my $rect_screen = SDL::Rect->new( -x => 0, -y => 0, -width => 256 * $scale, -height => 256 * $scale );          );
197            my $rect_screen = SDL::Rect->new( -x => 0, -y => 0, -width => $self->screen_width * $scale, -height => $self->screen_height * $scale );
198    
199          if ( $scale > 1 ) {          if ( $scale > 1 ) {
200                  use SDL::Tool::Graphic;                  use SDL::Tool::Graphic;
# Line 223  sub render_mem { Line 235  sub render_mem {
235    
236          $vram->display_format;          $vram->display_format;
237    
238          my $rect     = SDL::Rect->new( -x => 0, -y => 0, -width => 256, -height => 256 );          my $rect     = SDL::Rect->new( -x => 0, -y => 0, -width => $self->screen_width, -height => $self->screen_height );
239          my $rect_mem = SDL::Rect->new( -x => 256 * $self->scale, -y => 0, -width => 256, -height => 256 );          my $rect_mem = SDL::Rect->new( -x => $self->screen_width * $self->scale, -y => 0, -width => 256, -height => 256 );
240    
241          $vram->blit( $rect, $app, $rect_mem );          $vram->blit( $rect, $app, $rect_mem );
242    
Legend:
Removed from v.171  
changed lines
  Added in v.183
  ViewVC Help
Powered by ViewVC 1.1.26