App-GUI-GoLP
view release on metacpan or search on metacpan
$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';
my $initial_win_size = [800, 600];
my ($board_width, $board_height);
my ($birth, $survival);
my $game;
my $game_ready = 0;
my $tick_delay_ms = 250;
my $edit_mode = 0;
my $play = 0;
my $grid = 1;
my $autogrow = 1;
my $ticks = 0;
my $status = 1;
my $colordialog;
# From https://conwaylife.com/wiki/List_of_Life-like_rules
my %rule_name_to_BS = (
"Conway's Life" => 'B3/S23',
"Seeds" => 'B2/S',
"Live Free or Die" => 'B2/S0',
"Flock" => 'B3/S12',
"LowLife" => 'B3/S13',
"Long Life" => 'B345/S5',
"Amoeba" => 'B357/S1358',
"Geology" => 'B3578/S24678',
"HighLife" => 'B36/S23',
"Day and Night" => 'B3678/S34678',
"Pedestrian Life" => 'B38/S23',
"HoneyLife" => 'B38/S238',
"Maze" => 'B3/S12345',
"Mazectric" => 'B3/S1234',
"Star Trek" => 'B3/S0248',
"Life without death" => 'B3/S012345678',
"Persian rug" => 'B234/S',
"Coral" => 'B3/S45678',
"Stains" => 'B3678/S235678',
"Morley" => 'B368/S245',
"Bacteria" => 'B34/S456',
"Assimilation" => 'B345/S4567',
"Gnarl" => 'B1/S1',
"Snakeskin" => 'B1/S134567',
"Replicator" => 'B1357/S1357',
);
my %rule_BS_to_name;
while ( my ($k, $v) = each %rule_name_to_BS ) {
$rule_BS_to_name{$v} = $k;
}
my $livecolor = hex('ffffff');
my ($live_r, $live_g, $live_b) = (1, 1, 1);
my $deadcolor = 0;
my ($dead_r, $dead_g, $dead_b) = (0, 0, 0);
my $gridcolor = hex('4d4d4d');
my ($grid_r, $grid_g, $grid_b) = (0.3, 0.3, 0.3);
my $scale = 4; # pixels per cell dimension
my $vp_x_offset = 0;
my $vp_y_offset = 0;
my $board_pos;
if ( defined $filename ) {
if ( load_game($filename) ) {
($filebase, $dirs, $suffix) = fileparse($filename, '.rle', '.cells');
$initial_title = "GoLP | " . $filebase . $suffix;
}
else {
warn("Could not load up: $filename");
}
}
# create the main window with all the different menu options and interactions.
my $w = Prima::MainWindow->new(
layered => 1,
buffered => 1,
text => $initial_title,
size => $initial_win_size,
menuItems => [
[ '~File' => [
['~New', 'Ctrl+N', '^N', sub {
my ( $window, $menu ) = @_;
message('ERROR: Could not save ' . $save->fileName);
}
}
}],
[],
['~Exit', 'Ctrl+X', '^X', sub { shift-> close } ],
]],
[ '~Options' => [
[ 'play' => '~Play/Pause' => 'Space' => kb::Space => sub {
my ( $window, $menu ) = @_;
unless ( $edit_mode ) {
# prevent accidental unpausing if editing
$play = $window->menu->toggle($menu);
$play ? $window->Timer->start() : $window->Timer->stop();
}
} ],
['*Grid' => '~Grid' => sub {
my ( $window, $menu ) = @_;
$grid = $window->menu->toggle($menu);
$window->repaint();
} ],
['*Grow' => '~Autogrow' => sub {
my ( $window, $menu ) = @_;
$autogrow = $window->menu->toggle($menu);
} ],
['*Status' => 'S~tatus line' => sub {
my ( $window, $menu ) = @_;
$status = $window->menu->toggle($menu);
$window->repaint();
} ],
[ '~Snapshot board' => 'F5' => kb::F5 => sub {
my $snapname = to_png($game->get_grid());
if ( -e $snapname ) {
message("Snapshot written to $snapname");
}
else {
message("ERROR - snapshot not created");
}
} ],
[ 'L~oop delay' => [
[ '(s_zero' => '0 ms' => sub { $_[0]->Timer->timeout(0); } ],
[ 'ms_25' => '25 ms' => sub { $_[0]->Timer->timeout(25); } ],
[ 'ms_50' => '50 ms' => sub { $_[0]->Timer->timeout(50); } ],
[ 'ms_100' => '100 ms' => sub { $_[0]->Timer->timeout(100); } ],
[ '*ms_250' => '250 ms' => sub { $_[0]->Timer->timeout(250); } ],
[ 'ms_500' => '500 ms' => sub { $_[0]->Timer->timeout(500); } ],
[ 'one_s' => '1 s' => sub { $_[0]->Timer->timeout(1000); } ],
[ 'ms_2500' => '2.5 s' => sub { $_[0]->Timer->timeout(2500); } ],
[ 'five_s' => '5 s' => sub { $_[0]->Timer->timeout(5000); } ],
[ 'ten_s)' => '10 s' => sub { $_[0]->Timer->timeout(10000); } ],
]],
[ '~Rules' => [
[ '*(B3/S23' => "Conway's Life (B3/S23)" => sub { handle_rule($_[0], 'B3/S23'); } ],
[ 'B357/S1358' => "Amoeba (B357/S1358)" => sub { handle_rule($_[0], 'B357/S1358'); } ],
[ 'B345/S4567' => "Assimilation (B345/S4567)" => sub { handle_rule($_[0], 'B345/S4567'); } ],
[ 'B34/S456' => "Bacteria (B34/S456)" => sub { handle_rule($_[0], 'B34/S456'); } ],
[ 'B3/S45678' => "Coral (B3/S45678)" => sub { handle_rule($_[0], 'B3/S45678'); } ],
[ 'B3678/S34678' => "Day and Night (B3678/S34678)" => sub { handle_rule($_[0], 'B3678/S34678'); } ],
[ 'B3/S12' => "Flock (B3/S12)" => sub { handle_rule($_[0], 'B3/S12'); } ],
[ 'B3578/S24678' => "Geology (B3578/S24678)" => sub { handle_rule($_[0], 'B3578/S24678'); } ],
[ 'B1/S1' => "Gnarl (B1/S1)" => sub { handle_rule($_[0], 'B1/S1'); } ],
[ 'B36/S23' => "HighLife (B36/S23)" => sub { handle_rule($_[0], 'B36/S23'); } ],
[ 'B38/S238' => "HoneyLife (B38/S238)" => sub { handle_rule($_[0], 'B38/S238'); } ],
[ 'B3/S012345678' => "Life without death (B3/S012345678)" => sub { handle_rule($_[0], 'B3/S012345678'); } ],
[ 'B2/S0' => "Live Free or Die (B2/S0)" => sub { handle_rule($_[0], 'B2/S0'); } ],
[ 'B345/S5' => "Long Life (B345/S5)" => sub { handle_rule($_[0], 'B345/S5'); } ],
[ 'B3/S13' => "LowLife (B3/S13)" => sub { handle_rule($_[0], 'B3/S13'); } ],
[ 'B3/S12345' => "Maze (B3/S12345)" => sub { handle_rule($_[0], 'B3/S12345'); } ],
[ 'B3/S1234' => "Mazectric (B3/S1234)" => sub { handle_rule($_[0], 'B3/S1234'); } ],
[ 'B368/S245' => "Morley (B368/S245)" => sub { handle_rule($_[0], 'B368/S245'); } ],
[ 'B38/S23' => "Pedestrian Life (B38/S23)" => sub { handle_rule($_[0], 'B38/S23'); } ],
[ 'B234/S' => "Persian rug (B234/S)" => sub { handle_rule($_[0], 'B234/S'); } ],
[ 'B1357/S1357' => "Replicator (B1357/S1357)" => sub { handle_rule($_[0], 'B1357/S1357'); } ],
[ 'B2/S' => "Seeds (B2/S)" => sub { handle_rule($_[0], 'B2/S'); } ],
[ 'B1/S134567' => "Snakeskin (B1/S134567)" => sub { handle_rule($_[0], 'B1/S134567'); } ],
[ 'B3678/S235678' => "Stains (B3678/S235678)" => sub { handle_rule($_[0], 'B3678/S235678'); } ],
[ 'B3/S0248' => "Star Trek (B3/S0248)" => sub { handle_rule($_[0], 'B3/S0248'); } ],
[ 'custom)' => "Custom rule..." => sub {
my ( $window ) = @_;
my $rule_changer = CustomRuleForm->new();
$rule_changer->set_rules($birth, $survival);
if ( $rule_changer->execute() != mb::Cancel ) {
my ($new_b, $new_s) = $rule_changer->get_rule_string();
my $str = to_bs_string($new_b, $new_s);
if ( exists $rule_BS_to_name{$str} ) {
$window->menu->check($str);
}
handle_rule($window, $str);
}
}],
]],
[],
['change_zoom' => '~Zoom...' => sub {
my ( $window ) = @_;
my $zoom_changer = ZoomChangeForm->new();
$zoom_changer->value($scale);
if ( $zoom_changer->execute() != mb::Cancel ) {
$scale = $zoom_changer->value();
$window->repaint();
}
} ],
[],
['live_color' => '~Live cell color...' => sub {
handle_color($_[0], \$livecolor, \$live_r, \$live_g, \$live_b);
} ],
['dead_color' => '~Dead cell color...' => sub {
handle_color($_[0], \$deadcolor, \$dead_r, \$dead_g, \$dead_b);
} ],
['grid_color' => 'Gr~id color...' => sub {
handle_color($_[0], \$gridcolor, \$grid_r, \$grid_g, \$grid_b);
} ],
[],
[ 'edit' => '~Edit mode' => 'F1' => kb::F1 => sub {
my ( $window, $menu ) = @_;
$edit_mode = $window->menu->toggle($menu);
if ( $edit_mode ) {
# edit paused
$window->menu->uncheck('play');
$window->Timer->stop();
$play = 0;
( run in 1.517 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )