#!/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
}