#!/usr/bin/perl
use strict;
use 5.010;
use warnings;

do "fun_sub.pl";
die $@ if $@;

# ****************** Initialisierung ***************
# das Spielfeld
my $aa=[
  [qw /28 22 15  6 33  1/],
  [qw / 7 10 32 27 11 14/],
  [qw /23 18  5 31  9 30/],
  [qw / 4 36 29 20 16 24/],
  [qw /13 25 17  3 35 19/],
  [qw /34  2 26 12 21  8/],
];

# Feldwertigkeit, Prioritaet absteigend
my $best = [qw /5 31 20 29 32 27 9 16 3 17 36 18
               10 11 35 25 15 6 30 24 12 26 4 23
               22 33 14 19 21 2 13 7 28 1 8 34/];

# die Karten
my @karten=((1..12)x4,13..19);

# feldhash erzeugen
my %felder;
for (1..36) {
  $felder{$_} = $_;
}

#Karten mischen
for(@karten)
{
  my $p=int(rand(scalar @karten));
  my $k=$_;
  $_=$karten[$p];
  $karten[$p]=$k;
}

# Kartenpositionen anlegen
my $position=&pos;

# Karten geben
my @chand=splice(@karten,0,4); # Karten Computer
my @shand=splice(@karten,0,4); # Karten Spieler

# Stand der Gewinnlinien erzeugen
our $linien=&aoa($aa,\%felder);

# **************** Ende Initialisierung *************

#&testfelder(\%felder); # aus "fun_sub.pl"

# ******* Hier beginnt die Spielschleife ********
my $runden=20;
my $sieg='';
while ($runden > 0 && !$sieg) {

  &computer; # computer spielt

  $linien=&aoa($aa,\%felder);
  # Sieglinie suchen
  my $sp='C'; my $za=4;
  my $li=&sieger($linien,$sp,$za,$best);

  if (@$li) {
    $sieg = 'S';
    print "Sieg COMPUTER\n" if @$li;
  }

  unless ($sieg) {
    &spieler; # spieler spielt

    # Stand der Gewinnlinien erzeugen
    $linien=&aoa($aa,\%felder);
    # Sieglinie suchen
    $sp='M'; # $za=4;
    $li=&sieger($linien,$sp,$za,$best);

    if (@$li) {
      $sieg = 'S';
      print "Sieg SPIELER\n" if @$li;
    }
  }

  $runden--;
  print "*** Noch $runden Runden ***\n\n"
}

&spielfeld($aa,\%felder);print "\n";

# *********** Hier endet das Spiel **************

