viewvc.cgi/VRac/Orao.pm

package Orao;

use warnings;
use strict;

use Carp;
use lib './lib';
#use Time::HiRes qw(time);
use File::Slurp;
use Data::Dump qw/dump/;
use M6502;

use base qw(Class::Accessor M6502 Screen);
__PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));

=head1 NAME

Orao - Orao emulator

=head1 VERSION

Version 0.02

=cut

our $VERSION = '0.02';

=head1 SUMMARY

Emulator or Orao 8-bit 6502 machine popular in Croatia

=cut

=head2 init

Start emulator

=cut

our $orao;

select(STDERR); $| = 1;

sub init {
        my $self = shift;
        warn "Orao calling upstream init\n";
        $self->SUPER::init( $self, @_ );

        warn "staring Orao $Orao::VERSION emulation\n";

        $self->open_screen;
        $self->load_rom({
                0x1000 => 'dump/SCRINV.BIN',
                0xC000 => 'rom/BAS12.ROM',
                0xE000 => 'rom/CRT12.ROM',
        });

        $PC = 0xDD11;   # BC
#       $PC = 0xC274;   # MC

        $orao = $self;

#       $self->prompt( 0x1000 );

        my ( $trace, $debug ) = ( $self->trace, $self->debug );
        $self->trace( 0 );
        $self->debug( 0 );

        if ( $self->show_mem ) {

                warn "rendering memory map\n";

                my @mmap = (
                        0x0000, 0x03FF, 'nulti blok',
                        0x0400, 0x5FFF, 'korisnièki RAM (23K)',
                        0x6000, 0x7FFF, 'video RAM',
                        0x8000, 0x9FFF, 'sistemske lokacije',
                        0xA000, 0xAFFF, 'ekstenzija',
                        0xB000, 0xBFFF, 'DOS',
                        0xC000, 0xDFFF, 'BASIC ROM',
                        0xE000, 0xFFFF, 'sistemski ROM',
                );

                foreach my $i ( 0 .. $#mmap / 3 ) {
                        my $o = $i * 3;
                        my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
                        printf "%04x - %04x - %s\n", $from, $to, $desc;
                        for my $a ( $from .. $to ) {
                                if ( $a >= 0x6000 && $a < 0x8000 ) {
                                        my $b = $self->read( $a );
                                        $self->vram( $a - 0x6000, $b );
                                } else {
                                        $self->read( $a );
                                }
                        }
                }

        } else {

                warn "rendering video memory\n";
                for my $a ( 0x6000 .. 0x7fff ) {
                        $self->vram( $a - 0x6000, $mem[$a] );
                }
        
        }
        $self->sync;
        $self->trace( $trace );
        $self->debug( $debug );

        #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );

        warn "Orao init finished",
                $self->trace ? ' trace' : '',
                $self->debug ? ' debug' : '',
                "\n";

}

=head2 load_rom

called to init memory and load initial rom images

  $orao->load_rom;

=cut

sub load_rom {
    my ($self, $loaded_files) = @_;

    #my $time_base = time();

        foreach my $addr ( sort keys %$loaded_files ) {
                my $path = $loaded_files->{$addr};
                $self->load_oraoemu( $path, $addr );
        }
}


=head2 load_oraoemu

=cut

sub _write_chunk {
        my $self = shift;
        my ( $addr, $chunk ) = @_;
        $self->write_chunk( $addr, $chunk );
        my $end = $addr + length($chunk);
        my ( $f, $t ) = ( 0x6000, 0x7fff );

        if ( $end < $f || $addr >= $t ) {
                warn "skip vram update\n";
                return;
        };

        $f = $addr if ( $addr > $f );
        $t = $end if ( $end < $t );

        warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
        foreach my $a ( $f .. $t ) {
                $self->vram( $a - 0x6000 , $mem[ $a ] );
        }
}

