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 MainLoop;
 214
 215 1;
 216 __END__
 217
 218 =head1 NAME
 219
 220 App::Mafia - Perl extension for blah blah blah
 221
 222 =head1 SYNOPSIS
 223
 224   use App::Mafia;
 225   blah blah blah
 226
 227 =head1 DESCRIPTION
 228
 229 Stub documentation for App::Mafia, created by h2xs. It looks like the
 230 author of the extension was negligent enough to leave the stub
 231 unedited.
 232
 233 Blah blah blah.
 234
 235
 236 =head1 SEE ALSO
 237
 238 Mention other useful documentation such as the documentation of
 239 related modules or operating system documentation (such as man pages
 240 in UNIX), or any relevant external documentation such as RFCs or
 241 standards.
 242
 243 If you have a mailing list set up for your module, mention it here.
 244
 245 If you have a web site set up for your module, mention it here.
 246
 247 =head1 AUTHOR
 248
 249 Marius Gavrilescu, E<lt>marius@E<gt>
 250
 251 =head1 COPYRIGHT AND LICENSE
 252
 253 Copyright (C) 2013 by Marius Gavrilescu
 254
 255 This library is free software; you can redistribute it and/or modify
 256 it under the same terms as Perl itself, either Perl version 5.18.1 or,
 257 at your option, any later version of Perl 5 you may have available.
 258
 259
 260 =cut