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
