# A generic container. A container is any object that can hold other objects.

package Container;
use strict;
use vars qw(@ISA);
use Thing;
use Verb;
use UNIVERSAL qw(isa);
use Text;
use Error;
@ISA=qw{Thing};

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $this  = Thing::new($class,@_);
	bless ($this, $class);
	return $this;
}

# Cleans up after a container is deleted
# Transfer all things it contained into the place where the container is located
sub remove {
	my $this = shift;
	my $loc = $this->location;

	if ($loc) {
		foreach (@{$this->contents}) {
			$_->location($loc) if $_;
	                $loc->contents_add($_);
		}

        	# now $this doesn't contain anything. should we do this with
		# contents_remove instead?
		$this->contents([]);
	}
	
	my $ret=Thing::remove($this);
	return $ret if (Error::iserror($ret));
}

# Add a new thing to the container.
sub contents_add {
	my $this=shift;
	my $thing=shift;
	
	if (! isa($thing,"Thing")) {
		return Error->new("Tried to add something ($thing) that's not a valid object to a container.");
	}

	# Ask the object to move.
	$thing->location($this) || return undef;

	# TODO: duplicate object detection?
	my @contents=@{$this->contents};
	push @contents,$thing;
	$this->contents(\@contents);
}

# Remove somthing from the container.
sub contents_remove {
	my $this=shift;
	my $thing=shift;
	# This is a trifle expensive, but it doesn't happen too often.
	# I did it this way rather than using a hash for the objects, becuase
	# a hash is a lot of bother when you want to save objects on it.
	my $t;
	my @newcontents=();
	foreach $t (@{$this->contents}) {
		if ($thing != $t) {
			push @newcontents,$t;
		}
	}
	$this->contents(\@newcontents);
}

# Pass it an object, it will return true if said object is in this container.
sub contents_test {
	my $this=shift;
	my $object=shift;
	
	my $thing=undef;
	foreach $thing (@{$this->contents}) {
		if ($thing == $object) {
			return 1;
		}
	}
	
	return undef;
}

# Look inside the container for an object.
sub verb_look_inside {
	my $this=shift;
	my $verbcall=shift;

	# Figure out what is the direct object, looking at my contents.
	my @objects=$verbcall->caller->find_object($verbcall->word('direct_object'),@{$this->contents});
	if ($#objects > 0) {
		# Use a question callback to figure out which object they 
		# meant. Note that this is a closure, so it can see @objects
		# and $verbcall, etc.
		$verbcall->caller->question_callback(sub {
			my $newverbcall=shift;
			if ($newverbcall->command =~ m/^(\d+)$/ &&
			    $newverbcall->command <= $#objects + 1) {
				$verbcall->direct_object($objects[$newverbcall->command - 1]);
				return $verbcall;
			}
			else {
				return undef;
			}
		});
		my $n=1;
		return "Which \"".$verbcall->word('direct_object')."\" do you mean?",
			sort(map("\t".$n++.". ".$_->name, @objects));
	}
	else {
		$verbcall->direct_object(shift @objects);
	}

	if ($verbcall->direct_object) {
		return $verbcall->direct_object->verb_look($verbcall);
	}
	else {
		return "There is no \"".$verbcall->word('direct_object')."\" inside ".$this->name.".";
	}
}

# Change this so we show the contents. Note that it takes a caller now,
# who is not shown on the list of contents. That's special to containers'
# look methods.
sub look {
	my $this=shift;
	
	return ($this->description,$this->listobjects(ActiveUser::getactive));
		
}

# Pretty-prints the contents of the container.
sub listobjects {
	my $this=shift;
	my $caller=shift;

	# Generate a list the names of all the objects in the container.
	my @names;
	my $thing;
	foreach $thing (@{$this->contents}) {
		if ($thing && $thing != $caller) {
			push @names, $thing->name;
		}	
	}

	# Pretty-print the list of all the ojects in the container.
	if (@names) {
		return Text::subst($this->filled_msg, {
				name => $this->name,
				list => Text::MakeList(@names),
			});
	}
	else {
		return Text::subst($this->empty_msg, {
				name => $this->name,
			});
	}
}

# This is a hack. See README.programming for why I have to do this.
sub is_invalid_name {
	return Thing::is_invalid_name(@_);
}
sub verb_rename {
	return Thing::verb_rename(@_);
}
sub verb_help {
	return Thing::verb_help(@_);
}

1