#
# FancyDice.pm -- makes and rolls dice.
#

=head1 NAME

Games::FancyDice -- Dealing with Fancy(& Fanctionally) Dice for OOP

=head1 SYNOPSIS

 use Games::FancyDice qw(roll_dice);

 # as function
 print roll_dice(6);                # 1-6
 print roll_dice('2d8 + 1');        # 9-17
 my @dice = roll_dice('3d6','list');# 3-18
 
 # as method
 my $die = Games::FancyDice::Die->new(); # by default, a die with 6 sides
 $die->set_sides(10); # change sides into 10
 $die->set_looks( [1,3,5,7,9,11] );
 print $die->roll();
 
 # make a gimmic die
 $die->set_gimmic( 1 => 5, 2 => 3 ); # probability  5:3:1:1:1:1
 $die->set_gimmic( [5,3,1,1,1,1]  ); # same as upper
 
 $die = Games::FancyDice->new(
 	sides  => 4,
 	looks  => [1,2,3,3],
 	prob   => [3,1,1,1],
 	offset => -1,
 );
 # same as
 $die->is_fancy(
 	sides  => 4,
 	looks  => [qw(1 2 3 3)],
 	prob   => [3],
 	offset => -1
 );

 $die = Games::FancyDice->new([ # アルファベットサイコロ&100面ダイス
 	{ sides => 6, looks => [ qw(a b c d e f) ] },
 	{ sides => 100}
 ]);

 # 通常のサイコロではlooksは空リストへのリファレンス。
 # この時､rollはいちいち面の持つ値を調べない。
 # こうしないと、100面ダイスは100要素のリストが必要になってしまうから。

 # deal with dice
 my $dice = Games::FancyDice->new([8,8]); # create two dice with 8 sides.
 $dice->roll();         # roll every dice
 $dice->get(1)->roll(); # roll second die
 $dice->get(0)->set_gimmic([0,0,0,0,0,0,0,1]); # use first as gimmic dice

 $dice = Games::FancyDice->new('2d8'); # create two dice with 8 sides.


=head1 DESCRIPSION

You can produce any pseud-random numbers with C<rand>. Then you simulate
dice. But this module is easy to make any strange dice. For example,
would you like a gimmic die resulting number 6 in many time? Or How about
an alphabetical die,instead number? This is for you hoping to do so.

C<rand()>を使えば乱数をつくることができる。それでサイコロを
シミュレートすることも簡単だ。だがこのモジュールを使えば
変わり種のサイコロを手軽につくることができる。
例えば、6が異様に出やすいインチキサイコロは欲しくないか？
数字の代わりにアルファベットのサイコロはどう？
このモジュールはそんなあなたの味方です。

=cut
#######################################
# Games::FancyDice CLASS
#######################################
package Games::FancyDice;

=head1 Games::FancyDice Class

This class is for storing Games::FancyDice::Die objects.

このクラスは、1個以上のサイコロを保持する。

=cut
#==============================================================================
use warnings;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
@ISA       = qw(Exporter);
@EXPORT_OK = qw(roll_dice);
$VERSION   = '0.01';

#######################################
# FUNCTION
#######################################

sub roll_dice($;$$){
	my ($num,$sides,$opt,$value) = _specify_dice($_[0]);
	my (@dice,$sum);
	my $list = $_[1]; # is true. then return list of dice.

	for(my $i = 1; $i <= $num; $i++){
		my $result = int( rand($sides) + 1 );
		$sum += $result;
		push @dice,$result;
	}

	if(defined $opt){
		$sum += $value if($opt eq '+');
		$sum -= $value if($opt eq '-');
		$sum /= $value if($opt eq '/');
		$sum *= $value if($opt eq '*');
		$sum %= $value if($opt eq '%');
	}

	return ($list) ? @dice : $sum;
}

