/[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 41 - (hide annotations)
Tue Jul 31 08:49:22 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Screen.pm
File size: 2856 byte(s)
better output mostly
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 29 use base qw(Class::Accessor);
15 dpavlin 33 __PACKAGE__->mk_accessors(qw(debug scale show_mem mem_dump trace app));
16 dpavlin 29
17 dpavlin 30 =head2 open_screen
18 dpavlin 29
19     Open simulated screen
20    
21     =cut
22    
23     our $app;
24    
25 dpavlin 30 sub open_screen {
26 dpavlin 29 my $self = shift;
27 dpavlin 31
28     if ( ! $self->scale ) {
29     $self->scale( 1 );
30     warn "using default unscaled display\n";
31     }
32    
33 dpavlin 29 $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 dpavlin 33 $self->app( $app );
42 dpavlin 29 }
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 dpavlin 37 my $_vram_counter;
102    
103 dpavlin 29 sub vram {
104     my ( $self, $offset, $byte ) = @_;
105     my $x = ( $offset % 32 ) << 3;
106     my $y = $offset >> 5;
107     my $mask = 1;
108 dpavlin 37 my $scale = $self->scale;
109 dpavlin 29
110 dpavlin 37 # printf "## vram %04x %02x*%02x %02x\n", $offset, $x, $y, $byte if $self->trace;
111 dpavlin 29
112     foreach ( 0 .. 7 ) {
113 dpavlin 37 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 dpavlin 29 $mask = $mask << 1;
120     }
121 dpavlin 37
122     $app->sync if ( $_vram_counter++ % 10 == 0 );
123 dpavlin 29 }
124    
125 dpavlin 32 =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 dpavlin 33 return unless $self->show_mem && $self->app;
139 dpavlin 32
140 dpavlin 33 my ( $x, $y ) = $self->mem_xy( $addr );
141 dpavlin 41 warn sprintf "## mem %04x %02x %02x %02d*%02d\n", $addr, $r, $g, $x, $y if $self->debug;
142 dpavlin 32
143 dpavlin 33 my $col = SDL::Color->new( -r => $r, -g => $g, -b => $b );
144     $self->app->pixel( $x, $y, $col );
145 dpavlin 32
146     $_mem_stat++;
147     if ( $_mem_stat % 1000 == 0 ) {
148 dpavlin 33 $self->app->sync;
149 dpavlin 32 }
150     }
151    
152 dpavlin 33
153     =head2 sync
154    
155     $self->sync;
156    
157     =cut
158    
159     sub sync {
160     $app->sync;
161     }
162    
163 dpavlin 32 1;

  ViewVC Help
Powered by ViewVC 1.1.26