#!/usr/athena/bin/perl 

sub numerically {$b <=> $a ;}
sub othernumerically {$a <=> $b ;}
$total=0;
$sides=10;
$statcount=1000;
@stats=(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
$helpmsg = 
"----------------------------------------------------------------------
Usage: 
 For all of the flags, feel free to combine flags or not, and to put a
   \"-\" before them or not.  That is, \"dice wa X Y\" is the same as
   \"dice -w X -a Y\".  Have fun. 

 dice X will roll X dice and give you the output.

 dice X Y will roll X dice and give you the output, noting
   the number of successes if you are rolling for Y.  
 
 dice X Y Z will roll X dice and give you the output, noting
   the number of successes if you are rolling for Y and have Z skill.  

 dice r X Y Z will tell you what successes you're rated to get with X
   dice, rolling for Y, using Z skill, based on rolling $statcount
   times.  Note that X, Y and Z are numbers you choose, and r is an
   actual \"r\".  The \"r\" flag will trump all other flags because
   it's too complicated to deal with otherwise.

 dice a X [Y] [Z] will mention awryage. 

 dice w X [Y] Z will roll X dice with Z skill as wild magic and tell
   you as many useful outcomes as it finds (i.e. combinations of
   success/target number).  If you specify Y, it'll tell you just the
   answer for a target number of Y.

 dice d X Y Z will include printing the modified rolls.  For debugging.

 dice l X Y Z will tell you leftover skill. 

 dice s ## X [Y] [Z] will roll ##-sided dice instead. 

 dice p X will treat the roll as X Oath speed dice, and ignore all
   other flags and numbers.
----------------------------------------------------------------------\n\n";

if ($#ARGV == -1) {
    die $helpmsg ;}

  # Arguments are either flags or numbers.  We no longer care what
  # order, or if they have dashes.

while ($#ARGV > -1 ) {
    $tmp = shift @ARGV;
    if ($tmp =~ m/^[0-9]+$/) {
	push @numbers, $tmp;
	next;
    }
    $tmp =~ s/-//;
    if ($tmp =~ s/p//) {
      $speed = 1;
    }
    if ($tmp =~ s/r//) {
	$rflag = 1;
    }
    if ($tmp =~ s/w//) {
	$wflag = 1;
    }
    if ($tmp =~ s/d//) {
	$dflag = 1;
    }
    if ($tmp =~ s/a//) {
      $aflag = 1 ;
    }
    if ($tmp =~ s/l//) {
      $lflag = 1;
    }
    if ($tmp =~ s/s//) {
      $sides = shift @ARGV;
      if ($sides !~ m/^[0-9]+$/) {
	die "Number of sides must be an integer";
      }
    }
    if ($tmp =~ m/.+/) {       # If there's still something that's not a 
	die $helpmsg ;}        #number or a known flag...
}

if ($#numbers == -1) {die $helpmsg;}

$x = $numbers[0];
if ($rflag == 1) {
    dostats(); 
    exit;
}

while ($x--) {                          
    $d= (1 + int (rand $sides));
    push @dice, $d;
}

if (!$speed) {
  @sorteddice = sort numerically @dice;}
else {
    @sorteddice = sort othernumerically @dice;
  }


print "Results are: @sorteddice \n";

if ($speed == 1) {
  &dospeed();
  exit;
}

if ($wflag == 1 ) {
#    print "Embarking into wild magic...\n";
    if ($numbers[2] != "") {
	$z = $numbers[2];
	$y = $numbers[1];
    }
    else {
	$z = $numbers[1];
    }
    if ($z eq "") {
	print "Assuming skill of zero, though that's foolish.\n";
	$z = 0;
    }
    dowild();
    exit;
}


  # If there isn't a second argument, then we're done.

$y = $numbers[1];
if ($y eq ""){
    doawry();
    exit;
}

foreach $i (@sorteddice) {
    if ($i >= $y) {
	++$total;
    }
}
print "Target: $y.  Natural successes: $total.\n";

$z = $numbers[2];
if ($z eq "") {
    doawry();
    exit;
}

  # if there isn't a third argument, we're done again.

mainroll($y,$z);

######################################################################

sub dostats {
    $x = $numbers[0]; 
    $y = $numbers[1]; 
    $z = $numbers[2]; 
	
    if ($y eq "") {
	print "Assuming target number is 7\n";
	$y = 7;
    }
	
    $max = 0;
    for $i (1 .. $statcount) {
	
	undef @dice;
	undef @sorteddice;
	$j = $x;
	$zz = $z;
	while ($j--) {                          
	    $d= (1 + int (rand $sides));
	    push @dice, $d;
	}
	@sorteddice = sort numerically @dice;
	$total = 0;
	foreach $k (@sorteddice) {
	    if ($k >= $y) {
#		print "$total!\n";
		++$total;
	    }
	    elsif ($y - $k <= $zz and $k != 1) {
		$diff = $y - $k;
#		print "$total!\n";
		++$total;
		$zz = $zz - $diff;
	    }
	}
#	print "successes: $total\n";
	$addall = $addall + $total;
	push @rolled, $total;
	++$stats[$total];
#	print "total was $total\n";
	if ($total > $max) {
	    $max = $total; 
#	    print "upping max to $max\n";
	}
    }
#    print @stats;
    &printrate();

    $total = 0;
    print "
Successes      Exactly          At least
---------      -------          --------\n";
    for ($i = $max; $i > 0; --$i) {
	$total = $total + $stats[$i];
	printf " %4.0d            %2.0f%%       |      %2.0f%%\n", $i, $stats[$i]/$statcount *100, $total/$statcount*100;
    }
}


sub dowild {
    @storage = @sorteddice;
    $max = $sorteddice[0] + $z;
#    print "$max is max\n";
    foreach $i (@sorteddice) {
	if ($i == 1) {
	    ++$burnout;
	}
    }
    if ($burnout > 0) {
	print "Burnout: $burnout dice\n\n";
    }

    for ($diff=$max; $diff>6; --$diff) {
	@sorteddice = @storage;
	if ($y > 0) {
	    $diff = $y;
	}
	$lasttotal = $total;$lastawry = $awry;
#	print "Rolling with $diff $z\n";
	mainroll($diff,$z);
	if ($y > 0) {exit;}
    }
}


sub dp {
    my($level) = int(($_[0] / 3) + .99) - 2;
    my($dp) = 1 + ($level * ($level -1) ) / 2;
    return $dp;
}

sub mainroll { 
  @adjustdice = @sorteddice;
    $total = 0;
    $target = $_[0]; $skill = $_[1];
#    print "Target: $target; Skill: $skill\n";
#  print @adjustdice;
    foreach $i (@adjustdice) {
#      print "die: $i\n";
	if ($i >= $target) {
	    ++$total;
	}
	elsif ($target - $i <= $skill and $i != 1) {
	    $spend = $target - $i;
	    $i = $target;   #  We are no longer modifying the actual die here.
#	print "spend is $spend\n";
	    ++$total;
	    $skill = $skill - $spend;
	}
    }
    if ($dflag == 1 and $aflag !=1) {print "\n        ---> @adjustdice \n";}
    
    $printlater= "Target: $target.  Successes: $total.  ";
    if ($lflag == 1) {
      $printlater = $printlater . "\nSkill left over: $skill\n";
    }
    else {
	$printlater = $printlater . "\n";
    }
    doawry();
}


sub printrate {
  $mean = $addall/$statcount;
  print "Rated to get " . &round($mean) . " successes";

  foreach $i (0..$max) {
    $square = (($mean - $i)**2)*$stats[$i] + $square;
  }

  $stdev = &round  (sqrt($square/$statcount));
  $pm = &round( $stdev / sqrt($statcount));

  print " +/- $pm\n with a standard deviation of $stdev\n";

}

sub round {
  $digits = 2; 
  $input = $_[0];
  return int( $input * (10**$digits) +.5 )/ (10**$digits);
}

sub doawry {
  # $printlater is the adjusted successes.  If we're futzing with
  # awryage, we don't use it.
  if (!$aflag || $total<1) {
    print $printlater;
    return;
  }
  $awryon = 1;
  if ($wflag) {
    $awryon = $diff - 5;
  }

  $countawry =0;
  foreach $i(@adjustdice) {
    if ($i <= $awryon) {
      ++$countawry;
    }
  }
    if ($beenhere) {
      --$countawry;
    }

  #Awryage is less interesting on non-wild spells
  if (!$wflag) {
#    print "$countawry awryage, $total suaccesse\n";
    if ($countawry >= (2*$total)) {
      print $printlater;
      print "Definitely awry: $countawry awry, $total succesess\n";

      if ($beenhere != 1) {
	print "\n(Spending one skill to counter awryage)\n";
	$beenhere = 1;
	mainroll ($y, $z-1);
    }
      return;
    }
    if ($countawry >= 3) {
      print $printlater;
      print "Possibly awry: $countawry awry.\n";
      return;
    }
    print "No awryage.\n";
    print $printlater;
    return;
  }
  
## Now everything below this is for wild magic. 
  print $printlater;
  print "$countawry awry\n\n";
  
  if ($countawry > 0 ) {
    &raisebottom;
#  print "mainroll($y,$z)\n";
    &mainroll($y,$z);
  }
}

# Raisebottom changes both the number of skill ($z) and @sorteddice.
sub raisebottom {
#  print "Awry on $awryon\n";
  foreach $i(@sorteddice) {
    if ($i <= $awryon && $i !=1) {
      if ($z > ($awryon - $i) ){
#	print "Raising $i by ($awryon -$i) +1 \n";
	$z = $z - ($awryon - $i) -1 ;
	$i = $awryon + 1;
	return;
      }
    }
  }
  print "Out of skill to adjust awryage\n";
  exit;
}


sub dospeed {
  foreach $i (@sorteddice) {
    $phase{$i} = 1;
  }
  print scalar(keys %phase);
  print " actions: ";
  @speed = (sort othernumerically keys %phase);
  foreach $i (@speed) {
    print "$i ";
  }
  print "\n";
}