Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??


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.

In reply to Re^5: Help with perl game by Anonymous Monk
in thread Help with perl game by rainbowwarrior

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    [choroba]: Tux: What kind of dead-key diacriticals do you use? It works for me: ůěščö
    [choroba]: Do the keys work at any other Tk application?

    How do I use this? | Other CB clients
    Other Users?
    Others cooling their heels in the Monastery: (7)
    As of 2017-09-25 19:27 GMT
    Find Nodes?
      Voting Booth?
      During the recent solar eclipse, I:

      Results (288 votes). Check out past polls.