sub _specify_dice($){ # Users don't use this function directly.
	local $_ = lc(shift);
	s/\s//g;
	my ($num,$sides,$opt,$value) = m{(\d*)d(\d+)([-/+*xX%])?(\d+)?};

	$num   ||= 1; $sides ||= 6;

	if   (!defined $opt) { $opt = ''; $value = ''}
	elsif($opt =~ /[xX]/){ $opt = '*'; }

	return ($num,$sides,$opt,$value);
}

#==============================================================================

=head2 Methods of FancyDice

=over

=item new

This is a constructor which creates new die object.
Its behavior differs acoording to how many numbers of arguments
which the method takes more than 0. Without arguments, new creates
a simple die with 6 sides. With one argument, the constructor creates
specific dice according to specificion.

nweは新たにサイコロ（一つないしは複数）を生成する。
newの引数の個数は0、1、それ以上のどれかを取り、それによって動作が異なる。
引数がない場合、通常の6面ダイスを生成する。
引数が一つの場合、指定に従って通常のダイスを生成する。
引数が二つ以上の場合、指定に従って特殊な（特殊でなくても良い）ダイスを生成する。

=cut
#######################################
# CONSTRUCTOR
#######################################
sub new() {
	my $class = shift;
	my $self  = {
		dice   => [],
	};
	bless($self,$class);
	$self->_int(@_);
	return $self;
}
#######################################
sub _int{
	my $self  = shift;
	my @arg   = @_;
	my $sides;

	$self->{offset} = 0;  # may require D&D type

	if(! @arg){  # no argument
		$self->{dice} = [_die(6)];
	}
	elsif( @arg == 1 ){ # one argument
		if(ref $arg[0] eq 'ARRAY'){
			push @{ $self->{dice} }, _die($_) for( @{ $arg[0] } );
		}
		else{ # D&D type ... ex. '2d6'
			my ($num,$sides,$opt,$value) = _specify_dice($arg[0]);
			$self->{offset} += $value if($opt eq '+');
			$self->{offset} -= $value if($opt eq '-');
			push @{ $self->{dice} }, _die($sides) while($num--);
		}
	}
	else{
		push @{ $self->{dice} }, _die($_) for( @arg );
	}
}

sub _die{
	my $num = $_[0];
	if(!defined $num){ $num = 6; }
	return Games::FancyDice::Die->new($num);
}
#######################################
# METHODS
#######################################

=item roll

This rolls all dice at once. In list context, returns each result and
in 

一斉にサイコロを振る。リストコンテキストでは、各さいころの出目が返る。
スカラーコンテキストでは、サイコロの総和が返る。サイコロの出目が数値以外
の場合は総和には含まれない。

=cut

sub roll{
	my $self   = shift;
	my @result = ();
	my $sum    = undef;

	for my $d ( @{ $self->{dice} } ){ # サイコロを振る
		my $looks = $d->roll;
		push @result,$looks;
		$sum += $looks if($looks !~ /\D/);
	}

	$sum += $self->{offset}; # ex. FancyDice->new('2d8+1'), offset is 1.

	return (wantarray) ? @result : $sum;
}

=item get

引数に与えた場所にあるサイコロオブジェクトを返す。
引数がない場合は全てのサイコロオブジェクトを返す。

=cut

sub get{
	my $self = shift;
	my $num  = $_[0];
	return (defined $_[0]) ? $self->{dice}->[$num] : @{ $self->{dice} };
}

=item sum_up

直前にrollした出目の総和を返す。
数字以外の出目は足されない。

=cut

sub sum_up{
	my $self = shift;
	my $sum  = undef;
	for my $d ( @{ $self->{dice} } ){
		my $looks = $d->looks;
		$sum += $looks if($looks !~ /\D/);
	}
	return $sum;
}

=item max_min

出目の最小値と最大値を返す。

 ($min,$max) = $dice->max_min();

数字以外の出目は無視され、その結果最小・最大が存在しない場合は
undefが返される。

=cut

sub max_min{
	my $self = shift;
	my ($max,$min);
	for my $d ( @{ $self->{dice} } ){
		my $looks = $d->looks;
		next if($looks !~ /^-?\d+$/);
		$max = (!defined $max or $looks > $max) ? $looks : $max;
		$min = (!defined $min or $looks < $min) ? $looks : $min;
	}
	return ($min,$max);
}