sub load_oraoemu {
        my $self = shift;
        my ( $path, $addr ) = @_;

        my $size = -s $path || confess "no size for $path: $!";

        my $buff = read_file( $path );

        if ( $size == 65538 ) {
                $addr = 0;
                warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
                $self->_write_chunk( $addr, substr($buff,2) );
                return;
        } elsif ( $size == 32800 ) {
                $addr = 0;
                warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
                $self->_write_chunk( $addr, substr($buff,0x20) );
                return;
        }
        printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
        return $self->_write_chunk( $addr, $buff );

        my $chunk;

        my $pos = 0;

        while ( my $long = substr($buff,$pos,4) ) {
                my @b = split(//, $long, 4);
                $chunk .=
                        ( $b[3] || '' ) .
                        ( $b[2] || '' ) .
                        ( $b[1] || '' ) .
                        ( $b[0] || '' );
                $pos += 4;
        }

        $self->_write_chunk( $addr, $chunk );

};

=head2 save_dump

  $orao->save_dump( 'filename', $from, $to );

=cut

sub save_dump {
        my $self = shift;

        my ( $path, $from, $to ) = @_;

        $from ||= 0;
        $to ||= 0xffff;

        open(my $fh, '>', $path) || die "can't open $path: $!";
        print $fh $self->read_chunk( $from, $to );
        close($fh);

        my $size = -s $path;
        warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
}

=head2 hexdump

  $orao->hexdump( $address );

=cut

sub hexdump {
        my $self = shift;
        my $a = shift;
        return sprintf(" %04x %s\n", $a,
                join(" ",
                        map {
                                sprintf( "%02x", $_ )
                        } @mem[ $a .. $a+8 ]
                )
        );
}

=head2 prompt

  $orao->prompt( $address, $last_command );

=cut

sub prompt {
        my $self = shift;
        $self->app->sync;
        my $a = shift;
        my $last = shift;
        print STDERR $self->hexdump( $a ),
                $last ? "[$last] " : '',
                "> ";
        my $in = <STDIN>;
        chomp($in);
        warn "## prompt got: $in\n" if $self->debug;
        $in ||= $last;
        $last = $in;
        return split(/\s+/, $in) if $in;
}

=head1 Memory management

Orao implements all I/O using mmap addresses. This was main reason why
L<Acme::6502> was just too slow to handle it.

=cut

=head2 read

Read from memory

  $byte = read( $address );

=cut

sub read {
        my $self = shift;
        my ($addr) = @_;
        my $byte = $mem[$addr];
        warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
        $self->mmap_pixel( $addr, 0, $byte, 0 );
        return $byte;
}

=head2 write

Write into emory

  write( $address, $byte );

=cut

sub write {
        my $self = shift;
        my ($addr,$byte) = @_;
        warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;

        if ( $addr >= 0x6000 && $addr < 0x8000 ) {
                $self->vram( $addr - 0x6000 , $byte );
        }

        if ( $addr > 0xafff ) {
                warn sprintf "access to %04x above affff aborting\n", $addr;
                return -1;
        }
        if ( $addr == 0x8800 ) {
                warn sprintf "sound ignored: %x\n", $byte;
        }

        $self->mmap_pixel( $addr, $byte, 0, 0 );

        $mem[$addr] = $byte;
        return;
}

=head1 Command Line

Command-line debugging intrerface is implemented for communication with
emulated device

=head2 cli

  $orao->cli();

=cut

my $last = 'r 1';

sub cli {
        my $self = shift;
        my $a = $PC || confess "no pc?"; 
        while ( my @v = $self->prompt( $a, $last ) ) {
                my $c = shift @v;
                my $v = shift @v;
                $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
                @v = map { hex($_) } @v;
                printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
                if ( $c =~ m/^[qx]/i ) {
                        exit;
                } elsif ( $c eq '?' ) {
                        warn <<__USAGE__;
uage:
x|q\t\texit
e 6000 6010\tdump memory, +/- to walk forward/backward
m 1000 ff 00\tput ff 00 on 1000
j|u 1000\t\tjump (change pc)
r 42\t\trun 42 instruction opcodes
t\t\ttrace on/off
d\t\tdebug on/off
__USAGE__
                } elsif ( $c =~ m/^e/i ) {
                        $a = $v if defined($v);
                        my $to = shift @v;
                        $to = $a + 32 if ( ! $to || $to <= $a );
                        my $lines = int( ($to - $a - 8) / 8 );
                        printf "## m %04x %04x lines: %d\n", $a, $to, $lines;
                        while ( $lines ) {
                                print $self->hexdump( $a );
                                $a += 8;
                                $lines--;
                        }
                        $last = '+';
                } elsif ( $c =~ m/^\+/ ) {
                        $a += 8;
                } elsif ( $c =~ m/^\-/ ) {
                        $a -= 8;
                } elsif ( $c =~ m/^m/i ) {
                        $a = $v;
                        $self->poke_code( $a, @v );
                        printf "poke %d bytes at %04x\n", $#v + 1, $a;
                } elsif ( $c =~ m/^l/i ) {
                        my $to = shift @v || 0x1000;
                        $a = $to;
                        $self->load_oraoemu( $v, $a );
                } elsif ( $c =~ m/^s/i ) {
                        $self->save_dump( $v || 'mem.dump', @v );
                } elsif ( $c =~ m/^r/i ) {
                        $run_for = $v || 1;
                        print "run_for $run_for instructions\n";
                        last;
                } elsif ( $c =~ m/^(u|j)/ ) {
                        my $to = $v || $a;
                        printf "set pc to %04x\n", $to;
                        $PC = $to;      # remember for restart
                        $run_for = 1;
                        last;
                } elsif ( $c =~ m/^t/ ) {
                        $self->trace( not $self->trace );
                        print "trace ", $self->trace ? 'on' : 'off', "\n";
                } elsif ( $c =~ m/^d/ ) {
                        $self->debug( not $self->debug );
                        print "debug ", $self->debug ? 'on' : 'off', "\n";
                } else {
                        warn "# ignore $c\n";
                        last;
                }
        }


}

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 BUGS

=head1 ACKNOWLEDGEMENTS

See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
info about this machine (and even hardware implementation from 2007).

=head1 COPYRIGHT & LICENSE

Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Orao
1	dpavlin	29	package Orao;
2
3			use warnings;
4			use strict;
5
6			use Carp;
7			use lib './lib';
8			#use Time::HiRes qw(time);
9			use File::Slurp;
10	dpavlin	32	use Data::Dump qw/dump/;
11	dpavlin	34	use M6502;
12	dpavlin	29
13	dpavlin	30	use base qw(Class::Accessor M6502 Screen);
14	dpavlin	29	__PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));
15
16			=head1 NAME
17
18			Orao - Orao emulator
19
20			=head1 VERSION
21
22			Version 0.02
23
24			=cut
25
26			our $VERSION = '0.02';
27
28			=head1 SUMMARY
29
30			Emulator or Orao 8-bit 6502 machine popular in Croatia
31
32			=cut
33
34	dpavlin	30	=head2 init
35
36			Start emulator
37
38			=cut
39
40	dpavlin	32	our $orao;
41
42	dpavlin	42	select(STDERR); $\| = 1;
43
44	dpavlin	30	sub init {
45			my $self = shift;
46	dpavlin	34	warn "Orao calling upstream init\n";
47	dpavlin	33	$self->SUPER::init( $self, @_ );
48	dpavlin	30
49	dpavlin	31	warn "staring Orao $Orao::VERSION emulation\n";
50	dpavlin	30
51			$self->open_screen;
52	dpavlin	33	$self->load_rom({
53			0x1000 => 'dump/SCRINV.BIN',
54			0xC000 => 'rom/BAS12.ROM',
55			0xE000 => 'rom/CRT12.ROM',
56			});
57	dpavlin	32
58	dpavlin	46	$PC = 0xDD11; # BC
59			# $PC = 0xC274; # MC
60	dpavlin	35
61	dpavlin	32	$orao = $self;
62
63	dpavlin	33	# $self->prompt( 0x1000 );
64
65	dpavlin	49	my ( $trace, $debug ) = ( $self->trace, $self->debug );
66	dpavlin	38	$self->trace( 0 );
67	dpavlin	49	$self->debug( 0 );
68	dpavlin	33
69	dpavlin	38	if ( $self->show_mem ) {
70	dpavlin	33
71	dpavlin	38	warn "rendering memory map\n";
72
73			my @mmap = (
74			0x0000, 0x03FF, 'nulti blok',
75			0x0400, 0x5FFF, 'korisnièki RAM (23K)',
76			0x6000, 0x7FFF, 'video RAM',
77			0x8000, 0x9FFF, 'sistemske lokacije',
78			0xA000, 0xAFFF, 'ekstenzija',
79			0xB000, 0xBFFF, 'DOS',
80			0xC000, 0xDFFF, 'BASIC ROM',
81			0xE000, 0xFFFF, 'sistemski ROM',
82			);
83
84			foreach my $i ( 0 .. $#mmap / 3 ) {
85			my $o = $i * 3;
86			my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
87			printf "%04x - %04x - %s\n", $from, $to, $desc;
88			for my $a ( $from .. $to ) {
89			if ( $a >= 0x6000 && $a < 0x8000 ) {
90			my $b = $self->read( $a );
91			$self->vram( $a - 0x6000, $b );
92			} else {
93			$self->read( $a );
94			}
95	dpavlin	36	}
96	dpavlin	34	}
97	dpavlin	38
98			} else {
99
100			warn "rendering video memory\n";
101			for my $a ( 0x6000 .. 0x7fff ) {
102			$self->vram( $a - 0x6000, $mem[$a] );
103			}
104
105	dpavlin	33	}
106	dpavlin	38	$self->sync;
107			$self->trace( $trace );
108	dpavlin	49	$self->debug( $debug );
109	dpavlin	33
110	dpavlin	39	#( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
111	dpavlin	34
112	dpavlin	49	warn "Orao init finished",
113			$self->trace ? ' trace' : '',
114			$self->debug ? ' debug' : '',
115			"\n";
116	dpavlin	38
117	dpavlin	30	}
118
119	dpavlin	29	=head2 load_rom
120
121			called to init memory and load initial rom images
122
123			$orao->load_rom;
124
125			=cut
126
127			sub load_rom {
128	dpavlin	33	my ($self, $loaded_files) = @_;
129	dpavlin	29
130			#my $time_base = time();
131
132			foreach my $addr ( sort keys %$loaded_files ) {
133			my $path = $loaded_files->{$addr};
134			$self->load_oraoemu( $path, $addr );
135			}
136			}
137
138
139			=head2 load_oraoemu
140
141			=cut
142
143	dpavlin	46	sub _write_chunk {
144			my $self = shift;
145			my ( $addr, $chunk ) = @_;
146			$self->write_chunk( $addr, $chunk );
147			my $end = $addr + length($chunk);
148			my ( $f, $t ) = ( 0x6000, 0x7fff );
149
150			if ( $end < $f \|\| $addr >= $t ) {
151			warn "skip vram update\n";
152			return;
153			};
154
155			$f = $addr if ( $addr > $f );
156			$t = $end if ( $end < $t );
157
158			warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
159			foreach my $a ( $f .. $t ) {
160			$self->vram( $a - 0x6000 , $mem[ $a ] );
161			}
162			}
163
164	dpavlin	29	sub load_oraoemu {
165			my $self = shift;
166			my ( $path, $addr ) = @_;
167
168	dpavlin	31	my $size = -s $path \|\| confess "no size for $path: $!";
169	dpavlin	29
170			my $buff = read_file( $path );
171
172			if ( $size == 65538 ) {
173			$addr = 0;
174	dpavlin	33	warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
175	dpavlin	46	$self->_write_chunk( $addr, substr($buff,2) );
176	dpavlin	29	return;
177			} elsif ( $size == 32800 ) {
178			$addr = 0;
179	dpavlin	33	warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
180	dpavlin	46	$self->_write_chunk( $addr, substr($buff,0x20) );
181	dpavlin	29	return;
182			}
183	dpavlin	33	printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
184	dpavlin	46	return $self->_write_chunk( $addr, $buff );
185	dpavlin	29
186			my $chunk;
187
188			my $pos = 0;
189
190			while ( my $long = substr($buff,$pos,4) ) {
191			my @b = split(//, $long, 4);
192			$chunk .=
193			( $b[3] \|\| '' ) .
194			( $b[2] \|\| '' ) .
195			( $b[1] \|\| '' ) .
196			( $b[0] \|\| '' );
197			$pos += 4;
198			}
199
200	dpavlin	46	$self->_write_chunk( $addr, $chunk );
201	dpavlin	29
202			};
203
204			=head2 save_dump
205
206			$orao->save_dump( 'filename', $from, $to );
207
208			=cut
209
210			sub save_dump {
211			my $self = shift;
212
213			my ( $path, $from, $to ) = @_;
214
215			$from \|\|= 0;
216			$to \|\|= 0xffff;
217
218			open(my $fh, '>', $path) \|\| die "can't open $path: $!";
219			print $fh $self->read_chunk( $from, $to );
220			close($fh);
221
222			my $size = -s $path;
223	dpavlin	32	warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
224	dpavlin	29	}
225
226			=head2 hexdump
227
228			$orao->hexdump( $address );
229
230			=cut
231
232			sub hexdump {
233			my $self = shift;
234			my $a = shift;
235			return sprintf(" %04x %s\n", $a,
236			join(" ",
237			map {
238			sprintf( "%02x", $_ )
239	dpavlin	47	} @mem[ $a .. $a+8 ]
240	dpavlin	29	)
241			);
242			}
243
244			=head2 prompt
245
246			$orao->prompt( $address, $last_command );
247
248			=cut
249
250			sub prompt {
251			my $self = shift;
252	dpavlin	43	$self->app->sync;
253	dpavlin	29	my $a = shift;
254			my $last = shift;
255	dpavlin	32	print STDERR $self->hexdump( $a ),
256	dpavlin	29	$last ? "[$last] " : '',
257			"> ";
258			my $in = <STDIN>;
259			chomp($in);
260	dpavlin	49	warn "## prompt got: $in\n" if $self->debug;
261	dpavlin	29	$in \|\|= $last;
262			$last = $in;
263			return split(/\s+/, $in) if $in;
264			}
265
266	dpavlin	32	=head1 Memory management
267	dpavlin	30
268	dpavlin	32	Orao implements all I/O using mmap addresses. This was main reason why
269			L<Acme::6502> was just too slow to handle it.
270
271			=cut
272
273			=head2 read
274
275			Read from memory
276
277			$byte = read( $address );
278
279			=cut
280
281			sub read {
282	dpavlin	33	my $self = shift;
283	dpavlin	32	my ($addr) = @_;
284			my $byte = $mem[$addr];
285	dpavlin	41	warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
286	dpavlin	33	$self->mmap_pixel( $addr, 0, $byte, 0 );
287	dpavlin	32	return $byte;
288			}
289
290			=head2 write
291
292			Write into emory
293
294			write( $address, $byte );
295
296			=cut
297
298			sub write {
299	dpavlin	33	my $self = shift;
300	dpavlin	32	my ($addr,$byte) = @_;
301	dpavlin	41	warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
302	dpavlin	32
303			if ( $addr >= 0x6000 && $addr < 0x8000 ) {
304			$self->vram( $addr - 0x6000 , $byte );
305			}
306
307			if ( $addr > 0xafff ) {
308			warn sprintf "access to %04x above affff aborting\n", $addr;
309			return -1;
310			}
311			if ( $addr == 0x8800 ) {
312			warn sprintf "sound ignored: %x\n", $byte;
313			}
314
315	dpavlin	33	$self->mmap_pixel( $addr, $byte, 0, 0 );
316	dpavlin	32
317			$mem[$addr] = $byte;
318	dpavlin	36	return;
319	dpavlin	32	}
320
321	dpavlin	42	=head1 Command Line
322	dpavlin	32
323	dpavlin	42	Command-line debugging intrerface is implemented for communication with
324			emulated device
325
326			=head2 cli
327
328			$orao->cli();
329
330			=cut
331
332			my $last = 'r 1';
333
334			sub cli {
335			my $self = shift;
336			my $a = $PC \|\| confess "no pc?";
337	dpavlin	43	while ( my @v = $self->prompt( $a, $last ) ) {
338	dpavlin	42	my $c = shift @v;
339			my $v = shift @v;
340			$v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
341			@v = map { hex($_) } @v;
342	dpavlin	49	printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v \|\| 'undef'), join(",",@v) if $self->debug;
343	dpavlin	42	if ( $c =~ m/^[qx]/i ) {
344			exit;
345			} elsif ( $c eq '?' ) {
346			warn <<__USAGE__;
347			uage:
348			x\|q\t\texit
349			e 6000 6010\tdump memory, +/- to walk forward/backward
350			m 1000 ff 00\tput ff 00 on 1000
351			j\|u 1000\t\tjump (change pc)
352			r 42\t\trun 42 instruction opcodes
353	dpavlin	49	t\t\ttrace on/off
354			d\t\tdebug on/off
355	dpavlin	42	__USAGE__
356			} elsif ( $c =~ m/^e/i ) {
357	dpavlin	49	$a = $v if defined($v);
358	dpavlin	42	my $to = shift @v;
359			$to = $a + 32 if ( ! $to \|\| $to <= $a );
360			my $lines = int( ($to - $a - 8) / 8 );
361			printf "## m %04x %04x lines: %d\n", $a, $to, $lines;
362			while ( $lines ) {
363			print $self->hexdump( $a );
364			$a += 8;
365			$lines--;
366			}
367			$last = '+';
368			} elsif ( $c =~ m/^\+/ ) {
369			$a += 8;
370			} elsif ( $c =~ m/^\-/ ) {
371			$a -= 8;
372			} elsif ( $c =~ m/^m/i ) {
373			$a = $v;
374			$self->poke_code( $a, @v );
375			printf "poke %d bytes at %04x\n", $#v + 1, $a;
376			} elsif ( $c =~ m/^l/i ) {
377			my $to = shift @v \|\| 0x1000;
378			$a = $to;
379			$self->load_oraoemu( $v, $a );
380			} elsif ( $c =~ m/^s/i ) {
381			$self->save_dump( $v \|\| 'mem.dump', @v );
382			} elsif ( $c =~ m/^r/i ) {
383			$run_for = $v \|\| 1;
384			print "run_for $run_for instructions\n";
385			last;
386			} elsif ( $c =~ m/^(u\|j)/ ) {
387			my $to = $v \|\| $a;
388			printf "set pc to %04x\n", $to;
389			$PC = $to; # remember for restart
390			$run_for = 1;
391			last;
392			} elsif ( $c =~ m/^t/ ) {
393			$self->trace( not $self->trace );
394			print "trace ", $self->trace ? 'on' : 'off', "\n";
395	dpavlin	49	} elsif ( $c =~ m/^d/ ) {
396			$self->debug( not $self->debug );
397			print "debug ", $self->debug ? 'on' : 'off', "\n";
398	dpavlin	42	} else {
399			warn "# ignore $c\n";
400			last;
401			}
402			}
403
404
405			}
406
407	dpavlin	29	=head1 AUTHOR
408
409			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
410
411			=head1 BUGS
412
413			=head1 ACKNOWLEDGEMENTS
414
415			See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
416			info about this machine (and even hardware implementation from 2007).
417
418			=head1 COPYRIGHT & LICENSE
419
420			Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
421
422			This program is free software; you can redistribute it and/or modify it
423			under the same terms as Perl itself.
424
425			=cut
426
427			1; # End of Orao