/[VRac]/M6502/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

Contents of /M6502/Screen.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 56 - (show annotations)
Tue Jul 31 15:03:23 2007 UTC (14 years, 2 months ago) by dpavlin
File size: 3249 byte(s)
another refactoring: extract preferences to Prefs class
1 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 Carp qw/confess/;
13
14 use base qw(Class::Accessor Prefs);
15 __PACKAGE__->mk_accessors(qw(app));
16
17 =head1 NAME
18
19 Screen - simulated 256*256 pixels monochrome screen using SDL
20
21 =head2 open_screen
22
23 Open simulated screen
24
25 =cut
26
27 our $app;
28
29 sub open_screen {
30 my $self = shift;
31
32 $self->prefs;
33
34 if ( ! $self->scale ) {
35 $self->scale( 1 );
36 warn "using default unscaled display\n";
37 }
38
39 $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 $self->app( $app );
48 }
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 my $_vram_counter;
108
109 sub vram {
110 my ( $self, $offset, $byte ) = @_;
111 my $x = ( $offset % 32 ) << 3;
112 my $y = $offset >> 5;
113 my $mask = 1;
114 my $scale = $self->scale;
115
116 printf "## vram %04x %02x*%02x %02x\n", $offset, $x, $y, $byte if $self->trace;
117
118 foreach ( 0 .. 7 ) {
119 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 $mask = $mask << 1;
126 }
127
128 $app->sync if ( $_vram_counter++ % 10 == 0 );
129 }
130
131 =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 return unless $self->show_mem && $self->app;
145
146 my ( $x, $y ) = $self->mem_xy( $addr );
147 warn sprintf "## mem %04x %02x %02x %02d*%02d\n", $addr, $r, $g, $x, $y if $self->debug;
148
149 my $col = SDL::Color->new( -r => $r, -g => $g, -b => $b );
150 $self->app->pixel( $x, $y, $col );
151
152 $_mem_stat++;
153 if ( $_mem_stat % 1000 == 0 ) {
154 $self->app->sync;
155 }
156 }
157
158
159 =head2 sync
160
161 $self->sync;
162
163 =cut
164
165 sub sync {
166 $app->sync;
167 }
168
169 =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 1;

  ViewVC Help
Powered by ViewVC 1.1.26