lib/App/Mafia.pm

   1 package App::Mafia;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6 no warnings qw/experimental::smartmatch/;
   7
   8 our $VERSION = '0.001';
   9
  10 use Mafia;
  11 use Tk::BrowseEntry;
  12 use Tk::CodeText;
  13 use Tk::DialogBox;
  14 use Tk::ROText;
  15 use Tk::Table;
  16 use Tk;
  17
  18 use Data::Dumper qw/Dumper/;
  19 use List::Util qw/shuffle/;
  20
  21 use constant TABLE_PAD => 2;
  22 use constant ACTIONS => [qw/lynch factionkill protect vig roleblock jailkeep guncheck track watch guard rolecopcheck copcheck skill hide/];
  23
  24 ##################################################
  25
  26 my ($day, $night) = (0, 0);
  27 my ($top, $editor, $phase_frame, $new_day, $new_night);
  28 my (@names, @roles, @factions, %actions);
  29
  30 sub set_section_text{
  31   my ($tag, $text, @tag_config) = @_;
  32   if (my @ranges = $editor->tagRanges($tag)) {
  33 #       $ranges[0] = int $ranges[0];
  34         say "Inerting text at $ranges[0] chars";
  35         $editor->DeleteTextTaggedWith($tag);
  36         $editor->insert($ranges[0], $text, $tag);
  37   } else {
  38         $editor->insert(end => $text, $tag, "\n");
  39   }
  40   $editor->tagConfigure($tag => @tag_config);
  41 }
  42
  43 sub edit_player_list{
  44   my $dialog = $top->Toplevel;
  45   my $table = $dialog->Frame->pack;
  46   my $rownum = 0;
  47
  48   my $role_listbox = sub{
  49         my $num = $_[0];
  50         my $box = $table->BrowseEntry(-variable => \$roles[$num], qw/-state readonly/);
  51         $box->insert(end => @{ROLE()});
  52         $box->grid(-column => 1, -row => $num + 1, -padx => TABLE_PAD, -pady => TABLE_PAD);
  53   };
  54
  55   my $faction_listbox = sub{
  56         my $num = $_[0];
  57         my $box = $table->BrowseEntry(-variable => \$factions[$num], qw/-state readonly/);
  58         $box->insert(end => @{FACTION()});
  59         $box->grid(-column => 2, -row => $num + 1, -padx => TABLE_PAD, -pady => TABLE_PAD);
  60   };
  61
  62   my $add_row = sub{
  63         my $num = $rownum++;
  64         $table->Entry(-textvariable => \$names[$num])->grid(-column => 0, -row => $num + 1, -padx => TABLE_PAD, -pady => TABLE_PAD);
  65         $role_listbox->($num);
  66         $faction_listbox->($num);
  67   };
  68
  69   my $randomize_names = sub{
  70         my @snames = shuffle @names;
  71         $names[$_] = $snames[$_] for 0 .. $#snames;
  72   };
  73
  74   my $write_setup = sub{
  75         my $result = '';
  76         $result .= "player '$names[$_]' => $roles[$_], $factions[$_];\n" for 0 .. $#names;
  77         set_section_text playerlist => $result, qw/-background snow/;
  78         $dialog->withdraw;
  79   };
  80
  81   $table->Label(-text => 'Name')->grid(-column => 0, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD);
  82   $table->Label(-text => 'Role')->grid(-column => 1, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD);
  83   $table->Label(-text => 'Faction')->grid(-column => 2, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD);
  84
  85   $add_row->() for 1 .. ($#names + 1);
  86
  87   my $buttons = $dialog->Frame;
  88   $buttons->Button(-text => 'Add player', -command => $add_row)->pack(qw/-side left/);
  89   $buttons->Button(-text => 'Randomize names', -command => $randomize_names)->pack(qw/-side left/);
  90   $buttons->Button(-text => 'Write setup', -command => $write_setup)->pack(qw/-side left/);
  91   $buttons->pack;
  92 }
  93
  94 sub edit_phase{
  95   my $phase = $_[0];
  96   my ($phase_type, $phase_number) = split //, $phase, 2;
  97   my $dialog = $top->Toplevel;
  98   my $table = $dialog->Frame->pack;
  99   my $rownum = 0;
 100
 101   my $action_listbox = sub{
 102         my $num = $_[0];
 103         my $box = $table->BrowseEntry(-variable => \$actions{$phase}[$num]{action}, qw/-state readonly/);
 104         $box->insert(end => @{ACTIONS()});
 105         $box->grid(-column => 0, -row => $num + 1, -padx => TABLE_PAD, -pady => TABLE_PAD);
 106   };
 107
 108   my $player_listbox = sub{
 109         my ($num, $column, $key) = @_;
 110         my $box = $table->BrowseEntry(-variable => \$actions{$phase}[$num]{$key}, qw/-state readonly/);
 111         $box->insert(end => @names);
 112         $box->grid(-column => $column, -row => $num + 1, -padx => TABLE_PAD, -pady => TABLE_PAD);
 113   };
 114
 115   my $add_row = sub {
 116         my $num = $rownum++;
 117         $action_listbox->($num);
 118         $player_listbox->($num, 1, 'source');
 119         $player_listbox->($num, 2, 'target');
 120   };
 121
 122   my $write_section = sub{
 123         my $result = $phase_type == 'N' ? "night; #Night $night\n" : "day; #Day $day\n";
 124         $result .= "$actions{$phase}[$_]{action} '$actions{$phase}[$_]{source}', '$actions{$phase}[$_]{target}';\n" for 0 .. scalar @{$actions{$phase}} - 1;
 125         set_section_text $phase => $result, -background => ($phase_type == 'N' ? 'Light Sky Blue' : 'Antique White');
 126         $dialog->withdraw;
 127   };
 128
 129   $table->Label(-text => 'Action')->grid(-column => 0, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD);
 130   $table->Label(-text => 'Source')->grid(-column => 1, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD);
 131   $table->Label(-text => 'Target')->grid(-column => 2, -row => 0, -padx => TABLE_PAD, -pady => TABLE_PAD);
 132
 133   my $buttons = $dialog->Frame;
 134   $buttons->Button(-text => 'Add action', -command => $add_row)->pack(qw/-side left/);
 135   $buttons->Button(-text => 'Write section', -command => $write_section)->pack(qw/-side left/);
 136   $buttons->pack;
 137 }
 138
 139 sub run_script{
 140   my $out = '';
 141   $|=1;
 142   close STDOUT;
 143   open STDOUT, '>', \$out;
 144   eval $editor->Contents;
 145   close STDOUT;
 146   my $dialog = $top->DialogBox(-title => 'Result', -buttons => ['OK']);
 147   my $rotext = $dialog->add('ROText');
 148   utf8::decode($out);
 149   $rotext->Contents($out);
 150   $rotext->pack;
 151   $dialog->Show;
 152 }
 153
 154 sub menu_new{
 155   say 'New!';
 156 }
 157
 158 sub menu_open{
 159   say 'Open!';
 160 }
 161
 162 sub menu_save{
 163   say 'Save!';
 164 }
 165
 166 sub menu_save_as{
 167   say 'Save As!';
 168 }
 169
 170 sub add_menu_item{
 171   $_[0]->command(-label => $_[1], -command => $_[2], -accelerator => $_[3]);
 172   $top->bind($_[4], $_[2]);
 173 }
 174
 175 sub new_day{
 176   $day++;
 177   $new_day->configure(qw/-state disabled/);
 178   $new_night->configure(qw/-state normal/);
 179   $phase_frame->Button(-text => "D$day", qw/-padx 1 -pady 1 -overrelief raised -relief flat/, -command => [\&edit_phase, "D$day"])->pack(qw/-side left/);
 180   set_section_text "D$day" => "day; #Day $day\n", -background => 'Antique White';
 181 }
 182
 183 sub new_night{
 184   $night++;
 185   $new_day->configure(qw/-state normal/);
 186   $new_night->configure(qw/-state disabled/);
 187   $phase_frame->Button(-text => "N$night", qw/-padx 1 -pady 1 -overrelief raised -relief flat/,  -command => [\&edit_phase, "N$night"])->pack(qw/-side left/);
 188   set_section_text "N$night" => "night; #Night $night\n", -background => 'Light Sky Blue';
 189 }
 190
 191 ##################################################
 192
 193 $top = MainWindow->new;
 194 $editor = $top->Scrolled(qw/CodeText -syntax Perl -scrollbars osoe -font/, ['Terminus', 12])->pack;
 195
 196 my $buttons = $top->Frame->pack;
 197 $buttons->Button(-text => 'Edit player list', -command => \&edit_player_list)->pack(qw/-side left/);
 198 $buttons->Button(-text => 'Run script', -command => \&run_script)->pack(qw/-side left/);
 199 $new_day = $buttons->Button(-text => 'New day', -command => \&new_day)->pack(qw/-side left/);
 200 $new_night = $buttons->Button(-text => 'New night', -command => \&new_night)->pack(qw/-side left/);
 201
 202 my $phase_frame_container = $top->Frame->pack;
 203 $phase_frame_container->Label(-text => 'Edit phase: ')->pack(qw/-side left/);
 204 $phase_frame = $phase_frame_container->Frame->pack;
 205
 206 $top->configure(-menu => my $menu = $top->Menu);
 207 my $file = $menu->cascade(-label => '~File');
 208 add_menu_item $file, '~New', \&menu_new, 'Ctrl+N', '<Control-KeyRelease-n>';
 209 add_menu_item $file, '~Open...', \&menu_open, 'Ctrl+O', '<Control-KeyRelease-o>';
 210 add_menu_item $file, '~Save', \&menu_save, 'Ctrl+S', '<Control-KeyRelease-s>';
 211 add_menu_item $file, 'Save ~As...', \&menu_save_as, 'Shift+Ctrl+S', '<Shift-Control-KeyRelease-S>';
 212
 213 1;
 214 __END__
 215
 216 =head1 NAME
 217
 218 App::Mafia - Perl extension for blah blah blah
 219
 220 =head1 SYNOPSIS
 221
 222   use App::Mafia;
 223   blah blah blah
 224
 225 =head1 DESCRIPTION
 226
 227 Stub documentation for App::Mafia, created by h2xs. It looks like the
 228 author of the extension was negligent enough to leave the stub
 229 unedited.
 230
 231 Blah blah blah.
 232
 233
 234 =head1 SEE ALSO
 235
 236 Mention other useful documentation such as the documentation of
 237 related modules or operating system documentation (such as man pages
 238 in UNIX), or any relevant external documentation such as RFCs or
 239 standards.
 240
 241 If you have a mailing list set up for your module, mention it here.
 242
 243 If you have a web site set up for your module, mention it here.
 244
 245 =head1 AUTHOR
 246
 247 Marius Gavrilescu, E<lt>marius@E<gt>
 248
 249 =head1 COPYRIGHT AND LICENSE
 250
 251 Copyright (C) 2013 by Marius Gavrilescu
 252
 253 This library is free software; you can redistribute it and/or modify
 254 it under the same terms as Perl itself, either Perl version 5.18.1 or,
 255 at your option, any later version of Perl 5 you may have available.
 256
 257
 258 =cut