#! perl
use POSIX;
use Data::Dumper;
use List::Util qw/max min sum/;
use Jeweler;
use strict;

my $DEBUG = 1;
my $CFG;

# this is a simple quad polynom, it takes it's factors from
# the configuration
sub fx {
   my ($x, $setting) = @_;
   my $facts = getcfg (functions => $setting);
   return $facts->[0] * ($x ** 2) + $facts->[1] * $x + $facts->[2];
}

# makes a template arch (for example to get the value)
sub get_arch {
   my ($outarch) = @_;
   unless ($CFG->{arch}->{$outarch}) {
      $CFG->{arch}->{$outarch} = cf::object::new $outarch;

      unless ($CFG->{arch}->{$outarch}) {
         warn "ERROR: Couldn't make $outarch in conversion for $outarch!";
         return;
      }
   }
   $CFG->{arch}->{$outarch}
}

sub calc_costs {
   my ($ring) = @_;

   my $costs = {};

   for my $resnam (keys %{$ring->{resist} || {}}) {

      my $res = $ring->{resist}->{$resnam};

      next unless $res > 0;

      $costs->{"food_$resnam"} += $res;
      $costs->{"resist_" . $Jeweler::RESMAP{$resnam} . "_potion"}++;

      my $diamonds;
      if (grep { $resnam eq $_ } @Jeweler::EFFECT_RESISTS) {
         $diamonds += fx ($res, 'effect_resist_diamonds');
      } else {
         $diamonds += fx ($res, 'attack_resist_diamonds');
      }
      $costs->{diamonds} += $diamonds;
   }

   $costs = calc_stat_costs ($ring->{stat}, $costs);
   $costs = calc_special_costs ($ring->{spec}, $costs);

   warn
     sprintf "JEWEL ANALYSE: %40s: %s" ,
        $ring->{name},
        join (', ', map { "$_: " . sprintf "%.2f", $costs->{$_} } keys %$costs);
   return $costs;
}

sub read_config {
   my ($filename) = @_;

#   open my $fh, $filename
#     or die "Couldn't open '$filename': $!";

   my $cfg = {}; #LoadFile $filename;

#   my $section = 'main';
#
#  my $cont = join '', <$fh>;
#
#  for (<$fh>) {
#     s/#.*$//;
#
#     if (m/^\[([^\]]+)\]/) {
#        $section = $1;
#
#     } elsif (m/^\s*(\S+)\s*=\s*(.*?)\s*$/) {
#        my ($k, $v) = ($1, $2);
#
#        my @v = split /\s*,\s*/, $v;
#
#        if (@v > 1) {
#           $v = [ @v ];
#        }
#
#        $cfg->{$section}->{$k} = $v;
#     }
#  }

   return $cfg;
}

sub getcfg {
   my ($sect, $key) = @_;
   my $cfg = $CFG->{$sect}->{$key}
      or die "Couldn't find $sect/$key in configuration!";

   $cfg
}

sub ring_or_ammy_to_hash {
   my ($thing) = @_;

   my $obj = {};

   for (@Jeweler::RESISTS) {
      $obj->{resist}->{$_} = $thing->get_resistance ($_);
   }

   my $stats = $thing->stats;

   for (qw/Str Dex Con Wis Cha Int Pow/) {
      $obj->{stat}->{$_} = $stats->$_;
   }

   $obj->{spec}->{regen} = $thing->hp;
   $obj->{spec}->{magic} = $thing->sp;
   $obj->{spec}->{wc}    = $thing->wc;
   $obj->{spec}->{dam}   = $thing->dam;
   $obj->{spec}->{ac}    = $thing->ac;
   $obj->{spec}->{speed} = $thing->stats->exp;
   $obj->{spec}->{suste} = $thing->food;

   $obj->{name} = $thing->name;

   $obj
}

