8 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
9 |
use Z80; |
use Z80; |
10 |
use Screen; |
use Screen; |
11 |
|
use Time::HiRes qw/time/; |
12 |
|
|
13 |
use base qw(Class::Accessor VRac Z80 Screen Prefs Session); |
use base qw(Class::Accessor VRac Z80 Screen Prefs Session); |
14 |
__PACKAGE__->mk_accessors(qw(booted)); |
__PACKAGE__->mk_accessors(qw(booted)); |
95 |
my $hor_pos = 0; |
my $hor_pos = 0; |
96 |
|
|
97 |
$self->loop( sub { |
$self->loop( sub { |
98 |
Z80::exec( $_[0] ); |
my $run_for = shift; |
99 |
|
Z80::exec( $run_for ); |
100 |
if ( $hor_pos != $mem[ 0x2ba8 ] ) { |
if ( $hor_pos != $mem[ 0x2ba8 ] ) { |
101 |
warn "scroll 0x2ba8", $self->hexdump( 0x2ba8 ); |
warn "scroll 0x2ba8", $self->hexdump( 0x2ba8 ); |
102 |
$hor_pos = $mem[ 0x2ba8 ]; |
$hor_pos = $mem[ 0x2ba8 ]; |
158 |
'a' .. 'z', |
'a' .. 'z', |
159 |
qw/up down left right space/, |
qw/up down left right space/, |
160 |
'0' .. '9', |
'0' .. '9', |
161 |
':', '"', ',', '=', '.', '/', 'enter', 'tab', |
':', '"', ',', '=', '.', '/', 'return', 'tab', |
162 |
'left alt', 'delete', 'scroll lock', 'left shift' |
'left alt', 'backspace', 'scroll lock', 'left shift' |
163 |
); |
); |
164 |
|
|
165 |
my $remap; |
my $remap; |
176 |
|
|
177 |
sub key_down { |
sub key_down { |
178 |
my ( $self, $key ) = @_; |
my ( $self, $key ) = @_; |
179 |
warn "key down: $key ", $remap->{$key}; |
warn "registered key down: $key ", $remap->{$key}; |
180 |
$self->write( 0x2000 + $remap->{$key}, 0xfe ); |
$self->write( 0x2000 + $remap->{$key}, 0xfe ); |
181 |
} |
} |
182 |
|
|
186 |
|
|
187 |
sub key_up { |
sub key_up { |
188 |
my ( $self, $key ) = @_; |
my ( $self, $key ) = @_; |
189 |
warn "key up: $key ", $remap->{$key}; |
warn "registred key up: $key ", $remap->{$key}; |
190 |
$self->write( 0x2000 + $remap->{$key}, 0xff ); |
$self->write( 0x2000 + $remap->{$key}, 0xff ); |
191 |
} |
} |
192 |
|
|
219 |
sub render_vram { |
sub render_vram { |
220 |
my $self = shift; |
my $self = shift; |
221 |
|
|
222 |
|
my $t = time(); |
223 |
|
|
224 |
my $addr = 0x2800; |
my $addr = 0x2800; |
225 |
|
|
226 |
my @pixels = ("\x00") x ( 32 * 16 * 13 ); |
my @pixels = ("\x00") x ( 32 * 16 * 13 ); |
246 |
-pitch => 32, # bytes per line |
-pitch => 32, # bytes per line |
247 |
-from => pack("C*", @pixels), |
-from => pack("C*", @pixels), |
248 |
); |
); |
249 |
$vram->set_colors( 0, $black, $white ); |
$vram->set_colors( 0, $white, $black ); |
250 |
|
|
251 |
$self->render_frame( $vram ); |
$self->render_frame( $vram ); |
252 |
|
|
253 |
# $self->render_vram_text; |
# $self->render_vram_text; |
254 |
|
|
255 |
|
printf("frame in %.2fs\n", time()-$t); |
256 |
} |
} |
257 |
|
|
258 |
|
|