Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

GUI PerlDice for PerlMonks! v.1.1

by mr_leisure (Beadle)
on Jan 10, 2001 at 20:19 UTC ( #50930=CUFP: print w/replies, xml ) Need Help??

Okay folks, here is the GUI version of my previous Rhinehart Effort.

Please, please let me know what you think, if you used it, etc, as I didn't get much feedback last time...

Cheers, ML
#!/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); } }
# if ($mr_leisure) { bow; }
this is still not finished

Replies are listed 'Best First'.
Re: GUI PerlDice for PerlMonks! v.1.1
by ichimunki (Priest) on Jan 11, 2001 at 01:27 UTC
    Okay. I'm a little confused why you assign all these strings to variables with entirely vague var names like $one, $two ... only to assign the lot of them to a list. The following will be a lot easier to maintain/adapt/read:
    $roll = "something"; @strings = ( 'This is a string', 'Here is another', "I'm on a $roll", BAREWORD, 'That last one is interpreted as a string', 'All Done.' ); which can be retrieved using simple $strings[$x] notation.
    A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://50930]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (5)
As of 2021-09-27 08:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?