#!/usr/bin/perl ########## # # PerlDice.pl # # Author : mr_leisure (mr_leisure@hotmail.com) # # Usage : PerlDice.pl / PerlDice.pl -dice # # Requirements : TK and Long modules # ########## use Getopt::Long; use Tk; my %opt = (); GetOptions(\%opt, "dice!", #enables 'diceman' options ); srand; @names = qw ( Extremely Tilly Turnstep ybiC Zoogie Chipmunk Mirod Footpad Vroom Ovid Chromatic Danger Johannz Agoth Salvadors Davorg Mr_leisure Boo_radley Mina Nate Merlyn Ichimunki Princepawn Notsoevil $code_or_die BBQ Dealgan Wonko Jcwren Rastolfe Adam Tye Dominus AgentM Nuance Eduardo t0mas KM Btrott Zdog Guildenstern Mischief Repson Clemburg Zencrypt Lhoward Russ Japhy Mdillon Corion BigJoe Arturo Jptxs Jjhorner Redmist Ozymandias Kudra OeufMayo Neophyte Snowcrash Hannibal Sutch Swiftone Gag PurlGurl Perlknight Macphisto Petruchio MF Jima C-era Kschwab Mkmcconn ChOas Crazy_insomniac Dchetlin Coreolyn Kapper Redcloud PsychoSpunk Malkavian Tekniko Colderclimate j.a.p.h Erudil Russ Plaid Athomason ZZamboni Jeffa Neshura Mrmick Royalnjr Wombat PipTigger Arturo); $rn = $names[rand @names]; $rn2 = $names[rand @names]; # perlmonks related stuff $one = "\nTell $rn you like to take long walks on the beach, usually with $rn2.\n"; $two = "\nSpam the CB with \"Vroom, My Life for You!\".\n"; $three = "\nBuy a #!/usr/bin/perl bumpersticker, and stick it on your forehead.\n"; $four = "\nTell $rn he should really read the documentation, just like $rn2 said.\n"; $five = "\nTell $rn that $rn2 writes really sloppy code, and NEVER uses the -w switch.\n"; $six = "\nTell $rn you are really $rn2 incognito.\n"; $seven = "\nYour task this week : ++ everything $rn has posted.\n"; $eight = "\nYour task this week : -- everything $rn has posted.\n"; $nine = "\n$rn is hungry. Feed them.\n"; $ten = "\nTell $rn that $rn2 told you that he downvoted them.\n"; $eleven = "\n\/msg $rn, telling them you really, really like them.\n"; $twelve = "\nAsk $rn if they are feeling ok. Can you get them anything?\n"; $thirteen = "\n$rn is after you. Attack is the best form of defence!\n"; $fourteen = "\nThe next time $rn says something in CB, repeat it.\n"; $fifteen = "\nWrite a book on Perl."; $sixteen = "\nTell $rn you taught $rn2 everything they know.\n"; $seventeen = "\nPost \"Why $rn Is A Fraud\", and make some wild accusations.\n"; $eighteen = "\n-- the node that gave you this code.\n"; $nineteen = "\n++ the node that gave you this code.\n"; $twenty = "\nLearn a Language in 3 days.\n"; # diceman stuff $tone = "\nDon't go home for two days.\n"; $ttwo = "\nGo out tonight, and drink the entire bottle of something.\n"; $tthree = "\nStop playing this game.\n"; $tfour = "\nJoin a local club.\n"; $tfive = "\nGet a tattoo.\n"; $tsix = "\nGive 10 % of your paycheck to a charity.\n"; $tseven = "\nShoplift something of worth from your local store.\n"; $teight = "\nGo to Church every sunday this month.\n"; $tnine = "\nCall up an old friend right now.\n"; $thirty = "\nWrite Ten New Options for PerlDice.\n"; # perlmonks array @strings = ( $one, $two, $three, $four, $five, $six, $seven, $eight, $nine, $ten, $eleven, $twelve, $thirteen, $fourteen, $fifteen, $sixteen, $seventeen, $eighteen, $nineteen, $twenty); #all options (careful - this includes the diceman array) @all = ($one, $two, $three, $four, $five, $six, $seven, $eight, $nine, $ten, $eleven, $twelve, $thirteen, $fourteen, $fifteen, $sixteen, $seventeen, $eighteen, $nineteen, $twenty, $tone, $ttwo, $tthree, $tfour, $tfive, $tsix, $tseven, $teight, $tnine, $thirty ); $rstring = $strings[rand @strings]; $rall = $all [rand @all]; if ($opt{dice}) { print "\t\nYou are using the DiceMan Mode : \n\n"; print "\tDISCLAIMER\n"; print "\tThe author of this program (mr_leisure)\n"; print "\tIs in no way responsible for the consequences\n"; print "\tOf using this program, direct or indirect. YOU are\n"; print "\tResponsible for your own actions.\n"; print "\n\n"; print "\n$rall\n"; } else { print "\nUser Friendly Mode : No Dice!\n"; print "\n$rstring\n"; } # copyright 2001 jimkasystems.co ltd - based on the philosophy of dr luke rhinehart #### #if ($mr_leisure) { bow; }