[app-mafia.git] / lib / App / Mafia.pm

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>';

MainLoop;

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
Commit	Line	Data
46355154 MG	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
df4e059d MG	213	MainLoop;
df4e059d MG	214
46355154 MG	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