/[VRac]/Galaksija.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 /Galaksija.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 168 - (show annotations)
Mon Aug 6 09:19:19 2007 UTC (16 years, 7 months ago) by dpavlin
File size: 5671 byte(s)
map backspace to delete and return to enter, revert video
1 package Galaksija;
2
3 use warnings;
4 use strict;
5
6 use Carp qw/confess/;
7 use File::Slurp;
8 use Data::Dump qw/dump/;
9 use Z80;
10 use Screen;
11
12 use base qw(Class::Accessor VRac Z80 Screen Prefs Session);
13 __PACKAGE__->mk_accessors(qw(booted));
14
15 =head1 NAME
16
17 Galaksija - Galaksija emulator
18
19 =head1 VERSION
20
21 Version 0.01
22
23 =cut
24
25 our $VERSION = '0.01';
26
27 =head1 SUMMARY
28
29 Emulator of Galaksija 8-bit Z80 machine popular in former Yugoslavia
30
31 =cut
32
33 =head1 FUNCTIONS
34
35 =head2 run
36
37 =cut
38
39 our $emu;
40
41 sub run {
42 my $self = shift;
43
44 warn "Galaksija $Galaksija::VERSION emulation starting\n";
45
46 $self->show_mem( 1 );
47 #$self->trace( 1 );
48
49 $self->SUPER::init(
50 read => sub { $self->read( @_ ) },
51 write => sub { $self->write( @_ ) },
52 );
53
54 for my $a ( 0x1000 .. 0x2000 ) {
55 $mem[$a] = 0xff;
56 }
57
58 $self->open_screen;
59 $self->load_rom({
60 0x0000, 'rom/Galaksija/ROM1.BIN',
61 0x1000, 'rom/Galaksija/ROM2.BIN',
62 # 0xE000, 'rom/Galaksija/GAL_PLUS.BIN',
63 });
64
65 # keyboard
66 $mem[$_] = 0xff foreach ( 0x2000 .. 0x2800 );
67
68 # display
69 $mem[$_] = 0x20 foreach ( 0x2800 .. 0x2a00 );
70
71 # 6116-ice
72 $mem[$_] = 0 foreach ( 0x2a00 .. 0x4000 );
73
74 $emu = $self;
75
76 my ( $trace, $debug ) = ( $self->trace, $self->debug );
77 $self->trace( 0 );
78 $self->debug( 0 );
79
80 warn "rendering memory\n";
81 $self->render_mem( @mem );
82
83 #$self->sync;
84 $self->trace( $trace );
85 $self->debug( $debug );
86
87 warn "Galaksija boot finished",
88 $self->trace ? ' trace' : '',
89 $self->debug ? ' debug' : '',
90 "\n";
91
92 Z80::reset();
93
94 my $hor_pos = 0;
95
96 $self->loop( sub {
97 Z80::exec( $_[0] );
98 if ( $hor_pos != $mem[ 0x2ba8 ] ) {
99 warn "scroll 0x2ba8", $self->hexdump( 0x2ba8 );
100 $hor_pos = $mem[ 0x2ba8 ];
101 }
102 $self->render_vram;
103 });
104
105 }
106
107
108 =head1 Memory management
109
110 =cut
111
112 =head2 read
113
114 Read from memory
115
116 $byte = read( $address );
117
118 =cut
119
120 sub read {
121 my $self = shift;
122 my ($addr) = @_;
123 my $byte = $mem[$addr];
124 confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
125 warn sprintf("# Galaksija::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
126
127 $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
128 return $byte;
129 }
130
131 =head2 write
132
133 Write into emory
134
135 write( $address, $byte );
136
137 =cut
138
139 sub write {
140 my $self = shift;
141 my ($addr,$byte) = @_;
142 warn sprintf("# Galaksija::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
143
144 return if ( $addr > 0x4000 );
145
146 $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
147 $mem[$addr] = $byte;
148 return;
149 }
150
151 =head1 Architecture specific
152
153 =cut
154
155 my @keymap = (
156 'a' .. 'z',
157 qw/up down left right space/,
158 '0' .. '9',
159 ':', '"', ',', '=', '.', '/', 'return', 'tab',
160 'left alt', 'backspace', 'scroll lock', 'left shift'
161 );
162
163 my $remap;
164 my $o = 1;
165
166 foreach my $key ( @keymap ) {
167 $remap->{$key} = $o;
168 $o++;
169 }
170
171 =head2 key_down
172
173 =cut
174
175 sub key_down {
176 my ( $self, $key ) = @_;
177 warn "key down: $key ", $remap->{$key};
178 $self->write( 0x2000 + $remap->{$key}, 0xfe );
179 }
180
181 =head2 key_up
182
183 =cut
184
185 sub key_up {
186 my ( $self, $key ) = @_;
187 warn "key up: $key ", $remap->{$key};
188 $self->write( 0x2000 + $remap->{$key}, 0xff );
189 }
190
191 =head2 render_vram
192
193 Render characters as graphic
194
195 =cut
196
197 my $char_rom = 'rom/Galaksija/CHRGEN.BIN';
198
199 my @chars = map { ord($_) } split(//, read_file( $char_rom ));
200 warn "loaded ", $#chars, " characters\n";
201
202 my @char2pos;
203
204 # maken from mess/video/galaxy.c
205 foreach my $char ( 0 .. 255 ) {
206 my $c = $char;
207 if ( ( $c > 63 && $c < 96 ) || ( $c > 127 && $c < 192 ) ) {
208 $c -= 64;
209 } elsif ( $c > 191 ) {
210 $c -= 128;
211 }
212 $char2pos[ $char ] = ( $c & 0x7f );
213 }
214
215 warn dump( @char2pos );
216
217 sub render_vram {
218 my $self = shift;
219
220 my $addr = 0x2800;
221
222 my @pixels = ("\x00") x ( 32 * 16 * 13 );
223 my $a = 0;
224
225 for my $y ( 0 .. 15 ) {
226 for my $x ( 0 .. 31 ) {
227 my $c = $mem[ $addr++ ];
228 $c = $char2pos[ $c ];
229 for my $l ( 0 .. 12 ) {
230 my $o = $l << 5; # *32
231 my $co = ( $l << 7 ) | $c;
232 $pixels[ $a + $x + $o ] = $flip[ $chars[ $co ] ];
233 }
234 }
235 $a += ( 32 * 13 ); # next line
236 }
237
238 my $vram = SDL::Surface->new(
239 -width => 256,
240 -height => 256,
241 -depth => 1, # 1 bit per pixel
242 -pitch => 32, # bytes per line
243 -from => pack("C*", @pixels),
244 );
245 $vram->set_colors( 0, $white, $black );
246
247 $self->render_frame( $vram );
248
249 # $self->render_vram_text;
250 }
251
252
253 =head2 render_vram_text
254
255 Simple hex dumper of text buffer
256
257 =cut
258
259 my $last_dump = '';
260
261 sub render_vram_text {
262 my $self = shift;
263
264 my $addr = 0x2800;
265
266 my $dump;
267
268 for my $y ( 0 .. 15 ) {
269 # $dump .= sprintf "%2d: %s\n",$y, join('', map { sprintf("%02x ",$_) } @mem[ $addr .. $addr+31 ] );
270 $dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr .. $addr+31 ] );
271 $addr += 32;
272 }
273
274 if ( $mem[ 0x2bb0 ] ) {
275 warn "scroll", $self->hexdump( 0x2bb0 );
276 }
277
278 if ( $dump ne $last_dump ) {
279 print $dump;
280 $last_dump = $dump;
281 }
282 }
283
284 =head2 cpu_PC
285
286 Helper metod to set or get PC for current architecture
287
288 =cut
289
290 sub cpu_PC {
291 my ( $self, $addr ) = @_;
292 if ( defined($addr) ) {
293 $PC = $addr;
294 warn sprintf("running from PC %04x\n", $PC);
295 };
296 return $PC;
297 }
298
299 =head1 SEE ALSO
300
301 L<VRac>, L<Screen>, L<Z80>
302
303 =head1 AUTHOR
304
305 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
306
307 =head1 BUGS
308
309 Galaksija Plus isn't emulated. I don't have additional rom, but I would
310 B<love> to have support for this machine. So if you have ROM for Galaksija
311 Plus, get in touch!
312
313 =head1 ACKNOWLEDGEMENTS
314
315 Based on Galaxy emulator L<http://emulator.galaksija.org/> for Windows which
316 is in turn based on DOS version by Miodrag Jevremoviæ
317 L<http://solair.eunet.yu/~jovkovic/galaxy/>.
318
319 =head1 COPYRIGHT & LICENSE
320
321 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
322
323 This program is free software; you can redistribute it and/or modify it
324 under the same terms as Perl itself.
325
326 =cut
327
328 1; # End of Galaksija

  ViewVC Help
Powered by ViewVC 1.1.26