Untitled

package Dice;
use warnings;
use strict;
use Carp;
use overload bool => sub { return $_[0]->{dice} + $_[0]->{pips} },
             '""' => \&str,
             '*'  => \&mul,
             '+'  => \&add,
             '++' => \&add,
             '-'  => \&subt,
             '--' => \&subt;

sub mul {
  my $a = shift;
  confess "Nothing to subtract!" unless @_;

  my $b = shift;
  confess "Variable \$b <$b> isn't a number!" unless $b =~ /^[+-]?\d+?$/;

  return Dice->new($a->{dice} * $b, $a->{pips} * $b);
}

sub subt {
  my $a = shift;
  confess "Nothing to subtract!" unless @_;
  my $b = shift;

  my $order = @_ ? shift : 5;

  if (not ref $b) {
    eval { $b = Dice->new($b) };
    if ($@) {
      print STDERR "$@\n";
      $b = Dice->new(0, 0);
    }
  }

  ($a, $b) = ($b, $a) if $order;
  confess "Variable \$a <$a> is not an object reference!" unless ref $a;
  confess "Variable \$b <$b> is not an object reference!" unless ref $b;

  my $res;
  if (ref $b eq ref $a) { # $b is a die code penalty or something
    $res = Dice->new($a->{dice} - $b->{dice}, $a->{pips} - $b->{pips});

  } elsif ($b =~ /([+-]?\d+?) \+ ([+-]?\d+?)/) {
    $res = Dice->new($a->{dice} - $1, $a->{pips} - $2);

  } else {
    confess "Gah!";

  }

  $order eq '' ? $_[0] = $res : $res;
}

sub add {
  my $d = shift;
  confess "That's not an object!" unless ref $d;
  confess "Nothing to add!" unless @_;

  my $val = shift;
  my $res;
  my $mut = @_ ? shift : 5;
  if (ref $d eq ref $val) {
    return Dice->new($d->{dice} + $val->{dice}, $d->{pips} + $val->{pips});

  } elsif ($val =~ /([+-]\d+?)D \+ (\d+?)/)  {
    print STDERR $val, "\n";
    $res = Dice->new($d->{dice} + $1, $d->{pips} + $2);

  } elsif ($val =~ /^[+-]?\d+?/) { # stringy and numberish at the same time!!
    $res = Dice->new($d->{dice} + @_ ? int shift : 0, $d->{pips} + $val);

  } elsif (not defined $val) {
    $res = Dice->new($d->{dice} + 1, $d->{pips});

  } else {
    confess "Inexplicable value $val!";

  }

  $mut eq '' ? $_[0] = $res : $res;
}

sub str {
  my $d = shift;
  ref $d
    ? sprintf '%dD + %d', $d->{dice}, $d->{pips}
    : sprintf '%dD + %d', @_ ? int shift : 1, @_ ? int shift : 0
}

sub new {
  my $class = shift;
  # everyone's favorite copy constructor!
  return new("$class") if ref $class and not @_;

  my $dice = @_ ? shift : 1;
  my $pips;

  if ($dice =~ /^([+-]?\d+?)D \+ (\d+?)$/) {
    $dice = $1;
    $pips = $2;

  } elsif ($dice =~ /^[+-]?\d+?$/) {
    $pips = @_ ? int shift : 0;

  } else {
    confess "Got passed an inexplicable value of $dice\n";
  }

  my $self = {dice => $dice, pips => $pips};

  bless $self, $class;
  return $self;
}

5;