Sigh...
I rewrote it to something sightly. You owe me a 20-kg chunk of Atlantis.
#!/usr/bin/perl
#
# Flashy's bloodsports. http://digdilem.org/ - "Because thems trouts a
+in'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 i
+t, or the nick in $owner_nick)
#
# Optional Configuration (Will work fine without changing these, but y
+ou 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 unw
+rapping", '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 a
+nd $records{hunt}{weight}$scale)");
my %items = (
hunt => ["bear","gopher","rabbit","hunter","deer","fox","duck","mo
+ose","pokemon named Pikachu","park ranger","Yogi Bear","Boo Boo Bear"
+,"dog named Benji","cow","raccoon","koala bear","camper","channel lam
+er"],
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","S
+ubmarine","Seal","Seahorse","Jellyfish","Starfish","Electric Eel","Gr
+eat 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","playstati
+on3","hairdryer","trampoline","dog","cat","electric shock game","a bo
+ard 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 fie
+ld","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 Si
+nk","Bathroom Sink","Mud Puddle","Pail of Water","Bowl of Jell-O (tm)
+","Wash Basin","Rain Barrel","Aquarium","SnowBank","WaterFall","Cup o
+f 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 lu
+ck 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 yo
+urself 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 $rec
+ords{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 yo
+urself 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 w
+orld'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! Bett
+er 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 t
+rophy 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");
}
}
}
I haven't tested it -- I don't XChat either -- and haven't the faintest clue whether it works. You get to keep both pieces if it breaks. And I only did it because I started learning Perl by writing/modifying IRC scripts. It could still use more refactoring: three of the functions are practically identical.