sub computer { # computer spielt

  my (@prio,$fr,$li,$sp,$za,$su); # @prio erhaelt Prioritaeten des Setzens

  # freie 3C-Felder (Sieg möglich!) auflisten
  $sp=qr/C/; $za=3; 
  $li=&felder($linien,$sp,$za);
  $su = qr/\d+$/;
  $fr=&listen($su,$li,$best);
  #print "Frei 3-C: @$fr\n";
  push @prio, @$fr;

  # alle 3M-Felder (Sieg Gegner möglich!) auflisten
  $sp=qr/M/; $za=3;
  $li=&felder($linien,$sp,$za);
  push @prio, @$li;

  # freie 2C-Felder auflisten
  $sp=qr/C/; $za=2;
  $li=&felder($linien,$sp,$za);
  #$su = qr/\d+$/;
  $fr=&listen($su,$li,$best);
  #print "Frei 2-C: @$fr\n";
  push @prio, @$fr;

  # freie 1C-Felder auflisten
  $za=1; # $sp=qr/C/; 
  $li=&felder($linien,$sp,$za);
  #$su = qr/\d+$/;
  $fr=&listen($su,$li,$best);
  #print "Frei 1-C: @$fr\n";
  push @prio, @$fr;

  # mit C belegte 3C-Felder auflisten
  $za=3; # $sp=qr/C/; 
  $li=&felder($linien,$sp,$za);
  $su = qr/C/;
  $fr=&listen($su,$li,$best);
  #print "Belegt 3-C: @$fr\n";
  push @prio, @$fr;

  # mit C belegte 2C-Felder auflisten
  $za=2; # $sp=qr/C/; 
  $li=&felder($linien,$sp,$za);
  # $su = qr/C/;
  $fr=&listen($su,$li,$best);
  #print "Belegt 2-C: @$fr\n";
  push @prio, @$fr;

  # +++ Prioliste aufbereiten +++

  # Markierungen entfernen (M,C,G)
  for (@prio) {s/[C,G,M]+//}

  # @best an @prio anhaengen,
  # um alle 36 Felder zu erfassen
  push @prio, @$best;

  # Doubletten entfernen
  @prio=@{&double(@prio)};

  # jetzt setzen
  my $compchance=&chancen($position,\@chand,\%felder);
  print "Computer spielt mit @chand\n";
  #print "Computer hat @$compchance\n";
  #print "Best ist          @$best\n";
  #print "Computer hat Prio @prio\n";

  # setzfeld holen
  my $um;
  @prio=reverse @prio;
  for (@prio) {
    for my $u (@$compchance) {
        $um=$_ if ($_==$u)
    }
  }

  print "COMPUTER setzt auf $felder{$um}\n"; 
  
  # jetzt setzen im Hash
  &setzenall($um,\%felder,'C');

  # Karten ablegen und aufnehmen
  &newcard($position,\@chand,$um,\@karten);

} # end sub computer

sub spieler { # spieler spielt

  &spielfeld($aa,\%felder);
  print "\n";

  my $spchance=&chancen($position,\@shand,\%felder);

  # setzfeld holen
  my $erg=&setz($spchance,\@shand);

  print "SPIELER setzt auf $erg\n"; 

  # jetzt setzen im Hash
  &setzenall($erg,\%felder,'M');

  print "\n";
  #print "Spieler hatte Karten @shand ...\n";

  # Karten ablegen und aufnehmen
  &newcard($position,\@shand,$erg,\@karten);

} # end sub spieler

#!/usr/bin/perl
use strict;
use 5.010;
use warnings;


sub testfelder { # erwartet Hashreferenz so:
                 # &testfelder(\%felder);

  my $fe=shift;
  #$fe->{1} = "1";
  #$fe->{2} = "2C";
  #$fe->{3} = "3M";
  #$fe->{4} = "4";
  #$fe->{5} = "5M";
  #$fe->{6} = "6M";
  #$fe->{7} = "7M";
  #$fe->{8} = "8";
  #$fe->{9} = "9";
  #$fe->{10} = "10M";
  #$fe->{11} = "11";
  #$fe->{12} = "12C";
  #$fe->{13} = "13M";
  #$fe->{14} = "14";
  #$fe->{15} = "15";
  #$fe->{16} = "16M";
  #$fe->{17} = "17";
  #$fe->{18} = "18";
  #$fe->{19} = "19";
  #$fe->{20} = "20M";
  #$fe->{21} = "21MG";
  #$fe->{22} = "22";
  #$fe->{23} = "23M";
  #$fe->{24} = "24M";
  #$fe->{25} = "25";
  #$fe->{26} = "26C";
  #$fe->{27} = "27M";
  #$fe->{28} = "28M";
  #$fe->{29} = "29M";
  #$fe->{30} = "30C";
  #$fe->{31} = "31M";
  #$fe->{32} = "32";
  #$fe->{33} = "33M";
  #$fe->{34} = "34MG";
  #$fe->{35} = "35";
  #$fe->{36} = "36";

}

sub felder {
  # erstellt ein @ aller gesuchten Gew.linien
  my @felder; # alle Felder in eine Liste
  my $gel=shift;
  my $sp=shift; # M oder C
  my $za=shift; # Anzahl Vorkommen M/C
  for my $l (@$gel) { # jede Linie
    my @mg=grep (/MG/, @{$l}); # MG raus
    my @bu=grep (/$sp/, @{$l});
    push @felder, @{$l} if (@bu==$za && !@mg)
  }
  return \@felder
}

sub sieger {
  # erstellt ein @ aller gesuchten Gew.linien
  my @felder; # alle Felder in eine Liste
  my $gel=shift;
  my $sp=shift; # M oder C
  my $za=shift; # Anzahl Vorkommen M/C
  for my $l (@$gel) { # jede Linie
    my @bu=grep (/$sp/, @{$l});
    push @felder, @{$l} if @bu==$za
  }
  return \@felder
}

sub listen { # erwartet Suchstring und Ref. Array 
  # erstellt ein @ der gesuchten Felder aus den
  # in sub felder gefundenen Gew.linien

  my $su=shift; # Suchstring
  my $pr=shift; # \@prio
  my $be=shift; # \@best

  my @fr=grep(/$su/, @$pr);

  my $erg =code(\@fr);
  my (@ar, $i, $k);
  $k=1;

  do {
    my @et;
    while ( (my ($s, $w)) = each %$erg ) {
        if ($w eq $k) {
          push @et, $s;
          delete($$erg{$s})
        }
    }
    @et=@{&folge(\@et, $be)} if (@et > 1);
    unshift @ar, @et;
    $k++; $i+=$k;
  }
  while ($i < @$pr);
  return \@ar
}

sub folge {
  my $er=shift; # das Teilarray eines Vorkommens
  my $be=shift; # @best
  my %items_hash;
  for my $key (@$er)
  {
    ( my $copy = $key ) =~ tr/0-9//cd;
    $items_hash{$copy}=$key;
  }
  my @folge;
  my $elm;
  for ( @$be )
  {
    $elm=delete($items_hash{$_});
    push(@folge,$elm) if(defined($elm));
  }
  return \@folge
}

sub code {
  my $woerter = shift;
  my %zaehler;

  foreach ( @$woerter ) {
  $zaehler{$_}++;
  }
  
  return \%zaehler
}

sub setz {
  my $ch=shift; # die Chancen
  my $ka=shift; # die karten
  my $s=&einlesen($ch,$ka);
  print "Sie setzen $s bei Karten @$ka\n";
  print "Bestätigen mit J sonst eine Taste\n";
  my $e='';
  while ($e eq '') {
    $e=<STDIN>;
    chomp($e)
  }
  return $s if $e eq 'J';
  &setz($ch,$ka);

  sub einlesen {
    my $ac=shift;
    my $kaa=shift; # die karten
    #print "Bitte eine der Zahlen @$ac eingeben\n";
    print "Bitte eine Zahl aus @$kaa eingeben\n";
    my $za='';
    while ($za eq '') {
      $za=<STDIN>;
      chomp($za)
    }

    my $gt='';
    for my $e (@$ac) {
      $gt=$e if $e eq $za
    }
    print "Eingabe ungültig!\n" unless $gt;
    return $gt if $gt;
      
    &einlesen($ac,$kaa)
    
  }
}
sub newcard {
  my $position=shift;
  my $hand=shift;
  my $um=shift;
  my $karte=shift;
  my $reihe=&reihe($position,$hand,$um);
  #print "System hat mit @$hand die @$reihe verwendet.\n";

  #print "Ersetzt werden ";
  for (@$reihe) {
    #print "$$hand[$_]->";
    push @$karte,$$hand[$_]; # unter den Stapel
    my $ka=shift @$karte;    # neue karte
    splice(@$hand,$_,1,$ka)
  }
}

sub reihe { 
  my $position=shift;
  my $hand=shift;
  my $ka=shift;
  my @bits;
  for my $sa (@$position) {
    my $sum=0;
    for (@$sa) {
      $sum += $hand->[$_]
    }
    @bits=@$sa if $sum eq $ka
  }
  return \@bits
}

sub setzenall { # erwartet ... 
  my $za=shift; # gesetzte Zahl,
  my $hs=shift; # Ref. Feldhash,
  my $ke=shift; # Kennung Spieler (C oder M)

  my ($c, $m) = ('C', 'M'); # wenn Kennung C
  ($c, $m) = ('M', 'C') if $ke=~/M/;

  while ( (my $s, my $w) = each %$hs) {
    if ($s==$za) {
      if ($$hs{$za}   =~/$c/) {$$hs{$za}=$s.$c.'G'}
      elsif ($$hs{$za}=~/$m/) {$$hs{$za}=$s}
      else { $$hs{$za}=$s.$c}
    }
  }
}

sub spielfeld { # erwartet Spielfeldmatrix (\@aa)
                # und Belegung der Felder(\%felder);

  my $ma=shift; # die Feldmatrix
  my $fe=shift; # die Felder im Hash
  for (0..$#$ma) {
    # sechs reihen
    print "+-------+-------+-------+-------+-------+-------+\n";
    print "| \t| \t| \t| \t| \t| \t|\n";

    for my $k (0..$#{$$ma[$_]}) {
      print "|  $$fe{$$ma[$_][$k]}\t";
    }
    print "|\n";
    print "| \t| \t| \t| \t| \t| \t|\n";
  }
  print "+-------+-------+-------+-------+-------+-------+\n";
}

sub aoa { # gewinnlinien spielstand erzeugen
  my $ma=shift;
  my $fe=shift;
  my (@aoa,$lines);
  $lines=stepp_trou($ma,$fe,0,1);
  push @aoa,@$lines;
  $lines=stepp_trou($ma,$fe,1,0);
  push @aoa,@$lines;
  $lines=stepp_trou($ma,$fe,1,1);
  push @aoa,@$lines;
  return \@aoa; # 

  sub stepp_trou {
    my $matrix=shift; 
    my $feld=shift;
    my $sx=shift;
    my $sy=shift;
    my @linien;
    for my $s (0..2)
    {
      for my $t (0..2)
      {
        my $m=$t;
        my $k=$s;
        ($k,$m)=($t,$s) if($sx);
        my @tm;
        for (0..3)
        {
          my $li = $matrix->[$k]->[$m];
          push @tm, $$feld{$li};
          $k+=$sy;
          $m+=$sx;
        }
        push @linien, [@tm];
        # print "@tm\n";
      }
      for my $t (3..5)
      {
        my $m=$t;
        my $k=$s;
        ($k,$m)=($t,$s) if($sx);
        my @tm;
        for (0..3)
        {
          my $li = $matrix->[$k]->[$m];
          push @tm, $$feld{$li};
          if($sx && $sy) { 
            $k-=$sy;
          } else { 
            $k+=$sy 
          }
          $m+=$sx;
        }
        push @linien, [@tm];
        # print "@tm\n";
      }
    }
    return \@linien;
  } # end sub stepp_trou
} # end sub aoa

sub pos {
  my @ch; # speichern der Kombinationen
  for my $p (0..3) {
    push(@ch,[$p]);
    for my $elm (@ch)
    {
      my @l=@$elm;
      unless(grep{$p==$_}@l)
      {
        push(@l,$p);
        @l=sort(@l);
        push (@ch, \@l);
      }
    }
  }
  return \@ch
}

sub chancen { 
  # erwartet Refs. des Position-Hashes,
  # der vier Handkarten und der Felder
  my $position=shift;
  my $hand=shift;
  my $fe=shift;
  my (@chancen,$ce);
  for my $sa (@$position) {
    my $sum=0;
    for (@$sa) {
      $sum += $hand->[$_]
    }

    if (($sum>=1) && ($sum<=36)) {
      # gesperrte Felder raus aus Chancen
      push @chancen, $sum unless $fe->{$sum}=~/G/; 
    }
  }
  # Sortieren und doppelte Einträge entfernen
  my @result = sort{$a <=> $b} @chancen;
  @chancen   = @{&double(@result)};
  
  return \@chancen
}

sub double {
  my %hash;
  my @ca=grep {!$hash{$_}++;} @_;
  return \@ca
}