#!/usr/bin/perl
#use Fcntl q{:flock};
#use Mooix::Thing;
run sub {
	my $this=shift;
	%_=@_;

	# Don't notice things while flying.
	return if $this->flying;

	# Panic on any kind of intense event.
	if ($_{intensity} >= 70) {
		$this->panic if $this->background;
		exit;
	}
	
	# Only repeat sometimes.
	return if rand() < 0.75;

	# Only repeat say's, from other objects, that are not too short.
	return if $_{originator} == $this ||
	          $_{sense} ne 'hear' ||
	          ($_{event} ne 'say' && $_{event} ne 'directed_say' &&
	           $_{event} ne 'whisperto' && $_{event} ne 'whisper' &&
	           $_{event} ne 'yell') ||
		  length $_{quote} < 2;
	
	# Background to delay for a sec.
	return unless $this->background;
	select(undef, undef, undef, rand * 0.1);
	
	my $phrase=$_{quote};
	
	# Repeat last word only, if the quote seems quite long.
	($phrase)=$phrase=~/.*\W(\w+)[^\w]*$/ if length $phrase > 30;
	
	# Exclaim things!
	$phrase=~s/[.?]$//;
	$phrase.="!" unless $phrase=~/!$/;
	
	# Learn new phrases through repitition.
	# If there are already max phrases in short-term, replace least-well
	# known phrse, or increment counter for existing phrase.
	my $lock=$this->getlock(LOCK_EX, "phrases");
	my %phrases=$this->phrases;
	if (! exists $phrases{$phrase} && scalar keys %phrases >= $this->iq) {
		my $remove;
		foreach my $key (keys %phrases) {
			if (! defined $remove || 
			    $phrases{$key} < $phrases{$remove}) {
				$remove=$key;
		   	}
		}
		delete $phrases{$remove};
		
	}
	$phrases{$phrase}++;
	$this->phrases(%phrases);
	close $lock;

	# Pick a phrase to say back, parrot must have heard it at least twice
	# thougha. Look for something matching a word in the input, failing
	# that pick at random.
	my @phrases=grep { $phrases{$_} >=2 } keys %phrases;
	return unless @phrases;
	my @matches;
	if (rand > 0.3) {
		my $q=$_{quote};
		$q=~s/[^A-Za-z\s]//g;
		my @words=split ' ', $q;
		foreach my $w (@words) {
			foreach (@phrases) {
				push @matches, $_ if /\Q$w\E/i;
			}
		}
	}
	if (@matches) {
		$phrase=$matches[rand @matches];
	}
	else {
		$phrase=$phrases[rand @phrases];
	}
	
	# Repeat short stuff randomly.
	my $r=1;
	my $p=$phrase;
	while (length $phrase < 10 && $r++ < 3 && rand() > 0.25) {
		$phrase.=" ".$p;
	}
	
	# Use a different message then the ones I repeat, to avoid loops
	# with other parrots.
	$this->msg("squawk", quote => $phrase, avatar => $_{originator});
}
