File Coverage

blib/lib/Game/PseudoRand.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	16	16	100.0
condition	28	32	87.5
subroutine	12	12	100.0
pod	2	2	100.0
total	107	111	96.4

# -*- Perl -*-
#
# returns Pseudo Random Distribution random functions

package Game::PseudoRand;

use 5.10.0;
use strict;
use warnings;
use Carp qw(croak);

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(prd_step prd_table);

our $VERSION = '0.01';

sub prd_step {
    my %param = @_;
    croak "prd_step requires start and step values"
      unless exists $param{start}
      and exists $param{step};
    croak "prd_step rand must be a code ref"
      if defined $param{rand} and ref $param{rand} ne 'CODE';
    my $odds  = $param{start};
    my $reset = $param{reset} // $odds;
    my $rand  = $param{rand} // sub { CORE::rand };
    my $step  = $param{step};
    (   sub {
            if ( &$rand <= $odds ) { $odds = $reset; 1 }
            else                   { $odds += $step; 0 }
        },
        sub { $odds = $param{start} }
    );
}

sub prd_table {
    my %param = @_;
    croak "prd_table requires start and table values"
      unless exists $param{start}
      and exists $param{table};
    croak "prd_table table must be a not-empty array ref"
      if ref $param{table} ne 'ARRAY' or !@{$param{table}};
    croak "prd_table rand must be a code ref"
      if defined $param{rand} and ref $param{rand} ne 'CODE';
    my $index = $param{index} // 0;
    my $table = [ @{$param{table}} ];
    croak "index outside of table bounds" if $index < 0 or $index >= @$table;
    my $odds  = $param{start};
    my $reset = $param{reset} // $odds;
    my $rand  = $param{rand} // sub { CORE::rand };
    (   sub {
            if ( &$rand <= $odds ) { $odds = $reset; $index = 0; 1 }
            else                   { $odds += $table->[ $index++ ]; $index %= @$table; 0 }
        },
        sub { $odds = $param{start}; $index = $param{index} // 0 }
    );
}

1;
__END__