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

Contents of /Screen.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 45 - (show annotations)
Tue Jul 31 09:43:50 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Screen.pm
File size: 2855 byte(s)
print vram accesses if trace is on
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 mem_dump trace app));
16
17 =head2 open_screen
18
19 Open simulated screen
20
21 =cut
22
23 our $app;
24
25 sub open_screen {
26 my $self = shift;
27
28 if ( ! $self->scale ) {
29 $self->scale( 1 );
30 warn "using default unscaled display\n";
31 }
32
33 $app = SDL::App->new(
34 -width => 256 * $self->scale + ( $self->show_mem ? 256 : 0 ),
35 -height => 256 * $self->scale,
36 -depth => 16,
37 );
38 #$app->grab_input( 0 );
39
40 warn "# created SDL::App\n";
41 $self->app( $app );
42 }
43
44 my $white = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff );
45 my $black = SDL::Color->new( -r => 0x80, -g => 0x80, -b => 0x80 );
46
47 my $red = SDL::Color->new( -r => 0xff, -g => 0x00, -b => 0x00 );
48 my $green = SDL::Color->new( -r => 0x00, -g => 0xff, -b => 0x00 );
49 my $blue = SDL::Color->new( -r => 0x00, -g => 0x00, -b => 0xff );
50
51 =head2 p
52
53 $screen->p( $x, $y, 1 );
54
55 =cut
56
57 sub p {
58 my $self = shift;
59
60 my ($x,$y,$w) = (@_);
61
62 warn "p($x,$y,$w)\n" if $self->debug;
63
64 my $scale = $self->scale;
65 my $rect = SDL::Rect->new(
66 -height => $scale,
67 -width => $scale,
68 -x => $x * $scale,
69 -y => $y * $scale,
70 );
71
72 $app->fill( $rect, $w ? $white : $black );
73 $app->update( $rect );
74 }
75
76 =head2 mem_xy
77
78 Helper to return x and y coordinates in memory map
79
80 my ( $x,$y ) = $screen->mem_xy( $address );
81
82 =cut
83
84 sub mem_xy {
85 my $self = shift;
86 my $offset = shift;
87 my $x = $offset & 0xff;
88 $x += 256 * $self->scale;
89 my $y = $offset >> 8;
90 return ($x,$y);
91 }
92
93 =head2 vram
94
95 Push byte to video memory and draw it
96
97 $screen->vram( $offset, $byte );
98
99 =cut
100
101 my $_vram_counter;
102
103 sub vram {
104 my ( $self, $offset, $byte ) = @_;
105 my $x = ( $offset % 32 ) << 3;
106 my $y = $offset >> 5;
107 my $mask = 1;
108 my $scale = $self->scale;
109
110 printf "## vram %04x %02x*%02x %02x\n", $offset, $x, $y, $byte if $self->trace;
111
112 foreach ( 0 .. 7 ) {
113 my $on = $byte & $mask;
114 if ( $scale == 1 ) {
115 $app->pixel( $x + $_, $y, $on ? $white : $black );
116 } else {
117 $self->p($x + $_, $y, $on );
118 }
119 $mask = $mask << 1;
120 }
121
122 $app->sync if ( $_vram_counter++ % 10 == 0 );
123 }
124
125 =head2 mmap_pixel
126
127 Draw pixel in memory map
128
129 $self->mmap_pixel( $addr, $r, $g, $b );
130
131 =cut
132
133 # keep accesses to memory
134 my $_mem_stat;
135
136 sub mmap_pixel {
137 my ( $self, $addr, $r, $g, $b ) = @_;
138 return unless $self->show_mem && $self->app;
139
140 my ( $x, $y ) = $self->mem_xy( $addr );
141 warn sprintf "## mem %04x %02x %02x %02d*%02d\n", $addr, $r, $g, $x, $y if $self->debug;
142
143 my $col = SDL::Color->new( -r => $r, -g => $g, -b => $b );
144 $self->app->pixel( $x, $y, $col );
145
146 $_mem_stat++;
147 if ( $_mem_stat % 1000 == 0 ) {
148 $self->app->sync;
149 }
150 }
151
152
153 =head2 sync
154
155 $self->sync;
156
157 =cut
158
159 sub sync {
160 $app->sync;
161 }
162
163 1;

  ViewVC Help
Powered by ViewVC 1.1.26