sub split_diamonds {
   my ($cost, $diamonds, $category) = @_;

   my $stat_split = getcfg (diamond_split => $category);

   my $emarch = get_arch ('emerald');
   my $saarch = get_arch ('sapphire');
   my $pearch = get_arch ('pearl');
   my $ruarch = get_arch ('ruby');
   my $diarch = get_arch ('gem');

   my $sumvalue = $diarch->value * $diamonds;

   $cost->{emeralds}  += ceil (($sumvalue * $stat_split->[0]) / $emarch->{value});
   $cost->{sapphires} += ceil (($sumvalue * $stat_split->[1]) / $saarch->{value});
   $cost->{pearls}    += ceil (($sumvalue * $stat_split->[2]) / $pearch->{value});
   $cost->{rubies}    += ceil (($sumvalue * $stat_split->[3]) / $ruarch->{value});
   $cost->{diamonds}  += ceil (($sumvalue * $stat_split->[4]) / $diarch->{value});

   return $cost;
}

sub calc_stat_level {
   my ($stats) = @_;

   my $maxlevel = getcfg (maxlevels => 'stat_level');
   my $maxstat  = getcfg (maximprovements => 'stats');

   my $stat_cnt = scalar (grep { $_ > 0 } values %$stats);
   my $stat_sum = sum (values %$stats);
   my $level    = int (($maxlevel / $maxstat) * $stat_sum);

   ($level, $stat_cnt)
}

sub calc_resist_level {
   my ($resists) = @_;

   my $att_res_lvl = getcfg (maxlevels => 'resist_level');
   my $efc_res_lvl = getcfg (maxlevels => 'effect_resist_level');
   my $max_att_res = getcfg (maximprovements => 'attack_resistances');
   my $max_efc_res = getcfg (maximprovements => 'effect_resistances');
   my $max_ovr_res = getcfg (maximprovements => 'resistances');

   my $ressum = 0;
   my $rescnt = 0;
   my @reslevels;

   for my $resnam (keys %$resists) {
      my $res = $resists->{$resnam};

      $rescnt++
         if $res > 0;     # negative resistancies are not an improvement

      $ressum += $res;    # note: negative resistancies lower the sum

      next unless $res > 0;

      my $level = 0;
      if (grep { $resnam eq $_ } @Jeweler::EFFECT_RESISTS) {
         $level = ceil (($efc_res_lvl / $max_efc_res) * $res);
      } else {
         $level = ceil (($att_res_lvl / $max_att_res) * $res);
      }
      push @reslevels, $level;
   }

   my $overall_lvl = ($att_res_lvl / $max_ovr_res) * $ressum;

   (max (@reslevels, $overall_lvl), $rescnt);
}

sub calc_special_level {
   my ($specials) = @_;

   my $max_spc_lvl  = getcfg (maxlevels => 'spec_level');
   my $max_specials = getcfg (maximprovements => 'specials');

   my @speclvls;
   my $specsum = 0;
   my $imprs = 0;

   for my $spcnam (keys %$specials) {
      my $spc = $specials->{$spcnam};
      next unless $spc > 0;

      $specsum += $spc;
      $imprs++;

      my $max_spc = getcfg (maxspecial => $spcnam);

      my $lvl = ($max_spc_lvl / $max_spc) * $spc;
      push @speclvls, $lvl;
   }

   my $sumlvl = ($max_spc_lvl / $max_specials) * $specsum;

   (max (@speclvls, $sumlvl), $imprs)
}

sub calc_stat_costs {
   my ($stats, $cost) = @_;

   my $sum = sum grep { $_ > 0 } values %$stats;

   return $cost unless $sum > 0;

   $cost->{stat_potions} += fx ($sum, 'stat_potions');
   $cost->{diamonds}     += fx ($sum, 'stat_diamonds');

   $cost
}

sub calc_special_costs {
   my ($specials, $cost) = @_;

   my $sum = sum grep { $_ > 0 } values %$specials;

   return $cost unless $sum > 0;

   $cost->{spec_potions} += fx ($sum, 'spec_potions');
   $cost->{diamonds}     += fx ($sum, 'spec_diamonds');

   $cost
}

