#!/usr/bin/perl -w

# mariposa-4 - speel 4 op een rij

# Copyright © 2011 Joost van Baal-Ilić
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License, as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.  There is NO warranty.  A copy of the GNU GPL is available from
# http://www.gnu.org/licenses/.

use strict;

# 7 kolommen, 6 rows

# - - - - - - -   (0,5) (1,5) (2,5)     (6,5)
# - - - - - x -
# - - - - - o -   
# x - - o - x -
# o - - x o x -   (0,1) (1,1) (2.1)     (6,1)
# o o o x x x x   (0,0) (1,0) (2,0)     (6,0)
# 0 1 3 4 5 6 7
# > x

# - undef
# x 1
# o 0


# forces a flush right away and after every write or print on the currently
# selected output channel.  Default is 0  See perlvar(1), perlopentut(1)
# $OUTPUT_AUTOFLUSH = 1;
$| = 1;

my $debug = defined $ENV{"MP4_DEBUG"} ? $ENV{"MP4_DEBUG"} : 0;

my @spel = ( [], [], [], [], [], [], [] );
my $aanzet = 0;

sub onbeslist {
  my $rij = 0;
  for my $r (0 .. 5) {
    for my $k (0 .. 5) {
      if (defined $spel[$k][$r] and defined $spel[$k+1][$r]) {
        if ($spel[$k][$r] == $spel[$k+1][$r]){
          $rij++
        } else {
          $rij = 0;
        }
      }
    }
    if ($rij >= 3) {
      print "4 op een rij! (horizontaal)\n";
      return 0;
    } else {
      $rij = 0;
    }
  }
  for my $k (0 .. 6) {
    for my $r (0 .. 4) {
      if (defined $spel[$k][$r] and defined $spel[$k][$r+1]) {
        if ($spel[$k][$r] == $spel[$k][$r+1]) {
          $rij++;
        } else {
          $rij = 0;
        }
      }
    } 
    if ($rij >= 3) {
      print "4 op een rij! (vertikaal)\n";
      return 0;
    } else {
      $rij = 0;
    }
  }

  for my $i (0 .. 5) {
    for my $j (0 .. 4) {
      $k = 0; # FIXME
      $r = 0; # FIXME
      if (defined $spel[$k][$r] and defined $spel[$k+1][$r+1]) {
        if ($spel[$k][$r] == $spel[$k+1][$r+1]) {
          $rij++;
        } else {
          $rij = 0;
        }
    } 
    if ($rij >= 3) {
      print "4 op een rij! (diagonaal)\n";
      return 0;
    } else {
      $rij = 0;
    }
  }

  for my $r (0 .. 2) {
    for my $k (0 .. 2) {
      # FIXME $spel[$k][$r] == $spel[$k+1][$r-1] and $rij++ or $rij = 0;
      ;
    }
  }  
  return 1;
}

sub openrijen {
  my @a;
  for my $k (0 .. 6) {
    $#{ $spel[$k] } < 5 and push @a, $k;
  }
  return @a;
}

sub doezet {
  print "zet > ";
  # print STDERR "err: zet > ";
  while (<>) {
    chomp;
    my $zet = $_;
    my $geldigezet = 0;
    if ($zet =~ /^\d$/) {
      my $r;
      my @openrijen = &openrijen;
      foreach $r (@openrijen) {
        if (!$geldigezet && $zet == $r) {
          &update($zet, $aanzet);
          $geldigezet = 1;
        }
      }
      if ($geldigezet){
        $aanzet = !$aanzet;
        last;
      } else {
        print "ongeldige zet.  rijen 7, 8 en 9 bestaan niet, en/of rij $zet is mogelijk al vol.  typ 0, 1, 2, ... , of 6\n";
        print "zet > ";
      }
    } else {
      print "typ 0, 1, 2, ... , of 6\n";
      print "zet > ";
    }
  }
}

sub update {
  my ($zet, $aanzet) = @_;
  push @{ $spel[$zet] }, $aanzet;
  return 1;
}

sub toon {
  $|=1;
  print "\n";
  for my $r (5, 4, 3, 2, 1, 0) {
    for my $k (0 .. 6) {
       if (defined $spel[$k][$r]) {
         $spel[$k][$r] and print "x " or print "o ";
       } else {
         print "- ";
       }
    }
    print "\n";
  }
  print "0 1 2 3 4 5 6\n";
}

sub prompt {
  my $z = "o";
  $aanzet and $z = "x";
  print "> $z\n";
  print "\n";
  return 1;
}

while (&onbeslist && &openrijen) {
  &doezet;
  &toon;
  &prompt;
  if (&onbeslist) {
    # print "doe nog een zet\n";
    ;
  } else {
    print "proficiat!\n";
    exit 0;
  }
}