Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Comment on

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

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.

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

Title:
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!
  • 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?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others examining the Monastery: (15)
    As of 2015-07-07 16:35 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (91 votes), past polls