####################################
# Dice Rolling / Calculator Module #
####################################

# Bananabot 1.0a @2004 Thomas Castiglione  #
# Anyone is permitted to use and modify    #
# this program, as long as they preserve   #
# this notice and note their changes.      #
# banana@phunt.net                         #
#                                          #
# foxxtrot@foxxtrot.net                    #
# The license above was originally applied #
# to the bananabot source code, which is   #
# the core of the dicerolling mechanism,   #
# as well as the aliases.  I have added    #
# the following support to the dice roller #
# and apply the same license to my work.   #
# 1) Added support for WEG d6 System dice  #
# 2) Added support for EABA System dice    #
# 3) Converted options to work within the  #
# mozbot framework.                        #
# 4) Added 'coin' command to 'flip a coin' #


package BotModules::Roll;
use vars qw(@ISA);
@ISA = qw(BotModules);
use Math::Random::MT qw(srand rand);
srand(time());
1;

sub Help {
    my $self = shift;
    my($event) = @_;
    my $help = {
	'' => 'This module hanldes the rolling of dice.',
	'roll' => 'Performs the dice rolling.',
	'alias' => 'Lists all known aliases.  Aliases can only be set by a bot admin.',};
    return $help;
}

sub RegisterConfig {
    my $self = shift;
    $self->SUPER::RegisterConfig(@_);
    $self->registerVariables(
# [ name, save?, settable? ]
				['debug', 0, 1, 0],
				['totalcolour', 1, 1, '04'],
				['rollcolour', 1, 1, '12'],
				['dicecolour', 1, 1, '03'],
				['successcolour', 1, 1, '13'],
				['aliases', 1, 1,{}],);
}

sub Told {
    my $self = shift;
    my($event, $message) = @_;
    if ($message =~ /^\s*!?(flip\s+)?(a\s+)?coin.*$/) {
      my $r = int(rand(2));
      if ($r == 0) {
        $self->say($event,"$event->{'from'}, heads");
      } else {
        $self->say($event,"$event->{'from'}, tails");
      }
      return 0;
    }
    foreach (keys (%{$self->{'aliases'}})) {
	eval('$message =~ s/$_/'.$self->{'aliases'}->{$_}.'/ig');
    }
    if ($message =~ /^\s*!?r(oll)?\s+(.+)\s*$/osi) {
	Roll($self, $2, $event);
    } elsif ($message =~ /^\s*!?\s*alias(es)?/osi) {
	list_aliases($self,$event);
    } else {
	return $self->SUPER::Told(@_);
    }
    return 0;
# we've dealt with it, no need to do anything else.
}

sub Heard {
    my $self = shift;
    my($event, $message) = @_;
    if ($message =~ /^\s*!(flip\s+)?(a\s+)?coin.*$/) {
      my $r = int(rand(2));
      if ($r == 0) {
        $self->say($event,"$event->{'from'}, heads");
      } else {
        $self->say($event,"$event->{'from'}, tails");
      }
      return 0;
    }
    foreach (keys (%{$self->{'aliases'}})) {
	eval('$message =~ s/$_/'.$self->{'aliases'}->{$_}.'/ig');
    }
    if ($message =~ /^\s*!r(oll)?\s+(.+)\s*$/osi) {
	Roll($self, $2, $event);
    } elsif ($message =~ /^\s*!\s*alias(es)?/osi) {
	list_aliases($self,$event);
    } else {
	return $self->SUPER::Heard(@_);
    }
    return 0;
}

sub list_aliases {
    my ($self,$event) = @_;
    $self->say($event, "Currently known aliases:");
    my @alias = sort(keys(%{$self->{'aliases'}}));
    foreach (@alias) {
	$self->say($event, "$_ => $self->{'aliases'}->{$_}");
    }
    $self->say($event, "End of alias list.");
}

