#!/usr/bin/perl

use strict;
use warnings;

package Games::Solitaire::Verify::App::From_DBM_FC_Solver;

use base 'Games::Solitaire::Verify::Base';

use Games::Solitaire::Verify::VariantsMap;
use Games::Solitaire::Verify::Solution;
use Games::Solitaire::Verify::State;
use Games::Solitaire::Verify::Move;

use Getopt::Long qw(GetOptionsFromArray);

__PACKAGE__->mk_acc_ref(
    [
        qw(
            _filename
            _variant_params
        )
    ]
);

sub _init
{
    my ($self, $args) = @_;

    my $argv = $args->{'argv'};

    my $variant_map = Games::Solitaire::Verify::VariantsMap->new();

    my $variant_params = $variant_map->get_variant_by_id("freecell");

    GetOptionsFromArray(
        $argv,
        'g|game|variant=s' => sub {
            my (undef, $game) = @_;

            $variant_params = $variant_map->get_variant_by_id($game);

            if (!defined($variant_params))
            {
                die "Unknown variant '$game'!\n";
            }
        },
        'freecells-num=i' => sub {
            my (undef, $n) = @_;
            $variant_params->num_freecells($n);
        },
        'stacks-num=i' => sub {
            my (undef, $n) = @_;
            $variant_params->num_columns($n);
        },
        'decks-num=i' => sub {
            my (undef, $n) = @_;

            if (! ( ($n == 1) || ($n == 2) ) )
            {
                die "Decks should be 1 or 2.";
            }

            $variant_params->num_decks($n);
        },
        'sequences-are-built-by=s' => sub {
            my (undef, $val) = @_;

            my %seqs_build_by =
            (
                (map { $_ => $_ }
                    (qw(alt_color suit rank))
                ),
                "alternate_color" => "alt_color",
            );

            my $proc_val = $seqs_build_by{$val};

            if (! defined($proc_val))
            {
                die "Unknown sequences-are-built-by '$val'!";
            }

            $variant_params->seqs_build_by($proc_val);
        },
        'empty-stacks-filled-by=s' => sub {
            my (undef, $val) = @_;

            my %empty_stacks_filled_by_map =
            (map { $_ => 1 } (qw(kings any none)));

            if (! exists($empty_stacks_filled_by_map{$val}))
            {
                die "Unknown empty stacks filled by '$val'!";
            }

            $variant_params->empty_stacks_filled_by($val);
        },
        'sequence-move=s' => sub {
            my (undef, $val) = @_;

            my %seq_moves = (map { $_ => 1 } (qw(limited unlimited)));

            if (! exists ($seq_moves{$val}) )
            {
                die "Unknown sequence move '$val'!";
            }

            $variant_params->sequence_move($val);
        },
    )
        or die "Cannot process command line arguments";

    my $filename = shift(@$argv);

    if (!defined($filename))
    {
        $filename = "-";
    }

    $self->_variant_params($variant_params);
    $self->_filename($filename);

    return;
}

