Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

Re^5: Help with perl game

by Anonymous Monk
on Dec 08, 2012 at 15:52 UTC ( #1007900=note: print w/replies, xml ) Need Help??

in reply to Re^4: Help with perl game
in thread Help with perl game


I rewrote it to something sightly. You owe me a 20-kg chunk of Atlantis.

#!/usr/bin/perl # # Flashy's bloodsports. - "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 => " 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 => " 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.

Please do yourself a favour and learn some Perl, and please answer the questions the monks pose for you, instead of just saying that you don't know what's wrong.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1007900]
[haukex]: Discipulus: which one do you mean?
[choroba]: Hermit

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (8)
As of 2018-06-22 08:09 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (122 votes). Check out past polls.