package Orao;

use warnings;
use strict;

use Carp;
use lib './lib';
use ACME::6502;
use base qw/ACME::6502/;
use Class::Std;
use Class::Std::Slots;
use Time::HiRes qw(time);
use Term::ReadKey;
use File::Slurp;

=head1 NAME

Orao - Orao emulator

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SUMMARY

Emulator or Orao 8-bit 6502 machine popular in Croatia

=cut

use warnings;
use strict;

=head2 BUILD

=cut

my $loaded_files = {
	0xC000 => 'rom/BAS12.ROM',
	0xE000 => 'rom/CRT12.ROM',
};

# last CLI command
my $last;
my $trace = 0;

sub BUILD {
    my ($self, $id, $args) = @_;

    my $time_base = time();

	foreach my $addr ( sort keys %$loaded_files ) {
		my $path = $loaded_files->{$addr};
		printf "loading '%s' at %04x\n", $path, $addr;
		$self->load_oraoemu( $path, $addr );
	}

}


=head2 load_oraoemu

=cut

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

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

	my $buff = read_file( $path );

	if ( $size == 65538 ) {
		$addr = 0;
		printf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
		$self->write_chunk( $addr, substr($buff,2) );
		return;
	} elsif ( $size == 32800 ) {
		$addr = 0;
		printf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
		#$self->write_chunk( $addr, substr($buff,0x20) );
		$self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
		return;
	}
	printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $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);

	# never repeat save command
	$last = '';

	my $size = -s $path;
	printf "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", $_ )
			} $self->ram( $a, $a+8 )
		)
	);
}

=head2 prompt

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

=cut

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

=head2 trace

  $orao->trace( 1 );
  $orao->trace( 0 );

=cut

sub trace {
	my $self = shift;
	$trace = shift;
}

=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
