#!/usr/bin/perl
#
#   Battleship.pl
#
#   From www.perlmonks.com
#
use v5.10.1;
use strict;
use warnings;
use Data::Dumper;
use Getopt::Long;

my $dbg=0;      # Set to 1 to show computer's board

my $fl_print_boards = 'H';
my $shots_per_turn = 3;
my $turn;

my %Pieces = (
    Battleship => 4,    Carrier => 5,   Destroyer => 3,
    Patrol => 2,        Submarine => 3,
);

my @mnu_who_goes_first = (
    [ "You",            sub { $turn = 'HUMAN' } ],
    [ "Computer",       sub { $turn = 'Computer' }],
    [ "Random",         sub { int(rand(1000)) } ],
);

my @mnu_game_mode = (
    [   "Regular (one-shot mode)",  sub { $shots_per_turn = 1 } ],
    [   "Salvo (three-shot mode)",  sub { $shots_per_turn = 3 } ],
);

main::startup();

#******************************************************************************
#*******************************STARTUP FUNCTION*******************************
#******************************************************************************

sub main::startup {
 local $main::startup::name = "";
 print "\n\nPlease enter your name: ";
 chomp($main::startup::name = <STDIN>);
 main::call();
}

#*******************************************************************************
#******************************MAIN CALL FUNCTION*******************************
#*******************************************************************************

sub main::call {
 srand;
 local @main::com_ships::com_all_ships = ();
 local @main::user_ships::user_all_ships = ();
 local @main::com_ships::com_board = generate_board();
 local @main::user_ships::user_board = generate_board();

 local @main::letters::letters = ("A" .. "J");
 local $main::game_play::whos_first = '';
 local $main::game_play::mode = '';
 local @main::game_play::user_shots_check;
 local $main::com_ships::hits = '';
 local $main::user_ships::hits = '';
 generate_ship_pos::start();
 get_user_ship_pos::start();
 game_play::start();
}

#*******************************************************************************
#***************************SECONDARY CALL FUNCTIONS****************************
#*******************************************************************************

sub generate_ship_pos::start {
    for my $k (keys %Pieces) {
        generate_ship_pos::any_ship($Pieces{$k}, $k);
    }
    print_board(\@::main::com_ships::com_board) if $dbg;

    # Reset the board, we used it as a scratchpad
#    @main::com_ships::com_board = generate_board();
}

sub get_user_ship_pos::start {
    for my $k (keys %Pieces) {
        get_user_ship_pos::any_size($k, $Pieces{$k});
    }
    print_board(\@::main::user_ships::user_board);
}

sub game_play::start {
    game_play::decide();
    game_play::mode();
    play_game();
}

#*******************************************************************************
#********************* BOARD HELPER FUNCTIONS **********************************
#*******************************************************************************

sub gen_ship_list {
    my ($rC, $orient, $size) = @_;
    my ($x, $y) = @$rC;
    my $rShip;
    given ($orient) {
        when (0) { push @$rShip, [ $x, $y++ ] for 1 .. $size; }
        when (1) { push @$rShip, [ $x++, $y ] for 1 .. $size; }
    }
    return undef if $x>10 or $y>10;
    $rShip;
}

sub does_ship_fit {
    my ($rBoard, $rShip) = @_;
    my $collisions = 0;
    for my $P (@$rShip) {
        my ($x, $y) = @$P;
        ++$collisions if $$rBoard[$x][$y] ne '0';
    }
    return 0 if $collisions;
    1;
}

#*******************************************************************************
#*********************COMPUTER SHIP GENERATION FUNCTIONS************************
#*******************************************************************************

sub generate_ship_pos::any_ship {
    my ($size, $type) = @_;
    my $rShip;
    while (1) {
        # Randomly place a ship
        my $x = int(rand(10));
        my $y = int(rand(10));
        my $orient = int(rand(2));
        $rShip = gen_ship_list([$x,$y], $orient, $size);
        redo if ! defined $rShip;
        last if does_ship_fit(\@main::com_ships::com_board, $rShip);
    }
    for my $P (@$rShip) {
        my ($x, $y) = @$P;
        $main::com_ships::com_board[$x][$y] = uc(substr $type, 0, 1);
        push @main::com_ships::com_all_ships, "$x$y";
    }
}

