#!/usr/bin/perl

use strict;
use warnings;

use Carp;
use Data::Dump qw/dump/;

use SDL::App;
use SDL::Rect;
use SDL::Color;

use lib './lib';
use Orao;

my $debug = 0;
my $scale = 1;
my $show_mem = 1;
my $run_for = 1;
my $mem_dump = 'mem.dump';
my $trace = 0;


my $app = SDL::App->new(
	-width  => 256 * $scale + ( $show_mem ? 256 : 0 ),
	-height => 256 * $scale,
	-depth  => 16,
);

$app->grab_input( 0 );

my $white = SDL::Color->new( -r => 0xff, -g => 0xff, -b => 0xff );
my $black = SDL::Color->new( -r => 0x80, -g => 0x80, -b => 0x80 );

my $red		= SDL::Color->new( -r => 0xff, -g => 0x00, -b => 0x00 );
my $green	= SDL::Color->new( -r => 0x00, -g => 0xff, -b => 0x00 );
my $blue	= SDL::Color->new( -r => 0x00, -g => 0x00, -b => 0xff );

sub p {
	my ($x,$y,$w) = (@_);

	warn "p($x,$y,$w)\n" if $debug;

	my $rect = SDL::Rect->new(
		-height => $scale,
		-width  => $scale,
		-x      => $x * $scale,
		-y      => $y * $scale,
	);

	$app->fill( $rect, $w ? $white : $black );
	$app->update( $rect );
}

my $stat;

sub mem_xy {
	my $offset = shift;
	my $x = $offset & 0xff;
	$x += 256 * $scale;
	my $y = $offset >> 8;
	return ($x,$y);
}

=head2 vram

  $orao->vram( $offset, $byte );

=cut

sub vram {
	my ( $offset, $byte ) = @_;
	my $x = ( $offset % 32 ) << 3;
	my $y = $offset >> 5;
	my $mask = 1;

	printf "## vram %04x %02x*%02x %02x\n", $offset, $x, $y, $byte if $trace;

	foreach ( 0 .. 7 ) {
		p($x + $_, $y, $byte & $mask );
		$mask = $mask << 1;
	}
}

my $orao = new Orao({
	mmu => sub {
		my ( $offset, $what, $value ) = @_;
		my ( $x, $y ) = mem_xy( $offset );
		printf "## mem %04x %s = %02x %02d*%02d\n", $offset, $what, $value, $x, $y if $trace;

		if ( $offset >= 0x6000 && $offset < 0x8000 ) {
			vram( $offset - 0x6000 , $value );
		}

		my ( $r,$g,$b ) = ( 0,0,0 );

		if ( $what eq 'write' ) {
			$r = $value;
			if ( $offset > 0xafff ) {
				printf "access to %04x above affff aborting\n", $offset;
				return -1;
			}
			if ( $offset == 0x8800 ) {
				printf "sound ignored: %x\n", $value;
			}
		} elsif ( $what eq 'read' ) {
			$g = $value;
		} else {
			$b = $value;
		}

		my $col = SDL::Color->new( -r => $r, -g => $g, -b => $b );
		$app->pixel( $x, $y, $col );
	
		$stat->{$what}++;
		if ( $stat->{$what} % 1000 == 0 ) {
			$app->sync;
		}
	},
});

my ($pc, $a, $x, $y, $s, $p) = (0) x 6;
#$orao->load_rom('dump/basic.dmp', -2);

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

$orao->load_rom('makewav/SCRINV.BIN', 0x1000);
$pc = 0x1000;

#$orao->load_oraoemu('dump/orao-64k-1.2.dmp');
#$pc = 0xe5b7;

# memory dump
my $rect = SDL::Rect->new(
	-height => 256,
	-width  => 256,
	-x      => 256 * $scale,
	-y      => 0,
);

$app->fill( $rect, $white );
$app->update( $rect );

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 ) {
		$orao->read_8( $a );
	}
	$app->sync;
}

my $last;

sub opcode_cb {
	my $a = shift || confess "no pc?"; 
	$app->sync;
	while ( my @v = $orao->prompt( $a, $last ) ) {
		my $c = shift @v;
		my $v = shift @v;
		$v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
		printf "## [%s] %s\n", ($v || 'undef'), join(",",@v) if $debug;
		@v = map { hex($_) } @v;
		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
__USAGE__
		} elsif ( $c =~ m/^e/i ) {
			$a ||= $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 $orao->hexdump( $a );
				$a += 8;
				$lines--;
			}
			$last = '+';
		} elsif ( $c =~ m/^\+/ ) {
			$a += 8;
		} elsif ( $c =~ m/^\-/ ) {
			$a -= 8;
		} elsif ( $c =~ m/^m/i ) {
			$a = $v;
			$orao->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;
			$orao->load_oraoemu( $v, $a );
		} elsif ( $c =~ m/^s/i ) {
			$orao->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;
			$orao->set_pc( $to );
			$pc = $to;	# remember for restart
			$run_for = 1;
			$last = 'r 1';
			last;
		} elsif ( $c =~ m/^t/ ) {
			$trace = not $trace;
			print "trace ", $trace ? 'on' : 'off', "\n";
		} else {
			warn "# ignore $c\n";
		}
	}
}

sub restart {
	printf "starting emulation -- pc: %04x a:%d x:%d y:%d s:%d p:%d for %d instructions\n", $pc, $a, $x, $y, $s, $p, $run_for;

	$orao->set_pc( $pc );
	$orao->set_a( $a );
	$orao->set_x( $x );
	$orao->set_y( $y );
	$orao->set_s( $s );
	$orao->set_p( $p );
}

restart;

while ( 1 ) {
	eval {
		$orao->run( $run_for , sub {
			my ($pc, $inst, $a, $x, $y, $s, $p) = @_;
			$run_for--;

			$app->pixel( mem_xy( $pc ), $white );
			$app->sync if ( $run_for % 500 == 0 );

			printf " PC: %04x A:%02x P:%02x X:%02x Y:%02x S:%02x [%d]\n", $pc, $a,$p,$x,$y,$s, $run_for if ( $trace || $run_for % 1000 == 0 );
			opcode_cb( $pc ) if ( $run_for <= 1 );

			return 1;
		} );
	};

	if ( $@ ) {
		print "restart after $@\n";
		restart();
		$run_for = 1;
	}

	$run_for ||= 1;
}