sub run
{
    my $self = shift;

    my $filename = $self->_filename();
    my $variant_params = $self->_variant_params();

    my $fh;

    if ($filename eq "-")
    {
        $fh = *STDIN;
    }
    else
    {
        open $fh, "<", $filename
            or die "Cannot open '$filename' - $!";
    }

    my $found = 0;

    LINES_PREFIX:
    while (my $line = <$fh>)
    {
        chomp($line);
        if ($line eq "Success!")
        {
            $found = 1;
            last LINES_PREFIX;
        }
    }

    if (!$found)
    {
        close($fh);
        die "State was not solved successfully.";
    }

    my $read_next_state = sub {
        my $line = <$fh>;
        chomp($line);
        if ($line eq "END")
        {
            return;
        }
        elsif ($line ne "--------")
        {
            die "Incorrect format.";
        }

        my $s = <$fh>;
        LINES:
        while ($line = <$fh>)
        {
            if ($line !~ /\S/)
            {
                last LINES;
            }
            $s .= $line;
        }
        $line = <$fh>;
        chomp($line);
        if ($line ne "==")
        {
            die "Cannot find '==' terminator";
        }

        return Games::Solitaire::Verify::State->new(
            {
                variant => "custom",
                variant_params => $self->_variant_params(),
                string => $s,
            },
        );
    };

    my $initial_state = $read_next_state->();

    my $running_state = $initial_state->clone();
    my @cols_indexes = (0 .. ($running_state->num_columns() - 1));
    my @fc_indexes = (0 .. ($running_state->num_freecells() - 1));

    print "-=-=-=-=-=-=-=-=-=-=-=-\n\n";

    my $out_running_state = sub {
        print $running_state->to_string();
        print "\n\n====================\n\n";
    };

    my $calc_foundation_to_put_card_on = sub {
        my $card = shift;

        DECKS_LOOP:
        for my $deck (0 .. $running_state->num_decks() - 1)
        {
            if ($running_state->get_foundation_value($card->suit(), $deck) ==
                $card->rank() - 1)
            {
                my $other_deck_idx;

                for $other_deck_idx (0 ..
                    (($running_state->num_decks() << 2) - 1)
                )
                {
                    if ($running_state->get_foundation_value(
                            $card->get_suits_seq->[$other_deck_idx % 4],
                            ($other_deck_idx >> 2),
                        ) < $card->rank() - 2 -
                        (($card->color_for_suit(
                            $card->get_suits_seq->[$other_deck_idx % 4]
                        ) eq $card->color()) ? 1 : 0)
                    )
                    {
                        next DECKS_LOOP;
                    }
                }
                return [$card->suit(), $deck];
            }
        }
        return;
    };

    $out_running_state->();
    MOVES:
    while (my $move_line = <$fh>)
    {
        chomp($move_line);

        if ($move_line eq "END")
        {
            last MOVES;
        }

        # I thought I needed them, but I did not eventually.
        #
        # my @rev_cols_indexes;
        # @rev_cols_indexes[@cols_indexes] = (0 .. $#cols_indexes);
        # my @rev_fc_indexes;
        # @rev_fc_indexes[@fc_indexes] = (0 .. $#fc_indexes);

        my ($src, $dest);
        my $dest_move;

        my @tentative_fc_indexes = @fc_indexes;
        my @tentative_cols_indexes = @cols_indexes;
        if (($src, $dest) = $move_line =~ m{\AColumn (\d+) -> Freecell (\d+)\z})
        {
            $dest_move = "Move a card from stack $tentative_cols_indexes[$src] to freecell $tentative_fc_indexes[$dest]";
        }
        elsif (($src, $dest) = $move_line =~ m{\AColumn (\d+) -> Column (\d+)\z})
        {
            $dest_move = "Move 1 cards from stack $tentative_cols_indexes[$src] to stack $tentative_cols_indexes[$dest]";
        }
        elsif (($src, $dest) = $move_line =~ m{\AFreecell (\d+) -> Column (\d+)\z})
        {
            $dest_move = "Move a card from freecell $tentative_fc_indexes[$src] to stack $tentative_cols_indexes[$dest]";
        }
        elsif (($src) = $move_line =~ m{\AColumn (\d+) -> Foundation \d+\z})
        {
            $dest_move = "Move a card from stack $tentative_cols_indexes[$src] to the foundations";
        }
        elsif (($src) = $move_line =~ m{\AFreecell (\d+) -> Foundation \d+\z})
        {
            $dest_move = "Move a card from freecell $tentative_fc_indexes[$src] to the foundations";
        }
        print "$dest_move\n\n";


        $running_state->verify_and_perform_move(
            Games::Solitaire::Verify::Move->new(
                {
                    fcs_string => $dest_move,
                    game => $running_state->_variant(),
                },
            )
        );
        $out_running_state->();

        # Now do the horne's prune.
        my $num_moved = 1; # Always iterate at least once.

        my $perform_prune_move = sub {
            my $prune_move = shift;

            $num_moved++;

            $running_state->verify_and_perform_move(
                Games::Solitaire::Verify::Move->new(
                    {
                        fcs_string => $prune_move,
                        game => $running_state->_variant(),
                    }
                )
            );
            print "$prune_move\n\n";
            $out_running_state->();
        };

        while ($num_moved)
        {
            $num_moved = 0;
            foreach my $idx (0 .. ($running_state->num_columns()-1) )
            {
                my $col = $running_state->get_column($idx);

                if ($col->len())
                {
                    my $card = $col->top();
                    my $f = $calc_foundation_to_put_card_on->($card);

                    if (defined($f))
                    {
                        $perform_prune_move->(
                            "Move a card from stack $idx to the foundations"
                        );
                    }
                }
            }

            foreach my $idx (0 .. ($running_state->num_freecells() - 1))
            {
                my $card = $running_state->get_freecell($idx);

                if (defined($card))
                {
                    my $f = $calc_foundation_to_put_card_on->($card);

                    if (defined($f))
                    {
                        $perform_prune_move->(
                            "Move a card from freecell $idx to the foundations"
                        );
                    }
                }
            }
        }

        my $new_state = $read_next_state->();

        # Calculate the new indexes.
        my @new_cols_indexes;
        my @new_fc_indexes;

        my %old_cols_map;
        my %old_fc_map;
        my %non_assigned_cols =
            (map { $_ => 1 } (0 .. $running_state->num_columns() - 1));

        my %non_assigned_fcs =
            (map { $_ => 1 } (0 .. $running_state->num_freecells() - 1));

        foreach my $idx (0 .. ($running_state->num_columns() - 1))
        {
            my $col = $running_state->get_column($idx);
            my $card = $col->len ? $col->pos(0)->to_string() : '';

            push @{$old_cols_map{$card}}, $idx;
        }

        foreach my $idx (0 .. ($running_state->num_columns() - 1))
        {
            my $col = $new_state->get_column($idx);
            my $card = $col->len ? $col->pos(0)->to_string() : '';
            # TODO: Fix edge cases.
            my $aref = $old_cols_map{$card};

            if ((!defined($aref)) or (! @$aref))
            {
                $aref = $old_cols_map{''};
            }
            my $i = shift(@$aref);

            $new_cols_indexes[$idx] = $i;
            if (defined($i))
            {
                delete($non_assigned_cols{$i});
            }
        }

        my @non_assigned_cols_list = sort { $a <=> $b } keys(%non_assigned_cols);
        foreach my $col_idx (@new_cols_indexes)
        {
            if (!defined($col_idx))
            {
                $col_idx = shift(@non_assigned_cols_list);
            }
        }

        foreach my $idx (0 .. ($running_state->num_freecells() - 1))
        {
            my $card_obj = $running_state->get_freecell($idx);
            my $card = defined($card_obj) ? $card_obj->to_string() : '';

            push @{$old_fc_map{$card}}, $idx;
        }

        foreach my $idx (0 .. ($running_state->num_freecells() - 1))
        {
            my $card_obj = $new_state->get_freecell($idx);
            my $card = defined($card_obj) ? $card_obj->to_string() : '';
            # TODO : Fix edge cases.

            my $aref = $old_fc_map{$card};

            if ((!defined($aref)) or (! @$aref))
            {
                $aref = $old_fc_map{''};
            }

            my $i = shift(@$aref);
            $new_fc_indexes[$idx] = $i;
            if (defined($i))
            {
                delete($non_assigned_fcs{$i});
            }
        }

        my @non_assigned_fcs_list = sort { $a <=> $b } keys(%non_assigned_fcs);

        foreach my $fc_idx (@new_fc_indexes)
        {
            if (!defined ($fc_idx))
            {
                $fc_idx = shift(@non_assigned_fcs_list);
            }
        }

        my $verify_state =
            Games::Solitaire::Verify::State->new(
                {
                    variant => 'custom',
                    variant_params => $self->_variant_params(),
                }
            );

        foreach my $idx (0 .. ($running_state->num_columns() - 1))
        {
            $verify_state->add_column(
                $running_state->get_column($new_cols_indexes[$idx])->clone()
            );
        }

        $verify_state->set_freecells(
            Games::Solitaire::Verify::Freecells->new(
                {
                    count => $running_state->num_freecells(),
                }
            )
        );

        foreach my $idx (0 .. ($running_state->num_freecells() - 1))
        {
            my $card_obj = $running_state->get_freecell($new_fc_indexes[$idx]);

            if (defined($card_obj))
            {
                $verify_state->set_freecell($idx, $card_obj->clone());
            }
        }

        $verify_state->set_foundations($running_state->_foundations->clone());

        {
            my $v_s = $verify_state->to_string();
            my $n_s = $new_state->to_string();
            if ($v_s ne $n_s)
            {
                die "States mismatch:\n<<\n$v_s\n>>\n vs:\n<<\n$n_s\n>>\n.";
            }
        }

        @cols_indexes = @new_cols_indexes;
        @fc_indexes = @new_fc_indexes;
    }

    print "This game is solveable.\n";

    close($fh);
}

package main;

Games::Solitaire::Verify::App::From_DBM_FC_Solver->new({ argv => [@ARGV] })->run();