# this function calculated the 'level' of an amulet or a ring
sub power_to_level {
   my ($ring) = @_;

   my $max_imprs    = getcfg (maximprovements => 'improvements');
   my $max_impr_lvl = getcfg (maxlevels       => 'improve_level');

   my ($stat_lvl,   $stat_imprs) = calc_stat_level ($ring->{stat} || {});
   my ($resist_lvl, $res_imprs)  = calc_resist_level ($ring->{resist} || {});
   my ($spec_lvl,   $spec_imprs) = calc_special_level ($ring->{spec} || {});

   my $impr_lvl = ceil (($max_impr_lvl / ($max_imprs + 1)) * ($stat_imprs + $res_imprs + $spec_imprs - 1));

   my $levl = int max ($stat_lvl, $resist_lvl, $impr_lvl, $spec_lvl, 0);

   my $cost = calc_costs ($ring);
   warn sprintf "%3d: %50s: %s\n", $levl, $ring->{name}, "stat: $stat_lvl, resist: $resist_lvl, improve: $impr_lvl, spec: $spec_lvl (num impr $stat_imprs + $res_imprs + $spec_imprs - 1)";
#  warn sprintf "   %s\n", join (',', map { sprintf "$_: %5d", $cost->{$_} } keys %$cost);

   $levl
}

# this function converts metals/minerals into a raw ring (of adornment)
sub simple_converter {
   my ($pl, $ingred, $chdl, $conv) = @_;

   $conv = lc $conv;
   my $cnvs = $CFG->{conversions};

   return unless $cnvs->{$conv};

   my %ingred_groups;

   my @conv_cfg = @{$cnvs->{$conv}};
   my $outarch = $conv;
   my ($ingr_grp, $outarchvalfact, $srcarchname, $xp_gain) = @conv_cfg;

   unless (@conv_cfg <= 4) {
      warn "ERROR: Conversion for '$outarch' has only " . (@conv_cfg) . " arguments!";
      return;
   }

   unless ($xp_gain > 0) {
      warn "WARNING: xp gain isn't > 0 in convesion '$outarch'\n";
      return;
   }

   unless ($outarchvalfact) {
      warn "ERROR: source-arch-value-multiplier == 0 in convesion '$outarch'\n";
      return;
   }

   unless ($outarchvalfact >= 1) {
      warn "WARNING: source-arch-value-multiplier < 1 in convesion '$outarch', results in more valuable output!\n";
   }

   my $archvalsum = $ingred->value ($cnvs->{$outarch}->[0], $cnvs->{$outarch}->[2]);
   $ingred->remove ($cnvs->{$outarch}->[0], $cnvs->{$outarch}->[2]);

   my $outarchval = get_arch ($outarch)->value;

   my $nrof = int ($archvalsum / (($outarchval || 1000) * $outarchvalfact));
   if ($nrof) {
      # XXX: yes, i know what i'm doing here, i don't set nrof, but it didn't work somehow (pls. chek sometimes)
      $chdl->put (cf::object::new $outarch) for 1..$nrof;

      my $xp_sum = ($xp_gain * $nrof);

      if ($xp_sum) {
         $pl->ob->message ("You got $xp_sum xp by making $nrof ${outarch}s");
         $pl->ob->change_exp ($xp_sum, "jeweler", cf::SK_EXP_ADD_SKILL);
      }
   }
}



sub put_ingred_to_bench {
   my ($ingred, $bench) = @_;

   for my $ik (keys %$ingred) {
      for (@{$ingred->{$ik} || []}) {
         $_->insert_ob_in_ob ($bench);
      }
   }
}

my %lvl_diff_chances = (
   +5 => 100,
   +4 => 95,
   +3 => 85,
   +2 => 75,
   +1 => 65,
   0  => 50,
   -1 => 45,
   -2 => 35,
   -3 => 25,
   -4 => 10,
   -5 => 0
);

