#!/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 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 zencrypt
Kapper Trimbach Epoptai Jeroenes Stefan_K John-Paul Pope Tstanley Mothra 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 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.\n";
$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];

$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.tripod.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 should dammit

#{

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

#}

sub roll_dice 

{

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 zencrypt
Kapper Trimbach Epoptai Jeroenes Stefan_K John-Paul Pope Tstanley Mothra 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 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}) {

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