=item max_min_rolled

出目の最小値と最大値を返す。C<max_min>との違いは、それが
$Games::FancyDie::rolledの値、すなわち面の番号であるという点である。
ゆえに、C<max_main>と違ってどんな場合でも最小最大を返すことが出来る。

=cut

sub max_min_rolled{
	my $self = shift;
	my ($max,$min);
	for my $d ( @{ $self->{dice} } ){
		$max = (!defined $max or $d->{rolled} > $max) ? $d->{rolled} : $max;
		$min = (!defined $min or $d->{rolled} < $min) ? $d->{rolled} : $min;
	}
	return ($min,$max);
}


=back

=cut
#######################################
# Games::FancyDice::Die CLASS
#######################################
package Games::FancyDice::Die;
use strict;
use warnings;

=head1 Games::FancyDice::Die Class

sides の値Nは1以上の整数。面には0,1,2,...N-1までの番号がふられる。
面の番号に対応する面のデザイン

=head2 Constructor

=over

=item new

新たなサイコロを生成する。引数は省略可能で、一つの数値か、
名前付き引数を渡すことができる。
数値を渡した場合、その値だけ面を持ったサイコロが生成される。
名前付き引数を渡すと、特殊なサイコロを生成する。

=back

=head2 Member Variables

C<new>コンストラクタに渡すことが出来る引数の一覧。

=over

=item sides

=item looks

=item prob

=back

=cut

#######################################
# CONSTRUCTOR
#######################################
sub new() {
	my $class = shift;
	my $self  = {
		sides   => undef, # 面数
		looks   => undef, # 面に記された数字ないしは文字
		p       => undef, # 出現率(undefの時、無条件に均一)
		rolled  => undef, # 出目の面の番号
		offset  => 0,     # オフセット値
	};
	bless($self,$class);
	$self->_init(@_);
	return $self;
}
#######################################
sub _init{
	my $self = shift;
	my %hash = ();
	if(!defined $_[0]){
		$self->is_fancy( sides => 6 );
	}
	elsif( $_[0] =~ /^\d+$/ ){
		$self->is_fancy( sides => $_[0] );
	}
	elsif( ref $_[0] eq 'HASH' ){
		$self->is_fancy( %{$_[0]} );
	}
	else{
		$self->is_fancy( @_ );
	}
}
#######################################
# METHODS
#######################################

=head2 Methods of FancyDice::Die

=over

=item is_fancy

サイコロに様々なパラメータを渡す。このドキュメントでは確率分布あるいは
数字以外の面を持ったサイコロをファンシーなサイコロと呼ぶ。
引数がない時は、現在のlooksとprobのハッシュリファレンスを返す。
二つが共にundefなら偽を返す。

=cut

sub is_fancy{
	my $self = shift;
	my %hash = @_;

	$self->{sides}  = $hash{sides}  if(defined $hash{sides});
	$self->{looks}  = $hash{looks}  if(defined $hash{looks});
	$self->{offset} = $hash{offset} if(defined $hash{offset});
	if(defined $hash{prob}){
		$self->set_probability( $hash{prob} );
	}

	return (defined $self->{looks} or defined $self->{prob}) ?
		{looks => $self->{looks}, prob => $self->{prob}} : 0;
}

=item casual

ファンシーになったサイコロを元に戻す。
直前のファンシーさを返す。面の数と出目の値は変わらない。

=cut

sub casual{
	my $origin = {looks => $_[0]->{looks}, prob => $_[0]->{prob}};
	$_[0]->{looks} = undef;
	$_[0]->{prob}  = undef;
	return $origin;
}


