App-GUI-GoLP

 view release on metacpan or  search on metacpan

bin/golp  view on Meta::CPAN


                                    $window->repaint();
                                }
                                else {
                                    message('ERROR: Could not load ' . $open->fileName);
                                }                                
                            }
                        }],
                        ['Save' => sub {
                            my ( $window, $menu ) = @_;
                            
                            my $save_file = ($filebase // '') . ($suffix // '');
                            my $save = Prima::Dialog::SaveDialog-> new(
                                fileName => $save_file,
                                defaultExt => '.rle',
                                filter => [
                                            ['Run-length encoded (.rle)' => '*.rle'],
                                            ['Plaintext (.cells)' => '*.cells'],
                                    ]
                            );
                            
                            if ( $save->execute ) {
                                
                                if ( save_game($save->fileName) ) {
                                    ($filebase, $dirs, $suffix) = fileparse($save->fileName, '.rle', '.cells');                                    
                                    $window->text("GoLP | " . $filebase . $suffix);
                                }
                                else {
                                    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); 
                            }
                         }],
                    ]],
                    [],

bin/golp  view on Meta::CPAN

    my $p_h = $board_height * $scale;

    if ( ($vp_x_offset + $vp_w) >= $p_w ) {
        $vp_x_offset = $p_w - $vp_w;
    }

    if ( ($vp_y_offset + $vp_h) >= $p_h ) {
        $vp_y_offset = $p_h - $vp_h;
    }

    $vp_x_offset = 0 if $vp_x_offset < 0;
    $vp_y_offset = 0 if $vp_y_offset < 0;

    return 1;
}

sub drag_viewport {
    my ($v, $vp) = @_;

    my $v_x = $v->[0];
    my $v_y = $v->[1];
    my $vp_w = $vp->[0];
    my $vp_h = $vp->[1];

    my $p_w = $board_width * $scale;
    my $p_h = $board_height * $scale;

    if ( $p_w > $vp_w ) {

        my $new_x_offset = $vp_x_offset - $v_x;

        if ( ($new_x_offset >= 0) && ($new_x_offset < ($p_w - $vp_w)) ) {
            $vp_x_offset = $new_x_offset;
        }
    }

    if ( $p_h > $vp_h ) {
    
        my $new_y_offset = $vp_y_offset + $v_y;

        if ( ($new_y_offset >= 0) && ($new_y_offset < ($p_h - $vp_h)) ) {
            $vp_y_offset = $new_y_offset;
        }
    }

    return;
}

sub to_window {
    my ($cr, $vp_w, $vp_h, $data, $cur_pos) = @_;

    my $b_w = $board_width; 
    my $b_h = $board_height; 

    my $p_w = $b_w * $scale;
    my $p_h = $b_h * $scale;

    return render($cr, $data, $b_w, $b_h, $p_w, $p_h, $vp_w, $vp_h, $vp_x_offset, $vp_y_offset);
}

sub to_png {
    my ($data) = @_;

    my $b_w = $board_width; 
    my $b_h = $board_height; 

    my $p_w = $b_w * $scale;
    my $p_h = $b_h * $scale;

    my $surface = Cairo::ImageSurface->create('argb32', $p_w, $p_h);
    my $cr = Cairo::Context->create($surface);

    my $live_cells = render($cr, $data, $b_w, $b_h, $p_w, $p_h, $p_w, $p_h, 0, 0);

    my $filename = "snapshot:" . $filebase . ";ticks:" . $ticks . ";livecells:" . $live_cells . ".png";

    $cr->show_page;
    $surface->write_to_png($filename);

    return $filename;
}

# draw the board
sub render {
    my ($cr, $data, $b_w, $b_h, $p_w, $p_h, $vp_w, $vp_h, $vp_x_o, $vp_y_o) = @_;

    $cr->rectangle (0, 0, $vp_w, $vp_h);
    $cr->set_source_rgb (0.1, 0.1, 0.1);
    $cr->fill;

    return 0 unless defined $data;

    my $p_start_x;
    my $p_start_y;

    if ( $p_w > $vp_w ) {
        $p_start_x = -$vp_x_o;
    }
    elsif ( $p_w < $vp_w ) {
        $p_start_x = int($vp_w/2) - int($p_w/2);
    }
    else {
        $p_start_x = 0;
    }

    if ( $p_h > $vp_h ) {
        $p_start_y = -$vp_y_o;
    }
    elsif( $p_h < $vp_h ) {
        $p_start_y = int($vp_h/2) - int($p_h/2);
    }
    else {
        $p_start_y = 0;
    }

    my $p_end_x = $p_start_x + $p_w;
    my $p_end_y = $p_start_y + $p_h;

    # fill board to black
    $cr->rectangle(max($p_start_x, 0), max($p_start_y, 0), min($vp_w, $p_w), min($vp_h, $p_h));
    $cr->set_source_rgb($dead_r, $dead_g, $dead_b);
    $cr->fill;
    
    if ( $grid && ($scale > 3) ) {

        $cr->set_source_rgb ($grid_r, $grid_g, $grid_b);

        # draw grid
        # horizontal
        foreach my $i (0..$b_h-1) {
    
            my $y = $p_start_y+($scale * $i);

            if ( ($y > 0) && ($y < $vp_h) ) {
                $cr->rectangle(max($p_start_x, 0), $y, min($p_w, $vp_w), 1);
                $cr->fill;
            }           
        }



( run in 1.271 second using v1.01-cache-2.11-cpan-df04353d9ac )