File Coverage

blib/lib/Cellular/Automata/Wolfram.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Cellular::Automata::Wolfram;

use 5.006;
use strict;
use warnings;
use GD;
use Carp;
use Math::BaseCalc;
use Graphics::ColorNames 'hex2tuple';
use Class::MethodMaker
    new_with_init => 'new',
    get_set => [qw(rule rules colors radius width num_of_gens first_gen
random gens window draw_file)];

use constant INSTANCE_DEFAULTS => (rule=>110,radius=>1,width=>80,num_of_gens=>100,random=>"",colors=>['white','black'],draw_file=>'wolfram.png');

require Exporter;
require DynaLoader;
require GD;
require Carp;
require Math::BaseCalc;
require Graphics::ColorNames;

use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter DynaLoader);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Cellular::Automata::Wolfram ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);
our $VERSION = '1.1';

bootstrap Cellular::Automata::Wolfram $VERSION;

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

sub init {
    my($self) = shift;
    my %values = (INSTANCE_DEFAULTS,@_);
    my $key;
    if(!exists($values{first_gen})) {
        $values{"first_gen"} =
$self->set_first_gen($values{"colors"},$values{"width"},$values{"random"});
        $values{"width"} = (length($values{"first_gen"}));
    } # if

    if(!exists($values{rules})) {
        $values{rules} =
$self->get_rules($values{rule},$values{colors},$values{radius});
    } # if
    foreach my $key (keys %values) {
        $self->$key($values{$key});
    } # foreach
    my $temp = $self->first_gen();
    if(!defined($self->gens())) {
        $self->generate();
    } # if
    return $self;
} # sub new

sub draw {
    my($self,$draw_file) = @_;
    if(defined($draw_file)) {
        $self->draw_file($draw_file);
    } # if
    else {
        $draw_file = $self->draw_file();
    } # else
    my %COLORS;
    tie %COLORS, 'Graphics::ColorNames';
    my $width = $self->width();
    my $num_of_gens = $self->num_of_gens();
    my $outfile;
    my $i;
    my $j;
    my $im = new GD::Image($width,$num_of_gens);
    my $color;
    open($outfile,">". $draw_file) or croak "Cannot open $draw_file\n";
    my $colors = $self->colors();
    my %color2tuple;
    foreach $color (@{$colors}) {
        if(exists($COLORS{$color})) {
            $color2tuple{$color} =
$im->colorAllocate(hex2tuple($COLORS{$color}));
        } # if
        else {
            croak("Cannot find:" . $color . "in Graphics::ColorNames\n");
        } # else
    } # foreach
    $self->generate();
    my $gens = $self->gens();
    my $gen;
    my @lines;
    my $png_info;
    for($i=0;$i<@{$gens};$i++) {
        @lines = split(//,$gens->[$i]);
        for($j=0;$j<=$#lines;$j++) {
            $im->setPixel($j,$i,$color2tuple{$colors->[$lines[$j]]});
        } # for
    } # for
    binmode $outfile;
    $png_info = $im->png;
    print $outfile $png_info;
    close($outfile);
} # sub draw


sub next_gen {
    my($self,$curr_gen) = @_;
    my $next_gen;
    my $i;
    my $rules = $self->rules();
    my $window_size = $self->window();
    my $width = $self->width(length($self->first_gen()));
    my $radius = $self->radius();
    my $key;
    my $curr_window;
    my $state;
    my $left_cells;
    my $right_cells;
    for($i=0;$i<=($width-$window_size);$i++) {
        $curr_window = substr($curr_gen,$i,$window_size);
        if(exists($rules->{$curr_window})) {
            $next_gen .= $rules->{$curr_window};
        } # if
        else {
            croak("There is no rule for:" . $curr_window);
        } # else
    } # for
    my $temp1;
    my $temp2;
    for($i=1;$i<=$radius;$i++) {
        $curr_window = substr($curr_gen,-$i,$i) .
substr($curr_gen,0,$window_size-$i);
        if(exists($rules->{$curr_window})) {
            $left_cells .= $rules->{$curr_window};
        } # if
        else {
            croak("There is no rule for:" . $curr_window);
        } # else
        $temp1 =  substr($curr_gen,-$window_size+$i);
        $temp2 = substr($curr_gen,0,$i);
        $curr_window = $temp1 . $temp2;
        if(exists($rules->{$curr_window})) {
            $right_cells .= $rules->{$curr_window};
        } # if
        else {
            croak("There is no rule for:" . $curr_window);
        } # else
    } # for
    $next_gen = $left_cells . $next_gen . $right_cells;
    return $next_gen;
} # sub next_gen

sub generate {
    my($self) = @_;
    my $num_of_gens = $self->num_of_gens();
    my $curr_gen;
    my $i;
    if($self->random()) {
        $curr_gen =
$self->set_first_gen($self->colors(),$self->width(),$self->random());
    } # if
    else {
        $curr_gen = $self->first_gen();
    } # else
    my @gens;
    push(@gens,$curr_gen);
    for($i=0;$i<=$num_of_gens;$i++) {
        $curr_gen = $self->next_gen($curr_gen);
        push(@gens,$curr_gen);
    } # for
    $self->gens([@gens]);
} # sub generate

sub set_first_gen {
    my($self,$colors,$width,$random) = @_;
    my $i;
    my @first_gen;
    my $temp;
    my $num_o_colors = @{$colors};
    if($random) {
        srand($$);
        for($i=0;$i<$width;$i++) {
            push(@first_gen,int(rand($num_o_colors)));
        } # for
        $temp = join("",@first_gen);
    } # if
    else {
        $num_o_colors--;
        $temp = "0" x (int($width/2)-1) . "$num_o_colors" . "0" x
int($width/2);
    } # else
    return $temp;
} # sub set_first_gen


sub get_rules {
    my($self,$rule,$colors,$radius) = @_;
    my $i;
    my @k_states = (0..9,'A'..'Z','a'..'z');
    my @subk_states = splice(@k_states,0,@{$colors});
    my $calc = new Math::BaseCalc(digits => \@subk_states); #up to base 36
    my $rule_base = $calc->to_base($rule); # Convert $rule to given base
    my $max_num = (@{$colors} ** (@{$colors}**($radius+2)))-1;
    my $max_num_base = $calc->to_base($max_num);
    my $max_num_base_len = length($max_num_base);
    my $rule_base_len = length($rule_base);
    my $zero_pad = "0" x ($max_num_base_len-$rule_base_len);
    $rule_base = $zero_pad . $rule_base;
    $rule_base = reverse($rule_base);
    my $rule_num;
    my $max_rule_num = (@{$colors}**($radius+2))-1;
    my $max_rule_num_len = length($calc->to_base($max_rule_num));
    $self->window($max_rule_num_len);
    my %rules;
    for($i=$max_rule_num;$i>=0;$i--) {
                                  $rule_num = $calc->to_base($i);
                                  $zero_pad = "0" x
($max_rule_num_len-length($rule_num));
                                  $rule_num = $zero_pad . $rule_num;
                                  $rules{$rule_num} = chop($rule_base);
    } # for
    return \%rules;
} # get_rules

1;
__END__