From 4635515475e2fa584b579d104f8798c9324d2d40 Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Sun, 19 Jan 2014 21:47:24 +0200 Subject: [PATCH] Initial commit --- Changes | 6 ++ MANIFEST | 6 ++ Makefile.PL | 12 +++ README | 40 ++++++++ lib/App/Mafia.pm | 258 +++++++++++++++++++++++++++++++++++++++++++++++ mafia | 6 ++ t/App-Mafia.t | 18 ++++ 7 files changed, 346 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/App/Mafia.pm create mode 100755 mafia create mode 100644 t/App-Mafia.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..40978cd --- /dev/null +++ b/Changes @@ -0,0 +1,6 @@ +Revision history for Perl extension App::Mafia. + +0.001 Tue Sep 3 14:49:10 2013 + - original version; created by h2xs 1.23 with options + -AX --skip-exporter -b 5.14.0 -v 0.001 App::Mafia + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..1af3abc --- /dev/null +++ b/MANIFEST @@ -0,0 +1,6 @@ +Changes +Makefile.PL +MANIFEST +README +t/App-Mafia.t +lib/App/Mafia.pm diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..2929484 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,12 @@ +use 5.014000; +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + NAME => 'App::Mafia', + VERSION_FROM => 'lib/App/Mafia.pm', # finds $VERSION + PREREQ_PM => {}, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'lib/App/Mafia.pm', # retrieve abstract from module + AUTHOR => 'Marius Gavrilescu ') : ()), +); diff --git a/README b/README new file mode 100644 index 0000000..4bda95b --- /dev/null +++ b/README @@ -0,0 +1,40 @@ +App-Mafia version 0.001 +======================= + +The README is used to introduce the module and provide instructions on +how to install the module, any machine dependencies it may have (for +example C compilers and installed libraries) and any other information +that should be provided before the module is installed. + +A README file is required for CPAN modules since CPAN extracts the +README file from a module distribution so that people browsing the +archive can use it get an idea of the modules uses. It is usually a +good idea to provide version information here so that people can +decide whether fixes for the module are worth downloading. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + + blah blah blah + +COPYRIGHT AND LICENCE + +Put the correct copyright and licence information here. + +Copyright (C) 2013 by Marius Gavrilescu + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.18.1 or, +at your option, any later version of Perl 5 you may have available. + + diff --git a/lib/App/Mafia.pm b/lib/App/Mafia.pm new file mode 100644 index 0000000..d7f6cc1 --- /dev/null +++ b/lib/App/Mafia.pm @@ -0,0 +1,258 @@ +package App::Mafia; + +use 5.014000; +use strict; +use warnings; +no warnings qw/experimental::smartmatch/; + +our $VERSION = '0.001'; + +use Mafia; +use Tk::BrowseEntry; +use Tk::CodeText; +use Tk::DialogBox; +use Tk::ROText; +use Tk::Table; +use Tk; + +use Data::Dumper qw/Dumper/; +use List::Util qw/shuffle/; + +use constant TABLE_PAD => 2; +use constant ACTIONS => [qw/lynch factionkill protect vig roleblock jailkeep guncheck track watch guard rolecopcheck copcheck skill hide/]; + +################################################## + +my ($day, $night) = (0, 0); +my ($top, $editor, $phase_frame, $new_day, $new_night); +my (@names, @roles, @factions, %actions); + +sub set_section_text{ + my ($tag, $text, @tag_config) = @_; + if (my @ranges = $editor->tagRanges($tag)) { +# $ranges[0] = int $ranges[0]; + say "Inerting text at $ranges[0] chars"; + $editor->DeleteTextTaggedWith($tag); + $editor->insert($ranges[0], $text, $tag); + } else { + $editor->insert(end => $text, $tag, "\n"); + } + $editor->tagConfigure($tag => @tag_config); +} + +sub edit_player_list{ + my $dialog = $top->Toplevel; + my $table = $dialog->Frame->pack; + my $rownum = 0; + + my $role_listbox = sub{ + my $num = $_[0]; + my $box = $table->BrowseEntry(-variable => \$roles[$num], qw/-state readonly/); + $box->insert(end => @{ROLE()}); + $box->grid(-column => 1, -row => $num + 1, -padx => TABLE_PAD, -pady => TABLE_PAD); + }; + + my $faction_listbox = sub{ + my $num = $_[0]; + my $box = $table->BrowseEntry(-variable => \$factions[$num], qw/-state readonly/); + $box->insert(end => @{FACTION()}); + $box->grid(-column => 2, -row => $num + 1, -padx => TABLE_PAD, -pady => TABLE_PAD); + }; + + my $add_row = sub{ + my $num = $rownum++; + $table->Entry(-textvariable => \$names[$num])->grid(-column => 0, -row => $num + 1, -padx => TABLE_PAD, -pady => TABLE_PAD); + $role_listbox->($num); + $faction_listbox->($num); + }; + + my $randomize_names = sub{ + my @snames = shuffle @names; + $names[$_] = $snames[$_] for 0 .. $#snames; + }; + + my $write_setup = sub{ + my $result = ''; + $result .= "player '$names[$_]' => $roles[$_], $factions[$_];\n" for 0 .. $#names; + set_section_text playerlist => $result, qw/-background snow/; + $dialog->withdraw; + }; + + $table->Label(-text => 'Name')->grid(-column => 0, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD); + $table->Label(-text => 'Role')->grid(-column => 1, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD); + $table->Label(-text => 'Faction')->grid(-column => 2, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD); + + $add_row->() for 1 .. ($#names + 1); + + my $buttons = $dialog->Frame; + $buttons->Button(-text => 'Add player', -command => $add_row)->pack(qw/-side left/); + $buttons->Button(-text => 'Randomize names', -command => $randomize_names)->pack(qw/-side left/); + $buttons->Button(-text => 'Write setup', -command => $write_setup)->pack(qw/-side left/); + $buttons->pack; +} + +sub edit_phase{ + my $phase = $_[0]; + my ($phase_type, $phase_number) = split //, $phase, 2; + my $dialog = $top->Toplevel; + my $table = $dialog->Frame->pack; + my $rownum = 0; + + my $action_listbox = sub{ + my $num = $_[0]; + my $box = $table->BrowseEntry(-variable => \$actions{$phase}[$num]{action}, qw/-state readonly/); + $box->insert(end => @{ACTIONS()}); + $box->grid(-column => 0, -row => $num + 1, -padx => TABLE_PAD, -pady => TABLE_PAD); + }; + + my $player_listbox = sub{ + my ($num, $column, $key) = @_; + my $box = $table->BrowseEntry(-variable => \$actions{$phase}[$num]{$key}, qw/-state readonly/); + $box->insert(end => @names); + $box->grid(-column => $column, -row => $num + 1, -padx => TABLE_PAD, -pady => TABLE_PAD); + }; + + my $add_row = sub { + my $num = $rownum++; + $action_listbox->($num); + $player_listbox->($num, 1, 'source'); + $player_listbox->($num, 2, 'target'); + }; + + my $write_section = sub{ + my $result = $phase_type == 'N' ? "night; #Night $night\n" : "day; #Day $day\n"; + $result .= "$actions{$phase}[$_]{action} '$actions{$phase}[$_]{source}', '$actions{$phase}[$_]{target}';\n" for 0 .. scalar @{$actions{$phase}} - 1; + set_section_text $phase => $result, -background => ($phase_type == 'N' ? 'Light Sky Blue' : 'Antique White'); + $dialog->withdraw; + }; + + $table->Label(-text => 'Action')->grid(-column => 0, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD); + $table->Label(-text => 'Source')->grid(-column => 1, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD); + $table->Label(-text => 'Target')->grid(-column => 2, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD); + + my $buttons = $dialog->Frame; + $buttons->Button(-text => 'Add action', -command => $add_row)->pack(qw/-side left/); + $buttons->Button(-text => 'Write section', -command => $write_section)->pack(qw/-side left/); + $buttons->pack; +} + +sub run_script{ + my $out = ''; + $|=1; + close STDOUT; + open STDOUT, '>', \$out; + eval $editor->Contents; + close STDOUT; + my $dialog = $top->DialogBox(-title => 'Result', -buttons => ['OK']); + my $rotext = $dialog->add('ROText'); + utf8::decode($out); + $rotext->Contents($out); + $rotext->pack; + $dialog->Show; +} + +sub menu_new{ + say 'New!'; +} + +sub menu_open{ + say 'Open!'; +} + +sub menu_save{ + say 'Save!'; +} + +sub menu_save_as{ + say 'Save As!'; +} + +sub add_menu_item{ + $_[0]->command(-label => $_[1], -command => $_[2], -accelerator => $_[3]); + $top->bind($_[4], $_[2]); +} + +sub new_day{ + $day++; + $new_day->configure(qw/-state disabled/); + $new_night->configure(qw/-state normal/); + $phase_frame->Button(-text => "D$day", qw/-padx 1 -pady 1 -overrelief raised -relief flat/, -command => [\&edit_phase, "D$day"])->pack(qw/-side left/); + set_section_text "D$day" => "day; #Day $day\n", -background => 'Antique White'; +} + +sub new_night{ + $night++; + $new_day->configure(qw/-state normal/); + $new_night->configure(qw/-state disabled/); + $phase_frame->Button(-text => "N$night", qw/-padx 1 -pady 1 -overrelief raised -relief flat/, -command => [\&edit_phase, "N$night"])->pack(qw/-side left/); + set_section_text "N$night" => "night; #Night $night\n", -background => 'Light Sky Blue'; +} + +################################################## + +$top = MainWindow->new; +$editor = $top->Scrolled(qw/CodeText -syntax Perl -scrollbars osoe -font/, ['Terminus', 12])->pack; + +my $buttons = $top->Frame->pack; +$buttons->Button(-text => 'Edit player list', -command => \&edit_player_list)->pack(qw/-side left/); +$buttons->Button(-text => 'Run script', -command => \&run_script)->pack(qw/-side left/); +$new_day = $buttons->Button(-text => 'New day', -command => \&new_day)->pack(qw/-side left/); +$new_night = $buttons->Button(-text => 'New night', -command => \&new_night)->pack(qw/-side left/); + +my $phase_frame_container = $top->Frame->pack; +$phase_frame_container->Label(-text => 'Edit phase: ')->pack(qw/-side left/); +$phase_frame = $phase_frame_container->Frame->pack; + +$top->configure(-menu => my $menu = $top->Menu); +my $file = $menu->cascade(-label => '~File'); +add_menu_item $file, '~New', \&menu_new, 'Ctrl+N', ''; +add_menu_item $file, '~Open...', \&menu_open, 'Ctrl+O', ''; +add_menu_item $file, '~Save', \&menu_save, 'Ctrl+S', ''; +add_menu_item $file, 'Save ~As...', \&menu_save_as, 'Shift+Ctrl+S', ''; + +1; +__END__ + +=head1 NAME + +App::Mafia - Perl extension for blah blah blah + +=head1 SYNOPSIS + + use App::Mafia; + blah blah blah + +=head1 DESCRIPTION + +Stub documentation for App::Mafia, created by h2xs. It looks like the +author of the extension was negligent enough to leave the stub +unedited. + +Blah blah blah. + + +=head1 SEE ALSO + +Mention other useful documentation such as the documentation of +related modules or operating system documentation (such as man pages +in UNIX), or any relevant external documentation such as RFCs or +standards. + +If you have a mailing list set up for your module, mention it here. + +If you have a web site set up for your module, mention it here. + +=head1 AUTHOR + +Marius Gavrilescu, Emarius@E + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2013 by Marius Gavrilescu + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.18.1 or, +at your option, any later version of Perl 5 you may have available. + + +=cut diff --git a/mafia b/mafia new file mode 100755 index 0000000..4bdbcf9 --- /dev/null +++ b/mafia @@ -0,0 +1,6 @@ +#!/usr/bin/perl -w -CSDA +use v5.14; +use App::Mafia; +use Tk; + +MainLoop; diff --git a/t/App-Mafia.t b/t/App-Mafia.t new file mode 100644 index 0000000..8c078df --- /dev/null +++ b/t/App-Mafia.t @@ -0,0 +1,18 @@ +# Before 'make install' is performed this script should be runnable with +# 'make test'. After 'make install' it should work as 'perl App-Mafia.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use strict; +use warnings; + +use Test::More tests => 1; +BEGIN { use_ok('App::Mafia') }; + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + -- 2.39.2