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 ]; |
126 |
confess sprintf("can't find memory at address %04x",$addr) unless defined($byte); |
confess sprintf("can't find memory at address %04x",$addr) unless defined($byte); |
127 |
warn sprintf("# Galaksija::read(%04x) = %02x\n", $addr, $byte) if $self->trace; |
warn sprintf("# Galaksija::read(%04x) = %02x\n", $addr, $byte) if $self->trace; |
128 |
|
|
129 |
|
if ( $addr >= 0x2000 && $addr <= 0x2036 ) { |
130 |
|
# printf("## keyread 0x%04x = %02x\n", $addr, $byte); |
131 |
|
$self->key_pressed( 1 ); # force process of events |
132 |
|
} |
133 |
|
|
134 |
$self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem; |
$self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem; |
135 |
return $byte; |
return $byte; |
136 |
} |
} |
167 |
'left alt', 'backspace', 'scroll lock', 'left shift' |
'left alt', 'backspace', 'scroll lock', 'left shift' |
168 |
); |
); |
169 |
|
|
170 |
my $remap; |
my $remap_key2addr; |
171 |
my $o = 1; |
my $o = 1; |
172 |
|
|
173 |
foreach my $key ( @keymap ) { |
foreach my $key ( @keymap ) { |
174 |
$remap->{$key} = $o; |
$remap_key2addr->{$key} = 0x2000 + $o; |
175 |
$o++; |
$o++; |
176 |
} |
} |
177 |
|
|
178 |
|
printf("keymap is mmaped 0x%04x - 0x%04x\n", 0x2000, $o); |
179 |
|
|
180 |
=head2 key_down |
=head2 key_down |
181 |
|
|
182 |
=cut |
=cut |
183 |
|
|
184 |
sub key_down { |
sub key_down { |
185 |
my ( $self, $key ) = @_; |
my ( $self, $key ) = @_; |
186 |
warn "key down: $key ", $remap->{$key}; |
if ( ! defined( $remap_key2addr->{$key} ) ) { |
187 |
$self->write( 0x2000 + $remap->{$key}, 0xfe ); |
warn "unknown key pressed: $key [ignoring]\n"; |
188 |
|
return; |
189 |
|
} |
190 |
|
printf("registered key down: $key address: %04x\n", $remap_key2addr->{$key} ); |
191 |
|
$self->write( $remap_key2addr->{$key}, 0xfe ); |
192 |
} |
} |
193 |
|
|
194 |
=head2 key_up |
=head2 key_up |
197 |
|
|
198 |
sub key_up { |
sub key_up { |
199 |
my ( $self, $key ) = @_; |
my ( $self, $key ) = @_; |
200 |
warn "key up: $key ", $remap->{$key}; |
if ( ! defined( $remap_key2addr->{$key} ) ) { |
201 |
$self->write( 0x2000 + $remap->{$key}, 0xff ); |
warn "unknown key released: $key [ignoring]\n"; |
202 |
|
return; |
203 |
|
} |
204 |
|
warn "registred key up: $key ", $remap_key2addr->{$key}; |
205 |
|
$self->write( $remap_key2addr->{$key}, 0xff ); |
206 |
} |
} |
207 |
|
|
208 |
=head2 render_vram |
=head2 render_vram |
214 |
my $char_rom = 'rom/Galaksija/CHRGEN.BIN'; |
my $char_rom = 'rom/Galaksija/CHRGEN.BIN'; |
215 |
|
|
216 |
my @chars = map { ord($_) } split(//, read_file( $char_rom )); |
my @chars = map { ord($_) } split(//, read_file( $char_rom )); |
217 |
warn "loaded ", $#chars, " characters\n"; |
warn "loaded ", $#chars, " bytes from $char_rom\n"; |
218 |
|
|
219 |
my @char2pos; |
my @char2pos; |
220 |
|
|
229 |
$char2pos[ $char ] = ( $c & 0x7f ); |
$char2pos[ $char ] = ( $c & 0x7f ); |
230 |
} |
} |
231 |
|
|
232 |
warn dump( @char2pos ); |
#warn "## chars2pos = ",dump( @char2pos ); |
233 |
|
|
234 |
|
sub screen_width { 256 } |
235 |
|
sub screen_height { 16 * 13 } |
236 |
|
|
237 |
sub render_vram { |
sub render_vram { |
238 |
my $self = shift; |
my $self = shift; |
239 |
|
|
240 |
|
my $t = time(); |
241 |
|
|
242 |
my $addr = 0x2800; |
my $addr = 0x2800; |
243 |
|
|
244 |
my @pixels = ("\x00") x ( 32 * 16 * 13 ); |
my @pixels = ("\x00") x ( 32 * 16 * 13 ); |
258 |
} |
} |
259 |
|
|
260 |
my $vram = SDL::Surface->new( |
my $vram = SDL::Surface->new( |
261 |
-width => 256, |
-width => $self->screen_width, |
262 |
-height => 256, |
-height => $self->screen_height, |
263 |
-depth => 1, # 1 bit per pixel |
-depth => 1, # 1 bit per pixel |
264 |
-pitch => 32, # bytes per line |
-pitch => 32, # bytes per line |
265 |
-from => pack("C*", @pixels), |
-from => pack("C*", @pixels), |
269 |
$self->render_frame( $vram ); |
$self->render_frame( $vram ); |
270 |
|
|
271 |
# $self->render_vram_text; |
# $self->render_vram_text; |
272 |
|
|
273 |
|
printf("frame in %.2fs\n", time()-$t) if $self->debug; |
274 |
} |
} |
275 |
|
|
276 |
|
|