/[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 56 - (hide annotations)
Tue Jul 31 15:03:23 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Screen.pm
File size: 3249 byte(s)
another refactoring: extract preferences to Prefs class
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 dpavlin 33 use Carp qw/confess/;
13    
14 dpavlin 56 use base qw(Class::Accessor Prefs);
15     __PACKAGE__->mk_accessors(qw(app));
16 dpavlin 29
17 dpavlin 55 =head1 NAME
18    
19     Screen - simulated 256*256 pixels monochrome screen using SDL
20    
21 dpavlin 30 =head2 open_screen
22 dpavlin 29
23     Open simulated screen
24    
25     =cut
26    
27     our $app;
28    
29 dpavlin 30 sub open_screen {
30 dpavlin 29 my $self = shift;
31 dpavlin 31
32 dpavlin 56 $self->prefs;
33    
34 dpavlin 31 if ( ! $self->scale ) {
35     $self->scale( 1 );
36     warn "using default unscaled display\n";
37     }
38    
39 dpavlin 29 $app = SDL::App->new(
40     -width => 256 * $self->scale + ( $self->show_mem ? 256 : 0 ),
41     -height => 256 * $self->scale,
42     -depth => 16,
43     );
44     #$app->grab_input( 0 );
45    
46     warn "# created SDL::App\n";
47 dpavlin 33 $self->app( $app );
48 dpavlin 29 }
49    
50     my $white = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff );
51     my $black = SDL::Color->new( -r => 0x80, -g => 0x80, -b => 0x80 );
52    
53     my $red = SDL::Color->new( -r => 0xff, -g => 0x00, -b => 0x00 );
54     my $green = SDL::Color->new( -r => 0x00, -g => 0xff, -b => 0x00 );
55     my $blue = SDL::Color->new( -r => 0x00, -g => 0x00, -b => 0xff );
56    
57     =head2 p
58    
59     $screen->p( $x, $y, 1 );
60    
61     =cut
62    
63     sub p {
64     my $self = shift;
65    
66     my ($x,$y,$w) = (@_);
67    
68     warn "p($x,$y,$w)\n" if $self->debug;
69    
70     my $scale = $self->scale;
71     my $rect = SDL::Rect->new(
72     -height => $scale,
73     -width => $scale,
74     -x => $x * $scale,
75     -y => $y * $scale,
76     );
77    
78     $app->fill( $rect, $w ? $white : $black );
79     $app->update( $rect );
80     }
81    
82     =head2 mem_xy
83    
84     Helper to return x and y coordinates in memory map
85    
86     my ( $x,$y ) = $screen->mem_xy( $address );
87    
88     =cut
89    
90     sub mem_xy {
91     my $self = shift;
92     my $offset = shift;
93     my $x = $offset & 0xff;
94     $x += 256 * $self->scale;
95     my $y = $offset >> 8;
96     return ($x,$y);
97     }
98    
99     =head2 vram
100    
101     Push byte to video memory and draw it
102    
103     $screen->vram( $offset, $byte );
104    
105     =cut
106    
107 dpavlin 37 my $_vram_counter;
108    
109 dpavlin 29 sub vram {
110     my ( $self, $offset, $byte ) = @_;
111     my $x = ( $offset % 32 ) << 3;
112     my $y = $offset >> 5;
113     my $mask = 1;
114 dpavlin 37 my $scale = $self->scale;
115 dpavlin 29
116 dpavlin 45 printf "## vram %04x %02x*%02x %02x\n", $offset, $x, $y, $byte if $self->trace;
117 dpavlin 29
118     foreach ( 0 .. 7 ) {
119 dpavlin 37 my $on = $byte & $mask;
120     if ( $scale == 1 ) {
121     $app->pixel( $x + $_, $y, $on ? $white : $black );
122     } else {
123     $self->p($x + $_, $y, $on );
124     }
125 dpavlin 29 $mask = $mask << 1;
126     }
127 dpavlin 37
128     $app->sync if ( $_vram_counter++ % 10 == 0 );
129 dpavlin 29 }
130    
131 dpavlin 32 =head2 mmap_pixel
132    
133     Draw pixel in memory map
134    
135     $self->mmap_pixel( $addr, $r, $g, $b );
136    
137     =cut
138    
139     # keep accesses to memory
140     my $_mem_stat;
141    
142     sub mmap_pixel {
143     my ( $self, $addr, $r, $g, $b ) = @_;
144 dpavlin 33 return unless $self->show_mem && $self->app;
145 dpavlin 32
146 dpavlin 33 my ( $x, $y ) = $self->mem_xy( $addr );
147 dpavlin 41 warn sprintf "## mem %04x %02x %02x %02d*%02d\n", $addr, $r, $g, $x, $y if $self->debug;
148 dpavlin 32
149 dpavlin 33 my $col = SDL::Color->new( -r => $r, -g => $g, -b => $b );
150     $self->app->pixel( $x, $y, $col );
151 dpavlin 32
152     $_mem_stat++;
153     if ( $_mem_stat % 1000 == 0 ) {
154 dpavlin 33 $self->app->sync;
155 dpavlin 32 }
156     }
157    
158 dpavlin 33
159     =head2 sync
160    
161     $self->sync;
162    
163     =cut
164    
165     sub sync {
166     $app->sync;
167     }
168    
169 dpavlin 55 =head1 SEE ALSO
170    
171     L<Orao> is sample implementation using this module
172    
173     =head1 AUTHOR
174    
175     Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
176    
177     =head1 COPYRIGHT & LICENSE
178    
179     Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
180    
181     This program is free software; you can redistribute it and/or modify it
182     under the same terms as Perl itself.
183    
184     =cut
185 dpavlin 32 1;

  ViewVC Help
Powered by ViewVC 1.1.26