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

  ViewVC Help
Powered by ViewVC 1.1.26