sub Roll {
    my($self, $expression, $event) = @_;
    my $totalcolour = $self->{'totalcolour'};
    my $rollcolour = $self->{'rollcolour'};
    my $dicecolour = $self->{'dicecolour'};
    my $successcolour = $self->{'successcolour'};
    $self->say($event, "DEBUG: \$expression = $expression") if ($self->{'debug'});
### Replace Aliases ###
    #foreach (keys (%{$self->{'aliases'}})) {
#	eval('$expression =~ s/$_/'.$self->{'aliases'}->{$_}.'/ig');
 #   }
### Calculate number of Rolls #####    
    my $lines = 1;
    local $BotModules::Roll::target = 0;
#    if ($1 eq '') {
#	$BotModules::Roll::target = 0;
#    } else {
#	$BotModules::Roll::target = $1;
#    }
    my $fre = '\s*((\d*)\s*(@\s*\d*)?)\s*';
    if ($expression =~ /^${fre}#/) {
	$expression =~ s/${fre}#([^,]+)/and_repeat($4, $1)/e;
    } elsif ($expression =~ /#$fre$/) {
	$expression =~ s/([^,]+)#$fre/and_repeat($1, $2)/e;
    }
    #$self->say($event, "DEBUG: \$BotModules::Roll::target = $BotModules::Roll::target") if ($self->{'debug'});
    #$self->say($event, "DEBUG: \$expression = $expression") if ($self->{'debug'});
    if ($expression =~ /,\s*\d+/) {
	($expression, $lines) = split(/\s*,\s*/, $expression);
    } elsif ($expression =~ /\d+\s*,/) {
	($lines,$expression) = split(/\s*,\s*/, $expression);
    }
#    $self->say($event, "DEBUG: \$lines = $lines") if ($self->{'debug'});
    if ($lines > 10) {
	$self->say($event, "ERROR (40): Yeah, that would give you plenty of time to go fuck yourself.");
	return;
    }
### Seprate Batch Rolls ####
    for (my $i = 0 ; $i < $lines ; $i++) {
	my @batch = split('&',$expression);
	my $line = '';
	my $successes = 0;
	my $open = 0;
	my $wilddie = 0;
	my $p;
### Implement ** Operator ###	
	foreach $_ (@batch) {
	    while(/\*\*/) {
		s/([^,#]+)\*\*\s*(\d*)/roll_repeat($1, $2)/e;
	    }
	    $p = $_;
	    s/".*"//g;
	    $p =~ s/"(.*)"/$1/g;
### Substitue Die Roll Results for the d-Expressions ###
	    my @rolls = ($_ =~ /\d*[deso]\d*f?[hl]?\d*[hl]?\d*i?/ig);
	    for my $roll (@rolls) {
		#$self->say($event,"DEBUG: \$roll = $roll") if $self->{'debug'};
		my $orig = $roll;
### Conform to Roll Format: a(d|e|o|s)blchd, {a,c,d} are numbers, {b} number or f ###
		if ($roll !~ /l/i) {
		    $roll .= 'l0';
		}
		if ($roll !~ /h/i) {
		    $roll .= 'h0';
		}
		$roll =~ s/l([^0123456789])/l1$1/i;
		$roll =~ s/h([^0123456789])/h1$1/i;
		$roll =~ s/h(\d*)l(\d*)/l$2h$1/i;
		if ($roll =~ /^(d|e|o|s)/i) {
		    $roll = '1'.$roll;
		}
		$roll =~ s/(d|e|o|s)(h|l|i)/${1}6$2/i;
### Parse ###
		my $result = '(';
		my $presult = '';
		my ($individual,$high,$low,$sides,$number);
		if ($roll =~ /i/i) {
		    $individual = 1;
		    $roll =~ s/i//i;
		} else {
		    $individual = 0;
		}
		($roll, $high) = split(/h/i, $roll);
		($roll, $low) = split(/l/i, $roll);
		if ($roll =~ /d/i) {
		## Normal Dice ##
		    ($number,$sides) = split(/d/i, $roll);
		    $open = 0;
		} elsif ($roll =~ /o/) {
		## Open Dice ##
		    ($number, $sides) = split(/o/i, $roll);
		    $open = 1;
		} elsif ($roll =~ /s/) {
		## WEG d6 Dice ##
		    ($number,$sides) = split(/s/i, $roll);
		    $open = 2;
		} elsif ($roll =~ /e/) {
		## EABA Dice ##
		    ($number,$sides) = split(/e/i, $roll);
		    $open = 0;
		    $low = $low - (3 - $number) if $number > 3;
		}
		if ($number < 1) {
		    $self->say($event, "ERROR (100): Not enough dice");
		    return;
		}
		if ($number > 39278) {
		    $self->say($event, "ERROR (39278): Too many dice");
		    return;
		}
		if ($sides > 24789653974) {
		    $self->say($event, "ERROR (24789653974): Too many sides");
		    return;
		}
		if ($sides !~ /f/i && $sides < 2) {
		    $self->sat($event, "ERROR (200): Invalid number of sides");
		    return;
		}
		$self->say($event,"About to roll: \$number = $number \$sides = $sides \$individual = $individual \$high = $high \$low = $low") if $self->{'debug'};
### Time to Roll ####
		$result = 0;
		$presult = "\003$self->{'dicecolour'}";
		my @dice = ();
		my $die;
		if ($open == 0 && $sides !~ /f/i) {
		    for (my $j = 0 ; $j < $number ; $j++) {
			$die = int(rand($sides)) + 1;
			push (@dice,$die);
		    }
		} elsif ($open == 0 && $sides =~ /f/i) {
		    for (my $j = 0 ; $j < $number ; $j++) {
			$die = int(rand(3)) - 1;
			push (@dice, $die);
		    }
		} elsif ($open == 1 && $sides !~ /f/i) {
		    for (my $j = 0 ; $j < $number ; $j++) {
			$die = int(rand($sides)) + 1;
			push (@dice, $die);
			if ($die == $sides) {
			    $j--;
			}
		    }
		} elsif ($open == 1 && $sides =~ /f/i) {
		    for (my $j = 0 ; $j < $number ; $j++) {
			$die = int(rand(3)) - 1;
			push (@dice, $die);
			if ($die == 1) {
			    $j--;
			}
		    }
		} elsif ($open == 2 && $sides !~ /f/i) {
		    for (my $j = 0 ; $j < 1 ; $j++) {
			$die = int(rand($sides)) + 1;
			push (@dice, $die);
			if ($die == $sides) {
			    $wilddie = 2;
			    $j--;
			}
		    }
		    if ($dice[0] == 1) {
			$wilddie = 1;
			$high = 1;
			$low = 1 if $number > 1;
		    }
		    for (my $j = 1 ; $j < $number ; $j++) {
			$die = int(rand($sides)) + 1;
			push(@dice,$die);
		    }
		} elsif ($open == 2 && $sides =~ /f/i) {
		    for (my $j = 0 ; $j < 1 ; $j++) {
			$die = int(rand(3)) - 1;
			push(@dice,$die);
			if ($die == 1) {
			    $wilddie = 2;
			    $j--;
			}
		    }
		    if ($dice[0] == -1) {
			$wilddie = 1;
			$high = 1;
			$low = 1 if $number > 1;
		    }
		    for (my $j = 1 ; $j < $number ; $j++) {
			$die = int(rand(3)) - 1;
			push(@dice,$die);
		    }
		}
		if ($high + $low > $number) {
		    $self->say($event,"ERROR (88): Too many droppings");
		    return;
		}
		foreach $die (@dice) {
		    if ($sides =~ /f/i) {
			if ($die == 1) {$presult .= '+';}
			if ($die == 0) {$presult .= '/';}
			if ($die == -1) {$presult .= '-';}
		    }
		    $result += $die;
		}
		if ($sides !~ /f/i) {
		    if ($individual == 0) {
			$presult .= pad($number,$sides,$result);
		    } else {
			foreach $die (@dice) {
			    $presult .= pad (1, $sides, $die) . '+';
			}
			chop($presult);
		    }
		}
		my @sorteddice = sort { $a <=> $b } @dice;
		my @dropped;
		if ($low > 0 && $sides !~ /f/i) {
		    @dropped = @sorteddice[$0 .. ($low -1)];
		    foreach $die (@dropped) {
			$result -= $die;
			$presult .= '-'.pad(1,$sides,$die);
		    }
		}
		if ($high > 0 && $sides !~ /f/i) {
		    my $top = $#sorteddice + 1;
		    @dropped = @sorteddice[($top-$high) .. ($top - 1)];
		    foreach $die (@dropped) {
			$result -= $die;
			$presult .= '-'.pad(1,$sides,$die);
		    }
		}
		$presult .= "\003$self->{'rollcolour'}";
		# replace the $roll with the new total for that $roll
		s/$orig/($result)/;
		$p =~ s/$orig/$presult/;
	    }
## Make Sure only Valid Syntax Remiains ###
	    s/x/\*/gi;	    # Allow 'x' for '*'
	    s/\^/\*\*/g;    # Allow '^' for '**'
	    s/p/\+/g;	    # Allow 'p' for '+'
	    unless(m/^[\d\s(\)\+\-\*\/\%\.]+$/) {
		return;
	    }
	    my $answer = eval;
#	    $self->say($event,"DEBUG: \$answer = $answer") if $self->{'debug'};
	    my $q = $p;
	    my $answercolour;
	    if ($answer < $BotModules::Roll::target || $BotModules::Roll::target == 0) {
		$answercolour = $self->{'totalcolour'};
	    } else {
		$successes++;
		$answercolour = $self->{'successcolour'};
	    }
	    if ($q =~ /[^\s\d\003]/) {
		$answer = "\003$self->{'rollcolour'}$p = \003${answercolour}$answer";
	    } else {
		$answer = "\003${answercolour}$answer";
	    }
	    $line .= $answer . " ";
	}
	if ($BotModules::Roll::target > 0) {
		$line .= " $successes success";
		if ($successes != 1) {
			$line .= 'es';
		}
	}
	if ($open == 2 && $wilddie == 1) {
	    $line .= " Wild Die Failure";
	} elsif ($open == 2 && $wilddie == 2) {
	    $line .= " Wild Die Rerolled";
	}
	$self->say($event,"$event->{'from'}, $line");
    }
}

sub roll_repeat {
    my ($expr, $factor) = @_;
    my $exprplus = $expr . ' + ';
    return (($exprplus x ($factor - 1)) . $expr);
}

sub and_repeat {
    my ($expr, $factor) = @_;
    if ($factor eq '') {
	$factor = '1@0';
    } elsif ($factor !~ /@/) {
	$factor .= '@0';
    } elsif ($factor =~ /^@/) {
	$factor = '1' . $factor;
    }
    ($factor, $BotModules::Roll::target) = split(/@/, $factor);
    my $exprplus = $expr.'&';
    return (($exprplus x ($factor -1)) . $expr);
}

sub pad {
    my ($nd, $sd, $inp) = @_;
    my $maxlen;
    if ($sd =~ /f/i) {
	$maxlen = $nd;
    } else {
	$maxlen = length ($nd * $sd);
    }

    for (my $k = length $inp ; $k < $maxlen ; $k++) {
	$inp .= ' ';
    }

    return $inp;
}