sub set_probability{
	my $self  = shift;
	my $data  = $_[0];
	my $sides = $self->{sides};
	my $total = 0;
	# 配列リファレンスの場合、その順番に対応する面にあてはめていく
	if( ref $data eq 'ARRAY' ){
		for(my $i=0; $i < $sides; $i++){
			$total += (defined $data->[$i]) ? $data->[$i] : 1;
		}
		for(my $i=0; $i < $sides; $i++){
			$self->{p}->[$i] = (defined $data->[$i]) ?
				 $data->[$i] / $total: 1 / $total;
		}
	}
	# ハッシュリファレンスの場合、外見に対応するようにする。
	elsif( ref $data eq 'HASH' ){
		for(my $i=0; $i < $sides; $i++){
			my $num = $self->look_up($i+1);
			$total += (defined $data->{ $num }) ? $data->{ $num } : 1;
		}
		for(my $i=0; $i < $sides; $i++){
			my $num = $self->look_up($i+1);
			$self->{p}->[$i] 
				= (defined $data->{ $num }) ?
					$data->{ $num } / $total: 1 / $total;
		}
	}
}


=item roll

サイコロを振る。

=cut

sub roll{
	my $self = shift;

	$self->{rolled}
	 = (defined $self->{p}) ? _dist_roll($self) : _normal_roll($self);

	return $self->looks();
}

sub _normal_roll{
	return int( rand( $_[0]->{sides} ) );
}

#######################################
# Disribution
# 確率分布の変更されたダイス
#######################################

sub _dist_roll{
	my $rand = rand();
	for(my $i=0; $i <= scalar( @{$_[0]->{p} }); $i++ ){
		$rand -= $_[0]->{p}->[$i];
		return $i if( $rand < 0 );
	}
}

=item set_rolled

=cut

sub set_rolled{
	return $_[0]->{rolled} = $_[1];
}

=item reset_rolled

=cut

sub reset_rolled{
	my $rolled      = $_[0]->{rolled};
	$_[0]->{rolled} = undef;
	return $rolled;
}


=item look

rolledを返す…いらない？

=cut

sub look{
	my $self = shift;
	return $self->{rolled};
}

# 配列リファレンスの場合とハッシュリファレンスの場合との違い

=item look_up

引数に与えた数に対応する面を返す。
引数を与えなければ、全ての面のリストを返す。

=cut

sub look_up{
	return (defined $_[1]) ?
		$_[0]->_check_looks($_[1] - 1)
		 : map{ $_[0]->_check_looks($_ - 1) } 1..$_[0]->{sides};
}

=item looks

現在の$Games::FancyDice::Die::rolledに基づいて出目を返す。

=cut

sub looks{
	return (!defined $_[0]->{looks}) ? 
		$_[0]->{rolled} + 1 + $_[0]->{offset} : $_[0]->_check_looks;
}

#######################################
# 出目を判定して返す。
# looksが設定されているかどうか。
# されているなら、配列なのかハッシュ
# なのか。それぞれ異なる処理が必要…
#######################################

sub _check_looks{
	my $num = (defined $_[1]) ? $_[1] : $_[0]->{rolled};
	if(ref $_[0]->{looks} eq 'ARRAY'){
		return ( $_[0]->{looks}->[$num] ) ?
			$_[0]->{looks}->[$num] :
			$num + 1 + $_[0]->{offset};
	}
	elsif(ref $_[0]->{looks} eq 'HASH'){
		return ( defined $_[0]->{looks}->{$num+1} ) ?
			$_[0]->{looks}->{$num+1}:
			$num + 1 + $_[0]->{offset};
	}
	else{
		return $num + 1 + $_[0]->{offset};
	}
}
#==============================================================================
1;
__END__

=back

=head1 EXPORT

use Games::FancyDice に'roll_dice'を渡すことによって
関数C<roll_dice>をエクスポートする。

この関数を呼び出すとサイコロを振ってくれる。

 use Games::FancyDice qw(roll_dice);
 print roll_dice(10);
 print roll_dice('2d6 + 3');

=head1 BUGS

プラットフォームによっては、大きな数を利用できない場合がある。
例えばWindows系では2^15乗より大きい数の多面体ダイスは、正しく
動作しないかもしれない。

=head1 Author

Makamaka Hannyaharamitu

=cut