my %lvl_diff_msg = (
   -5 => '%s is way above your skill',
   -4 => 'The chance to make %s is very low',
   -3 => 'You hava a slight chance to make %s',
   -2 => 'There is a low chance you finish %s',
   -1 => 'You could make %s with a chance of nearly 50:50',
   0  => 'The chances to fininsh %s is 50:50',
   1  => 'To make %s your chance is slightly above 50:50',
   2  => 'You could make with a good chance %s if you concentrate a lot',
   3  => 'The chance you finish %s with some efford is high',
   4  => 'You are nearly confident to finish %s',
   5  => 'There is no chance you could fail to make %s',
);

sub level_diff_to_str {
   my ($delta) = @_;
   $delta = -5 if $delta < -5;
   $delta =  5 if $delta >  5;
   return $lvl_diff_msg{$delta}
}

sub level_diff_to_chance_perc {
   my ($delta) = @_;
   $delta = -5 if $delta < -5;
   $delta =  5 if $delta >  5;
   return $lvl_diff_chances{$delta}
}

sub grep_for_match {
   my ($thing, @matchar) = @_;

   my $i = 0;
   for my $match (@matchar) {
      if ($match =~ m/^\s*$/) {
         $i++;
         next;
      }

      if ($i % 3 == 0) {
#    warn ":FE1:" .  $thing->name . ": $match\n";
         $thing->name eq $match
            and return 1;
      } elsif ($i % 3 == 1) {
#        warn ":FE2:" .  $thing->title . ": $match\n";
         $thing->title eq $match
            and return 1;
      } else { # $i % 3 == 2
#        warn ":FE3:" .  $thing->archetype->name . ": $match\n";
         $thing->archetype->name eq $match
            and return 1;
      }
      $i++;
   }
   return 0;
}

sub get_plan {
   my ($ingred) = @_;

   for my $pot (@{$ingred->{potions}}) {
      for my $plan (keys %{$CFG->{plans}}) {
         my $plg = $CFG->{plans}->{$plan};
         my @plga = ();
         unless (ref $plg eq 'ARRAY') {
            push @plga, $plg;
         } else {
            @plga = @$plg;
         }
         next unless @plga > 0;
         if (grep_for_match ($pot, @plga)) {
            warn "MATCHED: $plan: @plga\n";
            return $plan;
         }
      }
   }
}

sub get_ring {
   my ($ingred) = @_;
   return @{$ingred->{rings} || []};
}

sub get_improv_amount {
   my ($plan, $ingred) = @_;

   if ($plan =~ m/^stat_(\S+)$/) {
      my $plingred = getcfg (plan_ingred => $plan)
         or die "ingredients for plan '$plan' not defined!";

      my $cnt = 0;
      for my $pot (@{$ingred->{potions}}) {
         if (grep_for_match ($pot, @$plingred)) {
            $cnt += $pot->nrof;
         }
      }
      warn "Found $cnt potions for plan $plan\n";

      my $amount = 0;
      for my $x (1..10) {
         my $y = fx ($x, 'stat_potions');
         warn "TEST: fx($x): $y <= $cnt \n";
         warn "FE: " . ($y == $cnt) . "\n";
         if ($y <= $cnt) {
            $amount = $x;
            warn "Found stat increase at: $x\n";
            last;
         }
      }

      return $amount;
   } elsif ($plan =~ m/^spec_(\S+)$/) {
      return 0;
   } elsif ($plan =~ m/^resist_(\S+)$/) {
      return 0;
   }
}

