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

  ViewVC Help
Powered by ViewVC 1.1.26