/[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

Annotation of /Screen.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 32 - (hide annotations)
Mon Jul 30 18:37:37 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Screen.pm
File size: 2476 byte(s)
comming along nicely: implement parts of memory maps
1 dpavlin 29 package Screen;
2    
3     # Dobrica Pavlinusic, <dpavlin@rot13.org> 07/30/07 17:58:55 CEST
4    
5     use strict;
6     use warnings;
7    
8     use SDL::App;
9     use SDL::Rect;
10     use SDL::Color;
11    
12     use base qw(Class::Accessor);
13     __PACKAGE__->mk_accessors(qw(debug scale show_mem run_for mem_dump trace));
14    
15 dpavlin 30 =head2 open_screen
16 dpavlin 29
17     Open simulated screen
18    
19     =cut
20    
21     our $app;
22    
23 dpavlin 30 sub open_screen {
24 dpavlin 29 my $self = shift;
25 dpavlin 31
26     if ( ! $self->scale ) {
27     $self->scale( 1 );
28     warn "using default unscaled display\n";
29     }
30    
31 dpavlin 29 $app = SDL::App->new(
32     -width => 256 * $self->scale + ( $self->show_mem ? 256 : 0 ),
33     -height => 256 * $self->scale,
34     -depth => 16,
35     );
36     #$app->grab_input( 0 );
37    
38     warn "# created SDL::App\n";
39     }
40    
41     my $white = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff );
42     my $black = SDL::Color->new( -r => 0x80, -g => 0x80, -b => 0x80 );
43    
44     my $red = SDL::Color->new( -r => 0xff, -g => 0x00, -b => 0x00 );
45     my $green = SDL::Color->new( -r => 0x00, -g => 0xff, -b => 0x00 );
46     my $blue = SDL::Color->new( -r => 0x00, -g => 0x00, -b => 0xff );
47    
48     =head2 p
49    
50     $screen->p( $x, $y, 1 );
51    
52     =cut
53    
54     sub p {
55     my $self = shift;
56    
57     my ($x,$y,$w) = (@_);
58    
59     warn "p($x,$y,$w)\n" if $self->debug;
60    
61     my $scale = $self->scale;
62     my $rect = SDL::Rect->new(
63     -height => $scale,
64     -width => $scale,
65     -x => $x * $scale,
66     -y => $y * $scale,
67     );
68    
69     $app->fill( $rect, $w ? $white : $black );
70     $app->update( $rect );
71     }
72    
73     =head2 mem_xy
74    
75     Helper to return x and y coordinates in memory map
76    
77     my ( $x,$y ) = $screen->mem_xy( $address );
78    
79     =cut
80    
81     sub mem_xy {
82     my $self = shift;
83     my $offset = shift;
84     my $x = $offset & 0xff;
85     $x += 256 * $self->scale;
86     my $y = $offset >> 8;
87     return ($x,$y);
88     }
89    
90     =head2 vram
91    
92     Push byte to video memory and draw it
93    
94     $screen->vram( $offset, $byte );
95    
96     =cut
97    
98     sub vram {
99     my ( $self, $offset, $byte ) = @_;
100     my $x = ( $offset % 32 ) << 3;
101     my $y = $offset >> 5;
102     my $mask = 1;
103    
104     printf "## vram %04x %02x*%02x %02x\n", $offset, $x, $y, $byte if $self->trace;
105    
106     foreach ( 0 .. 7 ) {
107     p($x + $_, $y, $byte & $mask );
108     $mask = $mask << 1;
109     }
110     }
111    
112 dpavlin 32 =head2 mmap_pixel
113    
114     Draw pixel in memory map
115    
116     $self->mmap_pixel( $addr, $r, $g, $b );
117    
118     =cut
119    
120     # keep accesses to memory
121     my $_mem_stat;
122    
123     sub mmap_pixel {
124     my ( $self, $addr, $r, $g, $b ) = @_;
125    
126     my ( $x, $y ) = mem_xy( $addr );
127     warn sprintf "## mem %04x %02x %02x %02d*%02d\n", $addr, $r, $g, $x, $y if $self->trace;
128    
129     my $col = sdl::color->new( -r => $r, -g => $g, -b => $b );
130     $app->pixel( $x, $y, $col );
131    
132     $_mem_stat++;
133     if ( $_mem_stat % 1000 == 0 ) {
134     $app->sync;
135     }
136     }
137    
138     1;

  ViewVC Help
Powered by ViewVC 1.1.26