--- /dev/null
+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', '<Control-KeyRelease-n>';
+add_menu_item $file, '~Open...', \&menu_open, 'Ctrl+O', '<Control-KeyRelease-o>';
+add_menu_item $file, '~Save', \&menu_save, 'Ctrl+S', '<Control-KeyRelease-s>';
+add_menu_item $file, 'Save ~As...', \&menu_save_as, 'Shift+Ctrl+S', '<Shift-Control-KeyRelease-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, E<lt>marius@E<gt>
+
+=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
projects / app-mafia.git / commitdiff