#!/usr/bin/perl
#
# Flashy's bloodsports. http://digdilem.org/ - "Because thems trouts ain't gonna catch themselves!"
# (Credit to the original Eggdrop TCL script by Nerfbendr)
#
# Adds silly !hunt, !fish and !trophy and !present public triggers
# Also !newmonth will clean out the trophy cupboard. (Only if you do it, or the nick in $owner_nick)
#
# Optional Configuration (Will work fine without changing these, but you can if you like)
my $owner_nick='rainbowwarrior'; # Your nick - you can only reset the scores remotely if you use this nick.
my $scale = 'kg'; # Say here whether you want to measure weights in lb or kg.
my $catch_percent=90; # How often you catch or shoot something.
my $trophy_cabinet = Xchat::get_info( 'xchatdir' ) . "\\trophies.txt"; # File to keep the trophies in.
# End user configuration

use strict;
use warnings;
use Storable qw/nstore retrieve/;

Xchat::register( "rainbowwarrrior's Huntin' 'n Fishin' and present unwrapping", 'v.004', "Hunting", "" );
Xchat::hook_print('Channel Message', "hunting");
Xchat::hook_print('Your Message', "hunting");
Xchat::hook_print('Private Message', "hunting");
Xchat::hook_print('Private Message to Dialog', "hunting");
my %records;
load_trophy();
Xchat::print("\002Loaded Flash's Huntin' 'n Fishin'\002 (!hunt, !fish !present !trophy - Current records are $records{fish}{weight}$scale and $records{hunt}{weight}$scale)");


my %items = (
	hunt => ["bear","gopher","rabbit","hunter","deer","fox","duck","moose","pokemon named Pikachu","park ranger","Yogi Bear","Boo Boo Bear","dog named Benji","cow","raccoon","koala bear","camper","channel lamer"],
	fish => ["Salmon","Herring","Yellowfin Tuna","Pink Salmon","Chub","Barbel","Perch","Northern Pike","Brown Trout","Arctic Char","Roach","Brayling","Bleak","Cat Fish","Sun Fish","Old Tire","Rusty Tin Can","Genie Lamp","Love Message In A Bottle","Old Log","Rubber Boot","Dead Body","Loch Ness Monster","Old Fishing Lure","Piece of the Titanic","Chunk of Atlantis","Squid","Whale","Dolphin","Porpoise","Stingray","Submarine","Seal","Seahorse","Jellyfish","Starfish","Electric Eel","Great White Shark","Scuba Diver","X","Lag Monster","Virus","Soggy Pack of Smokes","Pile of Weed","Boat Anchor","Pair Of Floaties","Mermaid","Merman","Halibut","Tiddler","Sock","Trout"],
	present => ["a new car","cake","guitar","dvd","xbox360","playstation3","hairdryer","trampoline","dog","cat","electric shock game","a board game","a snake","tickets to a rock concert","a blowup doll","book"],
);
my %places = (
	hunt => ["in some bushes","in a hunting blind","in a hole","up in a tree","in a hiding place","out in the open","in the middle of a field","downtown","on a street corner","at the local mall"],
	fish => ["Stream","Lake","River","Pond","Ocean","Bathtub","Kiddie's Swimming Pool","Toilet","Pile of Vomit","Pool of Urine","Kitchen Sink","Bathroom Sink","Mud Puddle","Pail of Water","Bowl of Jell-O (tm)","Wash Basin","Rain Barrel","Aquarium","SnowBank","WaterFall","Cup of Coffee","Glass of Milk"],
	present => ["in a cupboard","under a xmas tree","in the liverroom","up in a tree","in a hiding place","out in the open","upstairs","on a boat","on a street corner","at the local mall"],
);
my %last_users;
@last_users{qw/hunt fish present/} = ("Nobody") x 3;

sub reset_game {
	%records = (
		hunt => { qw/type bear weight 0 where Bush who Nobody/ },
		fish => { qw/type Trout weight 0 where Pool who Nobody/ },
		present => { qw/type xmas weight 0 where everywhere who Nobody/ },
	);
}

sub random_place {
	my ($type) = @_;
	die "Wrong type of place" unless $places{$type};

	my $ary = $places{$type};
	return $ary->[int rand scalar @$ary];
}

sub random_item {
	my ($type) = @_;
	die "Wrong type of item" unless $items{$type};

	my $ary = $items{$type};
	return $ary->[int rand scalar @$ary];
}

sub random_weight {
	my ($type) = @_;
	die "Wrong type of record" unless $records{$type};

	return int(rand($records{$type}{weight} + 10)) + 1;
}

sub hunt {
	my ($hunter) = @_;

	my $place = random_place('hunt');
	my $game = random_item('game');

	my @msgs = (
		[PRIV => "You hide $place and wait for something to wander by...",
		         ".", "..", "...",
		         "You think you hear something and fire wildly in that direction!"]
	);

	if (rand(100) > $catch_percent) {
		push @msgs, [PRIV => "Rats...you missed it, $hunter! Better luck next time!"];
		push @msgs, [PUB => "$hunter is useless, they missed by a mile!"];
		return @msgs;
	}

	my $weight = random_weight('hunt');

	push @msgs, [PRIV => "Congratulations, $hunter! You just bagged yourself a $weight$scale $game!"];
	push @msgs, [PUB => "$hunter just bagged a $weight$scale $game."];

	if ($weight > $records{hunt}{weight}) {
		push @msgs, [PRIV => "Wow!!! That's a new record! Way to go, $hunter! Type !trophy to see it!"];
		push @msgs, [PUB => "Wow! That breaks the old record of a $records{hunt}{weight}$scale $records{hunt}{type}! $hunter is amazing!"];

		$records{hunt} = {
			weight => $weight, type => $game,
			who => $hunter, where => $place };
		save_trophy();
	}

	return @msgs;
}