#*******************************************************************************
#************************USER SHIP GENERATION FUNCTIONS*************************
#*******************************************************************************

sub place_ship {
    my ($x, $y, $size, $orient, $type) = @_;
    given (uc $orient) {
        when ('U') { $x-=$size-1; $orient=1 }
        when ('D') { $orient=1 }
        when ('L') { $y-=$size-1; $orient=0 }
        when ('R') { $orient=0 }
    }
    return 0 if $x<0 or $y<0;

    my $rShip = gen_ship_list([$x,$y], $orient, $size);
    if (! defined $rShip) {
        print "Ship can't go off the edge of the board!\n";
        return 0;
    }
    if (! does_ship_fit(\@main::user_ships::user_board, $rShip)) {
        print "Can't overlap ships!\n";
        return 0;
    }

    for my $P (@$rShip) {
        ($x, $y) = @$P;
        $main::user_ships::user_board[$x][$y] = substr($type,0,1);
        push @main::user_ships::user_all_ships, "$x$y";
    }
    1;
}

sub get_user_ship_pos::any_size {
    my ($name, $size) = @_;
    print_board(\@main::user_ships::user_board);
    while (1) {
        print "Position your $name: ('A5 r' starts at A5 and goes right):";
        chomp(my $input = <STDIN>);
        if ($input =~ m/([A-J]\d0?)\s*([UDLRXY])/i) {
            # Coordinates look good, try placing the ship
            my ($start, $dir) = ($1, $2);
            my $rC = parse_coordinate($1);
            redo unless defined $rC;
            last if place_ship($$rC[0], $$rC[1], $size, $dir, $name);
        }
        print "You have entered invalid input. Please try again.\n\n";
    }
}

#*******************************************************************************
#*******************************GAME-PLAY FUNCTIONS*****************************
#*******************************************************************************

sub handle_menu {
    my ($ar, $prompt) = @_;
    while (1) {
        print "\n", $prompt, "\n";
        for (my $i=0; $i<@$ar; ++$i) {
            print $i+1, ". ", $$ar[$i][0], "\n";
        }
        print "\n\nYour choice: ";
        chomp(my $decide = <STDIN>);
        if ($decide>0 and $decide <= @$ar) {
            return $decide if ! defined $$ar[$decide-1][1];
            return &{$$ar[$decide-1][1]}();
        }
        print "Inrecognized choice, please try again.\n";
    }
}

sub game_play::decide {
    return handle_menu(\@mnu_who_goes_first, "Who goes first?");
}

sub game_play::mode {
    return handle_menu(\@mnu_game_mode, "Please enter game mode: ");
}

sub play_game {
    while (!game_play::dead_yet()) {
        if ($turn eq "Computer") {
            computer_shots($shots_per_turn);
            $turn = "HUMAN";
        }
        else {
            print_both_boards();
            player_shots($shots_per_turn);
            $turn = "Computer";
        }
    }
}

sub generate_computer_shots {
    my $num_shots = shift;
    my %shots;
    while ($num_shots) { # < @{keys %shots}) {
        my ($x, $y) = (int(rand(10)), int(rand(10)));
        my $k = "$x$y";
        next if $main::user_ships::user_board[$x][$y] eq 'X'
             or $main::user_ships::user_board[$x][$y] eq 'O';
        next if exists $shots{$k};
        $shots{$k} = [ $x, $y ];
        --$num_shots;
    }
    return values %shots;
}

sub computer_shots { #game_play::reg_mode::com_shot {
    my $num_shots = shift;
    my @shots = generate_computer_shots($num_shots);
    print "COMPUTER: ";
    for my $rs (@shots) {
        my ($x, $y) = @$rs;
        my $s = coord_to_str($rs);
        if ($main::user_ships::user_board[$x][$y] =~ /[BCDPS]/) {
            print "$s:BOOM!  ";
            ++$main::user_ships::hits;
            $main::user_ships::user_board[$x][$y] = 'X';
        }
        elsif ($main::user_ships::user_board[$x][$y] eq 'X') {
            print "$s:Boom.  ";
        }
        else {
            print "$s: splash  ";
            $main::user_ships::user_board[$x][$y] = 'O';
        }
    }
    print "\n";
}

