#!/usr/bin/perl
##########
#
# PerlDice.pl
#
# Author : mr_leisure (mr_leisure@hotmail.com)
# 
# Usage : PerlDice.pl OR 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 Foot
+pad Vroom Ovid 
Chromatic Danger Johannz Agoth Salvadors Davorg Mr_leisure Boo_radley 
+Mina 
Nate Merlyn Ichimunki Princepawn Notsoevil $code_or_die BBQ Dealgan Wo
+nko
Jcwren Rastolfe Adam Tye Dominus AgentM Nuance Eduardo t0mas KM Btrott
+ Zdog
Guildenstern Mischief Repson Clemburg Zencrypt Lhoward Russ Japhy Mdil
+lon 
Corion BigJoe Arturo Jptxs Jjhorner Redmist Ozymandias Kudra OeufMayo 
+Neophyte
Snowcrash Hannibal Sutch Swiftone Gag PurlGurl Perlknight Macphisto Pe
+truchio
MF Jima C-era Kschwab Mkmcconn ChOas Crazy_insomniac Dchetlin Coreolyn
+ Kapper
Redcloud PsychoSpunk Malkavian Tekniko Colderclimate j.a.p.h Erudil Ru
+ss Plaid
Athomason ZZamboni Jeffa Neshura Mrmick Royalnjr Wombat PipTigger Artu
+ro zencrypt
Kapper Trimbach Epoptai Jeroenes Stefan_K John-Paul Pope Tstanley Moth
+ra Albannach
Alfie The_Slycer Wardk Tsvika_t OzzyOsbourne Kilinrax Fundflow Gambler
+ Gharris );

$rn = $names[rand @names];
$rn2 = $names[rand @names];

# perlmonks related stuff

$one = "\nTell $rn you like to take long walks on the beach, usually w
+ith $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 use
+s 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 anythin
+g?\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.\n";
$sixteen = "\nTell $rn you taught $rn2 everything they know.\n";
$seventeen = "\nPost \"Why $rn Is A Fraud\", and make some wild accusa
+tions.\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, $tse
+ven, $teight,
$tnine, $thirty );

$rstring = $strings[rand @strings];
$rall = $all [rand @all];

$mw = MainWindow->new;

$mw->title("PerlDice for PerlMonks!");
$mw->Label(-text => "Don't forget to read the disclaimer!")->pack;

$text = $mw->Scrolled("Text",
    -relief=> "sunken",
    -background => "gray60",
    -width => 80,
    -height => 20,
    );

$text->pack(-side => "left",
    -fill => "both",
    -expand => "yes");

# $mw->Button(-text => "Clear Window",
#     -command => \&clear_window)->pack(-side => "bottom",
#        -fill => "x");
#
#        See comment next to clear_window subroutine
#

$mw->Button(-text => "Run Again",
    -command => \&roll_dice)->pack(-side => "bottom",
            -fill => "x");

$mw->Button(-text => "Quit",
    -command => sub {exit})->pack(-side => "bottom",
        -fill => "x");

if ($opt{dice}) {

$text->insert('end', $rall);

} else {

$text->insert('end',$rstring);

}


 $menubar = $mw->Frame(-relief => "raised",
    -borderwidth => 2)->pack(-anchor => "nw", 
    -fill => "x");

$filemenu = $menubar->Menubutton(-text => "Help",
    -underline => 1)->pack(-side => "left");

    $filemenu->separator();

    $filemenu->command(-label => "About PerlDice for PerlMonks!",
        -command => \&about_box);




MainLoop;

sub about_box

{

if (! Exists ($helpmenu)) {

$helpmenu = $filemenu->Toplevel();
    $helpmenu->title("About PerlDice for PerlMonks!");
    $helpmenu->Label(-justify => center,
    -text => "PerlDice for PerlMonks!\nby mr_leisure\nhttp://members.t
+ripod.com/misc/splash.swf")->pack;
    $helpmenu->Button(-text =>"Done",
        -command => sub {$helpmenu->withdraw } )->pack(-expand => "yes
+");

        } else {

        $helpmenu->deiconify();
        $helpmenu->raise();
        }
        }







#sub clear_window        # for some reason this doesn't work, but it s
+hould dammit

#{

#$text->delete(0,'end');

#}

sub roll_dice 

{

srand;

@names = qw ( Extremely Tilly Turnstep ybiC Zoogie Chipmunk Mirod Foot
+pad Vroom Ovid 
Chromatic Danger Johannz Agoth Salvadors Davorg Mr_leisure Boo_radley 
+Mina 
Nate Merlyn Ichimunki Princepawn Notsoevil $code_or_die BBQ Dealgan Wo
+nko
Jcwren Rastolfe Adam Tye Dominus AgentM Nuance Eduardo t0mas KM Btrott
+ Zdog
Guildenstern Mischief Repson Clemburg Zencrypt Lhoward Russ Japhy Mdil
+lon 
Corion BigJoe Arturo Jptxs Jjhorner Redmist Ozymandias Kudra OeufMayo 
+Neophyte
Snowcrash Hannibal Sutch Swiftone Gag PurlGurl Perlknight Macphisto Pe
+truchio
MF Jima C-era Kschwab Mkmcconn ChOas Crazy_insomniac Dchetlin Coreolyn
+ Kapper
Redcloud PsychoSpunk Malkavian Tekniko Colderclimate j.a.p.h Erudil Ru
+ss Plaid
Athomason ZZamboni Jeffa Neshura Mrmick Royalnjr Wombat PipTigger Artu
+ro zencrypt
Kapper Trimbach Epoptai Jeroenes Stefan_K John-Paul Pope Tstanley Moth
+ra Albannach
Alfie The_Slycer Wardk Tsvika_t OzzyOsbourne Kilinrax Fundflow Gambler
+ Gharris );

$rn = $names[rand @names];
$rn2 = $names[rand @names];

# perlmonks related stuff

$one = "\nTell $rn you like to take long walks on the beach, usually w
+ith $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 use
+s 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 anythin
+g?\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 accusa
+tions.\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, $tse
+ven, $teight,
$tnine, $thirty );

$rstring = $strings[rand @strings];
$rall = $all [rand @all];


if ($opt{dice}) {

$text->insert('end',$rall);
} else {
$text->insert('end',$rstring);
}
}
[download]

# if ($mr_leisure) { bow; }
[download]