sub get_plan_costs {
   my ($plan, $ring, $amount) = @_;

   my $pre_costs = calc_costs ($ring);

   # alter ring spec
   if ($plan =~ m/^stat_(\S+)$/) {
   } elsif ($plan =~ m/^spec_(\S+)$/) {
   } elsif ($plan =~ m/^resist_(\S+)$/) {
      my ($resid) = map { $Jeweler::RESMAP{$_} } grep { $Jeweler::RESMAP{$_} eq $1 } keys %Jeweler::RESMAP;
      unless (defined $resid) {
         die "Couldn't find resistancy for plan: '$plan'\n";
      }

      $ring->{resist}->{$resid} += $amount;
   }

   my $post_costs = calc_costs ($ring);

   my $delta_costs = {};
   for (keys %{$post_costs}) {
      my $cost = $post_costs->{$_} - $pre_costs->{$_};
      if ($cost > 0) {
         warn "DELTA COST: $_ => $cost\n";
         $delta_costs->{$_} = $cost;
      }
   }
   return $delta_costs
}

sub on_player_use_skill {
   return 0; # disabled not yet ready#d##TODO#
   my ($ob, $part, $sk, $dir, $msg) = @_;
   my $pl = $ob;

   my $skobj = $sk;

   my $chdl = new Jeweler::CauldronHandler;

   return 0 unless $sk->subtype == cf::SK_JEWELER;

   my $rv = 1;
   eval {
      $CFG = read_config ($ENV{CROSSFIRE_LIBDIR} . '/jeweler.yaml'); #XXX: This has to become cached properly!
      $DEBUG ||= $CFG->{main}->{debug};

      my $player = $ob->contr;#cf::player::find $ob->name;

      unless ($chdl->find_cauldron ('jeweler_bench', $ob->map->at ($ob->x, $ob->y))) {
         $rv = 0;
         return # return 0 if no cauldron found (default action: identify)
      }

      my $ingred = $chdl->extract_jeweler_ingredients;

      if ($msg =~ m/^\s*analy[sz]e\s*$/i) {
         for ($chdl->grep_by_type (cf::RING, cf::AMULET)) {
            my $sklvl = cf::exp_to_level ($sk->stats->exp);
            my $ringlvl = power_to_level (ring_or_ammy_to_hash ($_));

            if ($pl->get_flag (cf::FLAG_WIZ)) {
               $pl->message ("The " . $_->name . " is at level $ringlvl chance for you: " . level_diff_to_chance_perc ($sklvl - $ringlvl));
            } else {
               my $tmpl = level_diff_to_str ($sklvl - $ringlvl);
               my $msg = sprintf $tmpl, $_->name;
               $pl->message ($msg);
            }
         }

      } elsif ($msg =~ m/^\s*make\s+(\S+)\s*$/i) {
         unless ($CFG->{conversions}->{lc $1}) {
            $pl->message ("You don't know how to make '$1', is does such a thing even exist?");
            return
         }

         simple_converter ($player, $ingred, $chdl, $1);

#         for (@{$ingred->{rings}}) {
#           ring_or_ammy_to_hash ($_);
#        }
         #put_ingred_to_bench ($ingred, $c[0]);

      } else {
         my $plan = get_plan ($ingred);

         if ($plan) {
            my @ring = get_ring ($ingred);

            if (@ring > 1) {
               # actually the algorithm cant handle more than one improvement at a time
               $pl->message ("You can't manage to improve more than one ring!");

            } elsif (@ring < 1) {
               # actually the algorithm cant
               $pl->message ("You slap yourself, you forgot the ring!");

            } else {
               my $ringh = ring_or_ammy_to_hash ($ring[0]);
               my $amount = get_improv_amount ($plan, $ingred);
#               my $costs = get_plan_costs ($plan[0], $ringh, $amount);
#
#               if (my $chk = check_plan_costs ($costs, $ingred)) {
#                  # output some error that he lacks the ingredients
#               } else {
#                  execute_plan ($costs, $ringh, $ingred);
#               }
            }

         } else {
            $pl->message ("You've got no idea what you are planning to do!");
         }
      }
   };
   $@ and warn "ERROR: $@\n";

   my $r = cf::random_roll (0, 101, $pl, cf::PREFER_LOW);
   $rv;
}