sub get_player_shots {
    my $num_shots = shift;
    while (1) {
        my @retval;
        my %shots;
        print "\nPlease enter your shot(s): ";
        chomp(my $input = <STDIN>);
        my @shot_list = ($input =~ m/([A-J]\d0?)/gi);

        for my $shot (@shot_list) {
            my $r = parse_coordinate($shot);
            my ($x, $y) = @$r;
            my $k = coord_to_str($r);
            if (exists $shots{$k}) {
                print "Duplicate entry: $shot\n";
                next;
            }
            elsif ($main::com_ships::com_board[$x][$y] eq 'X'
                     or $main::com_ships::com_board[$x][$y] eq 'O') {
                print "You've already shot location $shot\n";
                next;
            }
            else {
                push @retval, [ $x, $y ];
                $shots{$k} = [ $x, $y ];
            }
        }
        my @t = keys %shots;
        if (@t < $num_shots) {
            print "Not enough shots entered, please try again.\n";
            next;
        }
        else {
            return @retval[0 .. $num_shots-1];
        }
    }
}

sub player_shots {
    my $num_shots = shift;
    my @shots = get_player_shots($num_shots);
    print $main::startup::name, ": ";
    for my $rs (@shots) {
        my $s = coord_to_str($rs);
        my ($x, $y) = @$rs;
        if ($main::com_ships::com_board[$x][$y] =~ /[BCDPS]/) {
            print "$s:BOOM!   ";
            ++$main::com_ships::hits;
            $main::com_ships::com_board[$x][$y] = 'X';
        }
        elsif ($main::com_ships::com_board[$x][$y] eq 'X') {
            print "$s:Boom.   ";
        }
        else {
            print "$s:splash   ";
            $main::com_ships::com_board[$x][$y] = 'O';
        }
    }
    print "\n";
}

=h1

sub xplayer_shots {
    my $num_shots = shift;
    INPUT: while (1) {
        my %shots;
        if ($num_shots == 1) {
            print "\nPlease enter your shot: ";
        }
        else {
            print "\nPlease enter your salvo: ";
        }
        chomp(my $input = <STDIN>);
        for my $shot (split '', $input) {
            my $r = parse_coordinate($shot);
            next INPUT unless defined $r;
            my ($x, $y) = @$r;
            my $k = "$x.$y";
            if (exists $shots{$k}) {
                print "You've already entered $k!\n";
                next INPUT;
            }

            if (grep { $k eq $_ } @main::game_play::user_shots_check) {
                print "You have entered invalid input. Please try again.\n";
                next INPUT;
            }

            if ($main::com_ships::com_board[$x][$y] eq 'X') {
            }
            elsif ($main::com_ships::com_board[$x][$y] eq 'X') {
            }
            else {
            }
        }

    }
}

=cut

=h1

sub xgame_play::salvo_mode::user_salvo {
    my $input = '';
    print "\nPlease enter your three salvo shots: ";
    chomp($input = <STDIN>);
    my @user_shots = split(" ", $input);

    if ($input !~ /^[A-J]\d0?\s[A-J]\d0?\s[A-J]\d0?$/i) {
        print "You've entered invalid input. Please try again.\n";
        game_play::salvo_mode::user_salvo();
        return 0;
    }

    if ($user_shots[0] eq ($user_shots[1] or $user_shots[2]) or $user_shots[1] eq $user_shots[2]) {
        print "You have entered a co-ordinate twice. Please try again.\n";
        game_play::salvo_mode::user_salvo();
        return 0;
    }

    foreach my $el (@user_shots) {
        my $rC = parse_coordinate($el);
        die "how did I get here?" if ! defined $rC;
        $el = "$$rC[0]$$rC[1]";
        foreach my $lee (@main::game_play::user_shots_check) {
            if ($el eq $lee) {
                print "You have entered invalid input. Please try again.\n";
                game_play::salvo_mode::user_salvo();
                return;
            }
        }
        foreach my $lee (@main::com_ships::com_all_ships) {

            if ($el eq $lee) {
                print "Computer ship hit!\n";
                $main::com_ships::com_board[$$rC[0]][$$rC[1]] = 'X';
                $main::com_ships::hits++;
                last;
            } elsif ($el ne $lee) {
                $main::com_ships::com_board[$$rC[0]][$$rC[1]] = 'O';
            }
        }
    }
    push @main::game_play::user_shots_check, @user_shots;
}

