App-GUI-GoLP
view release on metacpan or search on metacpan
my $max_row_len = 0;
my %cell_state_map = ( '.' => 0, 'o' => 1, 'O' => 1, 'x' => 1, 'X' => 1, );
my @file_grid;
READ_CELLS_FILE: while ( my $line = <$fh> ) {
chomp($line);
next READ_CELLS_FILE if $line =~ /!/; # skip comments
# sometimes in .cells files the trailing dead cells in a row are omitted
my $row_len = length($line);
if ( $row_len > $max_row_len ) {
$max_row_len = $row_len;
}
my @row_cells = map { $cell_state_map{$_} } split(//, $line);
push @file_grid, \@row_cells;
}
close($fh);
my @grid;
# we can't guarantee that the grid read from the file has uniform length rows.
foreach my $row (@file_grid) {
my @file_row = @{$row};
my $trailing = $max_row_len - scalar(@file_row);
if ( $trailing < 0 ) {
warn("Somehow calculating the row length went wrong");
return undef;
}
push @file_row, (0) x $trailing;
push @grid, \@file_row;
}
my $rows = scalar(@grid);
my $cols = $max_row_len;
unless ( defined($rows) && ($rows > 0) && defined($cols) && ($cols > 0) ) {
warn("Load does not look successful!");
return undef;
}
return { rows => $rows, cols => $cols, data => \@grid };
}
package NewBoard;
# 'New' dialog
use Prima;
use Prima::Classes;
use vars qw(@ISA);
@ISA = qw(Prima::MainWindow);
use Prima::Buttons;
use Prima::Label;
use Prima::Sliders;
sub profile_default
{
my $def = $_[ 0]-> SUPER::profile_default;
my %prf = (
designScale => [ 9, 18],
name => 'New Board',
origin => [ 776, 197],
originDontCare => 0,
size => [ 332, 360],
sizeDontCare => 0,
width => 332,
height => 360,
left => 776,
bottom => 197,
designScale => [ 9, 18],
);
@$def{keys %prf} = values %prf;
return $def;
}
sub init
{
my $self = shift;
my %instances = map {$_ => {}} qw();
my %profile = $self-> SUPER::init(@_);
my %names = ( q(NewBoard) => $self);
$self-> lock;
# Board size box
$names{GroupBox2} = $names{NewBoard}->insert( qq(Prima::GroupBox) =>
name => 'GroupBox2',
origin => [ 16, 240],
size => [ 300, 106],
text => 'Board size',
);
# Width
$names{Label2} = $names{GroupBox2}->insert( qq(Prima::Label) =>
name => 'Label2',
origin => [ 43, 46],
size => [ 100, 22],
text => 'Width',
);
$names{SpinEdit2} = $names{GroupBox2}->insert( qq(Prima::SpinEdit) =>
name => 'SpinEdit2',
origin => [ 128, 48],
size => [ 156, 22],
min => 1,
max => 100000,
value => 100,
);
# Height
$names{Label30} = $names{GroupBox2}->insert( qq(Prima::Label) =>
name => 'Label30',
origin => [ 43, 14],
size => [ 100, 22],
text => 'Height',
);
$names{SpinEdit30} = $names{GroupBox2}->insert( qq(Prima::SpinEdit) =>
name => 'SpinEdit30',
origin => [ 128, 16],
size => [ 156, 22],
min => 1,
max => 100000,
value => 100,
);
# Cell state box
$names{GroupBox1} = $names{NewBoard}->insert( qq(Prima::GroupBox) =>
name => 'GroupBox1',
origin => [ 16, 66],
size => [ 300, 160],
text => 'Initial cell state',
);
# Radio buttons for cell state
$names{Radio1} = $names{GroupBox1}->insert( qq(Prima::Radio) =>
name => 'Radio1',
origin => [ 18, 98],
size => [ 100, 36],
text => 'All dead',
checked => 1,
);
$names{Radio2} = $names{GroupBox1}->insert( qq(Prima::Radio) =>
value => 50,
);
# OK and cancel buttons
$names{Button1} = $names{NewBoard}->insert( qq(Prima::Button) =>
name => 'Button1',
origin => [ 40, 14],
size => [ 96, 36],
text => '~OK',
modalResult => mb::OK,
);
$names{Button2} = $names{NewBoard}->insert( qq(Prima::Button) =>
name => 'Button2',
origin => [ 196, 14],
size => [ 96, 36],
text => 'Cancel',
modalResult => mb::Cancel,
);
$self->unlock;
return %profile;
}
sub value {
my $self = shift;
my %vals;
$vals{width} = $self->SpinEdit2->value();
$vals{height} = $self->SpinEdit30->value();
my $CellState;
if ( $self->Radio1->checked() ) {
$CellState = 'All dead';
}
elsif ( $self->Radio2->checked() ) {
$CellState = 'All live';
}
elsif ( $self->Radio3->checked() ) {
$CellState = 'Random';
}
$vals{cell_state} = $CellState;
$vals{probability} = $self->SpinEdit3->value();
return \%vals;
}
package CustomRuleForm;
# Dialog to set birth/survival rules
use Prima;
use Prima::Classes;
use vars qw(@ISA);
@ISA = qw(Prima::Dialog);
use Prima::Buttons;
use Prima::Label;
sub profile_default
{
my $def = $_[0]-> SUPER::profile_default;
my %prf = (
name => 'Custom Rules',
origin => [766, 356],
originDontCare => 0,
size => [253, 396],
sizeDontCare => 0,
width => 253,
height => 396,
left => 766,
bottom => 356,
designScale => [8, 16],
);
@$def{keys %prf} = values %prf;
return $def;
}
sub init
{
my $self = shift;
my %instances = map {$_ => {}} qw();
my %profile = $self->SUPER::init(@_);
my %names = (q(Form1) => $self);
$self->lock;
# title row
$names{Title_Label_1} = $names{Form1}->insert( qq(Prima::Label) =>
name => 'Title_Label_1',
origin => [8, 364],
size => [79, 20],
text => 'Neighbours',
);
$names{Title_Label_2} = $names{Form1}->insert( qq(Prima::Label) =>
name => 'Title_Label_2',
origin => [108, 364],
size => [44, 20],
text => 'Birth',
);
$names{Title_Label_3} = $names{Form1}->insert( qq(Prima::Label) =>
name => 'Title_Label_3',
origin => [172, 364],
size => [60, 20],
text => 'Survival',
);
# rows
my $y_offset = 332;
foreach my $row (0..8) {
$names{'Label_Row' . $row} = $names{Form1}->insert( qq(Prima::Label) =>
name => 'Label_Row' . $row,
origin => [40, $y_offset-1],
size => [23, 20],
text => $row,
);
$names{'Birth_CheckBox_Row' . $row} = $names{Form1}->insert( qq(Prima::CheckBox) =>
name => 'Birth_CheckBox_Row' . $row,
origin => [116, $y_offset],
showHint => 1,
size => [30, 20],
text => '',
);
$names{'Survival_CheckBox_Row' . $row} = $names{Form1}->insert( qq(Prima::CheckBox) =>
name => 'Survival_CheckBox_Row' . $row,
origin => [192, $y_offset],
size => [32, 20],
text => '',
);
$y_offset -= 32;
}
# OK/Cancel buttons
$names{Button1} = $names{Form1}->insert( qq(Prima::Button) =>
name => 'Button1',
origin => [ 16, 14],
size => [ 96, 36],
text => '~OK',
modalResult => mb::OK,
);
$names{Button2} = $names{Form1}->insert( qq(Prima::Button) =>
name => 'Button2',
origin => [140, 14],
size => [96, 36],
my %b_rules;
if ( ref($birth) eq 'ARRAY' ) {
foreach my $num (@{$birth}) {
$b_rules{$num} = 1;
}
}
my %s_rules;
if ( ref($survival) eq 'ARRAY' ) {
foreach my $num (@{$survival}) {
$s_rules{$num} = 1;
}
}
foreach my $i (0..8) {
my $b_cbox = 'Birth_CheckBox_Row' . $i;
my $s_cbox = 'Survival_CheckBox_Row' . $i;
exists $b_rules{$i} ? $self->$b_cbox->checked(1) : $self->$b_cbox->checked(0);
exists $s_rules{$i} ? $self->$s_cbox->checked(1) : $self->$s_cbox->checked(0);
}
return;
}
sub get_rule_string {
my $self = shift;
my @birth;
my @survival;
foreach my $i (0..8) {
my $b_cbox = 'Birth_CheckBox_Row' . $i;
my $s_cbox = 'Survival_CheckBox_Row' . $i;
if ( $self->$b_cbox->checked() ) {
push @birth, $i;
}
if ( $self->$s_cbox->checked() ) {
push @survival, $i;
}
}
return (\@birth, \@survival);
}
package ZoomChangeForm;
# Dialog box for adjusting the zoom/scale (which can also be changed using the mousewheel)
use Prima;
use Prima::Classes;
use vars qw(@ISA);
@ISA = qw(Prima::Dialog);
use Prima::Buttons;
use Prima::Label;
use Prima::Sliders;
sub profile_default
{
my $def = $_[0]->SUPER::profile_default;
my %prf = (
name => 'Zoom',
origin => [778, 651],
originDontCare => 0,
size => [232, 129],
sizeDontCare => 0,
width => 232,
height => 129,
left => 778,
bottom => 651,
designScale => [8, 16],
);
@$def{keys %prf} = values %prf;
return $def;
}
sub init
{
my $self = shift;
my %profile = $self->SUPER::init(@_);
my %names = ( q(Form1) => $self);
$self->lock;
$names{Button1} = $names{Form1}->insert( qq(Prima::Button) =>
name => 'Button1',
origin => [12, 14],
size => [96, 36],
text => '~OK',
modalResult => mb::OK,
);
$names{Button2} = $names{Form1}->insert( qq(Prima::Button) =>
name => 'Button2',
origin => [120, 14],
size => [96, 36],
text => 'Cancel',
modalResult => mb::Cancel,
);
$names{Label1} = $names{Form1}->insert( qq(Prima::Label) =>
name => 'Label1',
origin => [12, 92],
size => [202, 20],
text => 'Zoom (pixels per cell)',
);
$names{SpinEdit1} = $names{Form1}->insert( qq(Prima::SpinEdit) =>
max => 50,
min => 1,
name => 'SpinEdit1',
origin => [12, 60],
size => [204, 24],
);
$self->unlock;
return %profile;
}
sub value {
my $self = shift;
my $val = shift;
if ( defined $val ) {
$self->SpinEdit1->value($val);
return;
}
else {
return $self->SpinEdit1->value();
}
}
package main;
use Prima qw(Application MsgBox Dialog::FileDialog Dialog::ColorDialog Cairo);
use Cairo;
use Game::Life::Faster;
use List::Util qw/max min/;
use File::Basename;
use Feature::Compat::Try;
my $filename = shift; # can specify an input file on the command line
my ($filebase, $dirs, $suffix);
my $initial_title = 'GoLP';
( run in 1.732 second using v1.01-cache-2.11-cpan-5837b0d9d2c )