sub fish {
	my ($hunter) = @_;
	my $place = random_place('fish');
	my $fish = random_item('fish');

	my @msgs = (
		[PRIV => "You cast your line into a $place and wait for a bite...",
		         ".", "..", "...",
		         "You feel a tug on your line and reel it in..."]
	);

	if (rand(100) > $catch_percent) {
		push @msgs, [PRIV => "Rats...it got away, $hunter! Better luck next time!"];
		push @msgs, [PUB => "$hunter is useless, they failed to catch anything!"];
		return @msgs;
	}

	my $weight = random_weight('fish');
	push @msgs, [PRIV => "Congratulations, $hunter! You just caught yourself a $weight$scale $fish!"];
	push @msgs, [PUB => "$hunter just caught a $weight$scale $fish"];

	if ($weight > $records{fish}{weight}) {
		push @msgs, [PRIV => "Wow!!! That's a new record! Way to go, $hunter! Type !trophy to see it!"];
		push @msgs, [PUB => "Brilliant! That breaks the old record of a $records{fish}{weight}$scale $records{fish}{type}! $hunter is the world's best!"];

		$records{fish} = {
			weight => $weight, type => $fish,
			who => $hunter, where => $place };
		save_trophy();
	}

	return @msgs;
}

sub trophy {
	my %verbs = (
		fish => [fishing => 'caught'],
		hunt => [hunting => 'bagged'],
		present => ['present unwrapping' => 'unwrapped']
	);

	return map { [ 'PUB', $_ ] }
		map { sprintf "%s holds the %s record when they %s a %s$scale %s", @$_ }
		map { [ @$_[0, 3, 4, 1, 2] ] }
		map { [ @{ $records{$_} }{qw/who weight type/}, @{ $verbs{$_} } ] }
			qw/fish hunt present/;
}

sub present {
	my ($hunter) = @_;
	my $place = random_place('present');
	my $present = random_item('present');

	my @msgs = (
		[PRIV => "You unwrap your present from $place and see what you get...",
		         ".", "..", "...", "You unwrap and see ..."]
	);

	if (rand(100) > $catch_percent) {
		push @msgs, [PRIV => "Sorry no present this time $hunter! Better luck next time!"];
		push @msgs, [PUB => "$hunter is useless, they failed to get a present!"];
		return @msgs;
	}
	
	my $weight = random_weight('present');
	push @msgs, [PRIV => "Congratulations, $hunter! You just unwrapped a $weight$scale $present!"];
	push @msgs, [PUB => "$hunter just got a $weight$scale $present"];

	if ($weight > $records{present}{weight}) {
		push @msgs, [PRIV => "Wow!!! That's a new record! Way to go, $hunter! Type !trophy to see it!"];
		push @msgs, [PUB => "Brilliant! That breaks the old record of a $records{present}{weight}$scale $records{present}{type}! $hunter is the world's best!"];

		$records{present} = {
			weight => $weight, type => $present,
			who => $hunter, where => $place };
		save_trophy();
	}

	return @msgs;
}

sub new_month {
	my ($hunter, $mynick) = @_;
	$hunter = lc $hunter;

	if (not ($hunter eq lc $owner_nick or $hunter eq $mynick)) {
		return [PUB => "Who are you, $hunter to tell me to change the month?"];
	}

	reset_game();
	save_trophy();
	return [PUB => "It's a new month, all existing huntin' 'n fishin' and present unwrapping records are reset!"];
}

sub check_hogging {
	my ($type, $hunter) = @_;

	if ($last_users{$type} eq $hunter) {
		return [PUB => "Stop hogging all the best pitches $hunter, let someone else try first!"];
	}

	return;
}

sub load_trophy {
	reset_game();
	retrieve(\%records, $trophy_cabinet) or do {
		save_trophy();
		return;
	};
}

sub save_trophy {
	nstore(\%records, $trophy_cabinet)
		or die "Bah! Can't open the trophy cabinet to push this 'ere trophy in!";
}

my %triggers = (
	hunt     => \&hunt,
	fish     => \&fish,
	trophy   => \&trophy,
	present  => \&present,
	newmonth => \&new_month,
);

sub hunting {
	my ($who, $msg) = @{ $_[0] };
	my @pubwords = split(/ /, $msg);

	my $trigger = substr( lc $pubwords[0], 1 );
	my $func = $triggers{ $trigger };

	return unless $func;

	my $hunter = Xchat::strip_code($who);
	my $channel = Xchat::get_info('channel');
	my @msgs = check_hogging($trigger, $hunter);

	if (!@msgs) {
		@msgs = $func->($hunter, Xchat::get_info('nick'));
	}

	for my $msg (@msgs) {
		my $type = shift @$msg;
		if ($type eq 'PUB') {
			Xchat::command("msg $channel $_") for @$msg;
		} elsif ($type eq 'PRIV') {
			Xchat::command("msg $hunter $_") for @$msg;
		} else {
			Xchat::print("Unknown message type: $type");
		}
	}
}