sub xgame_play::reg_mode::user_shot {
    my $input = '';
    print "\nPlease enter your target: ";
    chomp($input = <STDIN>);
    if ($input !~ /^[A-J]\d0?$/i) {
        print "You've entered invalid input. Please try again.\n";
        game_play::reg_mode::user_shot();
        return 0;
    }
    my $rC = parse_coordinate($input);
    die "eh?" unless defined $rC;
    my ($let, $num) = (@$rC);
    $input = "$let" . "$num";
    given ($num) {
        when ($num > 9) {
            print "Your input is invalid. Please try again.\n\n";
            $input = '';
            game_play::reg_mode::user_shot();
            return;
        }
    }
    foreach my $lee (@main::game_play::user_shots_check) {
        if ($input eq $lee) {
            print "You have entered invalid input. Please try again.\n";
            game_play::reg_mode::user_shot();
            return;
        }
    }
    foreach my $lee (@main::com_ships::com_all_ships) {
        if ($input eq $lee) {
            print "Computer ship hit!\n";
            $main::com_ships::com_board[$let][$num] = 'X';
            $main::com_ships::hits++;
            last;
        } elsif ($input ne $lee) {
            $main::com_ships::com_board[$let][$num] = 'O';
        }
    }
    push @main::game_play::user_shots_check, $input;
}

=cut

sub game_play::dead_yet {
 if ($main::com_ships::hits eq '17') {
   print "Congratulations! You won, $main::startup::name!\n\n";
   exit;
 }
 if ($main::user_ships::hits eq '17') {
   print "Computer won. Better luck next time!\n";
   print "Computer used:\n";
   print_board(\@main::com_ships::com_board);
   exit;
 }
}

sub get_board_rows {
    my $ar = shift;
    my @retval;
    for (my $i=0; $i<@$ar; ++$i) {
        push @retval, join(" ", map { $_ eq '0' ? '-' : $_ } @{$$ar[$i]});
    }
    return @retval;
}

sub print_both_boards {
    if ($fl_print_boards eq 'H') {
        print_both_boards_H();
    }
    else {
        print_both_boards_V();
    }
}

sub print_both_boards_H {
    my @U = get_board_rows(\@main::user_ships::user_board);
    my @C = get_board_rows(\@main::com_ships::com_board);
    printf <<EOHDR, center_text($main::startup::name,20), center_text('Computer',20);
   %-20.20s    %-20.20s
   1 2 3 4 5 6 7 8 9 10    1 2 3 4 5 6 7 8 9 10
   --------------------    --------------------
EOHDR
    for (my $i=0; $i<@U; ++$i) {
        print "$main::letters::letters[$i]| ";
        print $U[$i];
        print " |$main::letters::letters[$i]| ";
        print $C[$i];
        print " |$main::letters::letters[$i]\n";
    }
}

sub print_both_boards_V {
   print center_text($main::startup::name,20);
   print_board(\@main::user_ships::user_board);
   print center_text("COMPUTER BOARD:", 20);;
   print_board(\@main::com_ships::com_board);
}

sub print_board {
    my $ar = shift;
    my @rows = get_board_rows($ar);
    print "\n   1 2 3 4 5 6 7 8 9 10\n";
    print "   --------------------\n";
    for (my $i=0; $i<@$ar; ++$i) {
        print "$main::letters::letters[$i]| ";
        print $rows[$i], "\n";
   }
}

sub coord_to_str {
    my $r = shift;
    return substr("ABCDEFGHIJ",$$r[0],1) . sprintf("%u",1+$$r[1]);
}

sub generate_board {
    my @t;
    push @t, [ (0) x 10 ] for 0..9;
    return @t;
}

sub parse_coordinate {
    # converts /[A-J]([1-9]|10)/i to [ [0..9], [0..9] ]
    my $coord = uc shift;
    return [ ord($1)-ord('A'), $2-1 ] if $coord =~ /^([A-J])([1-9]|10)$/;
    print "Invalid coordinate $coord!\n";
    return undef;
}

sub center_text {
    my ($text, $len) = @_;
    return substr($text, 0, $len) if length($text) >= $len;
    $text = ' ' x ( ($len-length($text))/2 ) . $text;
    return $text .= ' ' x ($len - length($text));
}