#package Tie::Filter::Array;
package TieMem;

use 5.008;
use strict;
use warnings;

use Carp qw/confess cluck/;
use base qw/Tie::Array/;

use Data::Dump qw/dump/;

our $VERSION = '1.02';

my $debug = 0;

=head1 NAME

Tie::Filter::Array - Tie a facade around an array

=head1 DESCRIPTION

Don't use this package directly. Instead, see L<Tie::Filter>.

=cut

sub _read {
	my ( $self, $index ) = @_;
	my $value = $$self{WRAP}[$index & 0xffff];
	cluck "read undef value from $index" unless defined($value);
#	printf "_read(%04x) = %2x %d\n", $index, $value, $value;
	$self->{mmu}->( $index, 'read', $value );
	return $value;
}

sub _write {
	my ( $self, $index, $value ) = @_;
	confess "write undef value to $index" unless defined($value);
#	printf "_write(%04x) = %2x %d\n", $index, $value, $value;
	$self->{mmu}->( $index, 'write', $value );
	$$self{WRAP}[$index] = $value;
}

my @ram = (0) x 65536;

=head2 ram

Access low-level ram without tracing through MMU routines

=cut

sub ram {
	return \@ram;
}

sub TIEARRAY {
	my %self;
	my ($class, $args) = @_;
	warn "tiemem",dump( $class, $args );
	$self{WRAP} = \@ram;
	foreach my $p ( qw/mmu debug/ ) {
		confess "no $p ?" unless defined($args->{$p});
		$self{$p} = $args->{$p}
	}
	return bless \%self, $class;
}

sub FETCH {
	my ($self, $index) = @_;
	$self->_read($index);
}

sub STORE {
	my ($self, $index, $value) = @_;
	$self->_write( $index, $value );
}

sub FETCHSIZE {
	my $self = shift;
	scalar(@{$$self{WRAP}});
}

sub STORESIZE {
	my ($self, $count) = @_;
	$#{$$self{WRAP}} = $count - 1;
}

# TODO (?) Detect if the wrappee is tied and call it's EXTEND if it is,
# otherwise do nothing.
sub EXTEND { }

sub EXISTS {
	my ($self, $index) = @_;
	exists $$self{WRAP}[$index];
}

sub DELETE {
	my ($self, $index) = @_;
	delete $$self{WRAP}[$index];
}

sub CLEAR {
	my $self = shift;
	@{$$self{WRAP}} = ();
}

sub PUSH {
	my $self = shift;
	push @{$$self{WRAP}}, map Tie::Filter::_filter($$self{STORE}, $_), @_;
}

sub POP {
	my $self = shift;
	Tie::Filter::_filter($$self{FETCH}, pop @{$$self{WRAP}});
}

sub SHIFT {
	my $self = shift;
	Tie::Filter::_filter($$self{FETCH}, shift @{$$self{WRAP}});
}

sub UNSHIFT {
	my $self = shift;
	unshift @{$$self{WRAP}}, map Tie::Filter::_filter($$self{STORE}, $_), @_;
}

sub SPLICE {
	my $self = shift;
	my $offset = shift;
	my $length = shift;
	printf "## splice(%04x,%04x) %d,%d\n", ( $offset, $length ) x 2 if $debug;
	splice(@{$$self{WRAP}}, $offset, $length, @_);
}

sub UNTIE { }

sub DESTROY { }

=head1 SEE ALSO

L<perltie>, L<Tie::Filter>

=head1 AUTHOR

  Andrew Sterling Hanenkamp, <sterling@hanenkamp.com>

=head1 LICENSE AND COPYRIGHT

Copyright 2003 Andrew Sterling Hanenkamp. All Rights Reserved. This library is
free software; you can redistribute it and/or modify it under the same terms as
Perl itself.

=cut

1