Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Game of Life with GTK2

by kikuchiyo (Hermit)
on Jan 27, 2010 at 17:40 UTC ( [id://819984]=CUFP: print w/replies, xml ) Need Help??

Here I present two versions of a simple Game of Life simulator.

The first version uses Inline C for speed - the pure perl implementation is unusably slow.
#!/usr/bin/perl

# works now but terribly slow

use strict;
#use warnings;
use Gtk2 -init;
use Gtk2::Ex::Dialogs;
use Gtk2::Gdk::Keysyms;
use Glib ':constants';
#use Goo::Canvas;
use Data::Dumper;
use Time::HiRes qw( gettimeofday tv_interval  );

# straight out of the Gentoo handbook
use Inline C => Config => CCFLAGS => '-O3 -msse3 -mfpmath=sse -march=c
+ore2 -ffast-math';
use Inline C => 'DATA';


$|++;
##############################################
# setting up default sizes
# edit these
my $xbox = 400;
my $ybox = 400;
my $boxsize = 2;
my $timer = 0;
my $run = 0;
##############################################

my $fps = 0;
my $it = 0;
my $sx; my $sy;
my $t0 = [gettimeofday()];

my $screen = pack("W", 255) x (3*$xbox*$ybox*$boxsize**2);

print length $screen;
toggle(100,100);
toggle(101,100);
toggle(102,100);
toggle(102,101);
toggle(101,102);

#for my $y (0..$ybox-1) { for my $x (0..$xbox/2) {toggle($x*2, $y)}};
#toggle(52,71);

if (0) {
draw(54, 45,
"....*\n".
".****\n".
"****\n".
"*..*\n".
"****\n".
".****\n".
"....*\n");
draw(63, 46,
"*\n".
"*\n");
draw(44, 47,
"..*\n".
".*.*\n".
"*...**\n".
"*...**\n".
"*...**\n".
".*.*\n".
"..*\n");
draw(67, 48,
"**\n".
"**\n");
draw(33, 50,
"**\n".
"**\n");
}
if (0) {
draw(380, 380,
".....*.*\n".
"....*..*\n".
"...**\n".
"..*\n".
".****\n".
"*....*\n".
"*..*\n".
"*..*\n".
".*.........***...***\n".
"..****.*..*..*...*..*\n".
"...*...*.....*...*\n".
"....*........*...*\n".
"....*.*......*...*\n".
".\n".
"...***.....***...***\n".
"...**.......*.....*\n".
"...***......*******\n".
"...........*.......*\n".
"....*.*...***********\n".
"...*..*..*............**\n".
"...*.....************...*\n".
"...*...*.............*...*\n".
"....*...************.....*\n".
".....**............*..*..*\n".
"........***********...*.*\n".
".........*.......*\n".
"..........*******......***\n".
"..........*.....*.......**\n".
".........***...***.....***\n".
".\n".
"...........*...*......*.*\n".
"...........*...*........*\n".
"...........*...*.....*...*\n".
"........*..*...*..*..*.****\n".
".........***...***.........*\n".
".........................*..*\n".
".........................*..*\n".
".......................*....*\n".
"........................****\n".
"..........................*\n".
"........................**\n".
".....................*..*\n".
".....................*.*\n");
}
if (0) {
draw(380, 380, 
    "................*.................\n".
    "..............*.*.*...............\n".
    "............*.*.*.*.*.............\n".
    "..........*.*.*.*.*.*.*...........\n".
    "........*.*.*..**.*.*.*.*.........\n".
    "......*.*.*.*......*..*.*.*.......\n".
    "....*.*.*..*..........*.*.*.*.....\n".
    ".....**.*..............*..*.*.*...\n".
    "...*...*..................*.**....\n".
    "....***....................*...*..\n".
    "..*.........................***...\n".
    "...**...........................*.\n".
    ".*...*........................**..\n".
    "..****.......................*...*\n".
    "*.............................***.\n".
    ".***.............................*\n".
    "*...*.......................****..\n".
    "..**........................*...*.\n".
    ".*...........................**...\n".
    "...***.........................*..\n".
    "..*...*....................***....\n".
    "....**.*..................*...*...\n".
    "...*.*.*..*..............*.**.....\n".
    ".....*.*.*.*..........*..*.*.*....\n".
    ".......*.*.*..*......*.*.*.*......\n".
    ".........*.*.*.*.**..*.*.*........\n".
    "...........*.*.*.*.*.*.*..........\n".
    ".............*.*.*.*.*............\n".
    "...............*.*.*..............\n".
    ".................*................\n");
}

#for my $i (0..$xbox-1) { for my $j (0..$ybox-1) { toggle($i, $j) if (
+rand() > 0.5) }}

# Create the main window
my $win = new Gtk2::Window ( "toplevel" );
$win->signal_connect ("delete_event", sub { $run = 0; print "Average f
+ps = ", $fps/$it, "\n"; Gtk2->main_quit; });
#$win->signal_connect ("configure_event", \&win_expose);
$win->set_title( "Fucked up Game of Life demo" );
$win->set_border_width (6);
#$win->maximize;
$win->set_resizable (0);
$win->resize(700, 500);

my $vbox = Gtk2::VBox->new (0, 6);
$win->add ($vbox);

# The DrawingArea that holds the pixbuf that holds the image
my $da = Gtk2::DrawingArea->new;
$da->set_size_request($xbox*$boxsize, $ybox*$boxsize);
$vbox->pack_start($da, 1, 1, 0);  
$da->signal_connect('motion_notify_event' => \&on_background_motion_no
+tify);
$da->signal_connect('button_press_event' => \&on_background_motion_not
+ify);
$da->signal_connect('key_press_event' => \&on_key_press);
$da->can_focus(TRUE);
$da->set_events ([ @{ $da->get_events },
                         'leave-notify-mask',
                         'pointer-motion-mask',
                         'pointer-motion-hint-mask',
                         'button-press-mask',
                         'key-press-mask', ]);
#print $da->get_events ;
$win->show_all;
my $gc1 = Gtk2::Gdk::GC->new ($da->window); 

my $id = Glib::Timeout->add ($timer, \&timeout_handler);

main Gtk2;

########################################################

sub timeout_handler {
    update() if $run;
    return 1;  # return 0 or 1 to kill/keep timer going
}

sub on_key_press {
    my ( $canvas, $event ) = @_;
    my $oldtimer = $timer;
    
    $run = !$run if $event->keyval == $Gtk2::Gdk::Keysyms{Return};
    update(1) if $event->keyval == $Gtk2::Gdk::Keysyms{space};
    $timer = int(1.1*$timer) > $timer+1 ? int(1.1*$timer) : $timer+1 i
+f $event->keyval == $Gtk2::Gdk::Keysyms{KP_Subtract};
    $timer = int(0.9*$timer) if $event->keyval == $Gtk2::Gdk::Keysyms{
+KP_Add} and $timer > 0;
    if ($oldtimer != $timer) {
        Glib::Source->remove($id);
        $id = Glib::Timeout->add ($timer, \&timeout_handler);
    }

    return TRUE;
}

# replotting on mouse movement
sub on_background_motion_notify {
    my ($da, $event) = @_;

    my (undef, $ex, $ey, $state) = $event->window->get_pointer; 
    
    my $y = int(($ey)/$boxsize); #///
    my $x = int(($ex)/$boxsize);
    return TRUE if ($x < 0 or $x >= $xbox or $y < 0 or $y >= $ybox);
    #print "$x\t$y\n";
    #print Dumper $event;
    my $type = $event->type;
    if ($type eq 'motion-notify') {
        if ( $state >= 'button1-mask' ) {
            toggle($x, $y) unless $sx == $x and $sy == $y;
            update();
            $sx = $x;
            $sy = $y;
        }        
    } else {
        $sx = $x;
        $sy = $y;
        toggle($x, $y);
        update();
        print " $x\t$y\n";
    }
#    if ( $state >= 'button1-mask' ) {
#        toggle($x, $y) ;#unless $event->type eq 'motion-notify';
#        update();
#    }

    return TRUE;
}

sub update {
    my $doit = shift;
    $screen = calculate_c($screen, $xbox, $ybox, $boxsize) if $run or 
+$doit;
    #print length $screen;
    #print STDERR $screen;
    
    my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data (
        $screen, 'rgb', FALSE, 8, 
        $xbox*$boxsize, 
        $ybox*$boxsize, 
        3*$xbox*$boxsize
    );

    #my $gc1 = Gtk2::Gdk::GC->new ($da->window); 
    $da->window->draw_pixbuf($gc1, $pixbuf,  0, 0, 
        0, 0, $xbox*$boxsize, 
        $ybox*$boxsize, 

        'none', 0, 0,
    );
    
    my $tt = 1/tv_interval($t0);
    $fps += $tt;
    $it++;
    print "$tt fps\r";
    $t0 = [gettimeofday()];

    return TRUE;
}

sub calculate {
    my $oldscreen = shift;
    
    my $sum;
    my $v;
    my $wh = pack "W", 255;
    my $bl = pack "W", 0;
    my $new;
    my $pos;
    my $newscreen = '';
    my $row = '';
    my ($left, $right, $top, $bot);
    
    foreach my $y (0..$ybox-1) {
        if ($y == 0) {
            $top = ($ybox-1)*3*$boxsize**2*$xbox;
            $bot = 3*$boxsize**2*$xbox;
        } elsif ($y == $ybox-1) {
            $top = -3*$boxsize**2*$xbox;
            $bot = (-$ybox)*3*$boxsize**2*$xbox;
        } else {
            $top = -3*$boxsize**2*$xbox;
            $bot = 3*$boxsize**2*$xbox;
        }

        foreach my $x (0..$xbox-1) {
            if ($x == 0) {
                $left = ($xbox-1)*3*$boxsize;
                $right = 3*$boxsize;
            } elsif ($x == $xbox-1) {
                $left = -3*$boxsize;
                $right = (0-$xbox)*3*$boxsize;
            } else {
                $left = -3*$boxsize;
                $right = 3*$boxsize;
            }
            $pos = $y*$xbox*$boxsize**2*3+$x*$boxsize*3;
            $v = unpack "W", substr $oldscreen, $pos, 1;
            $sum = unpack "W", substr $oldscreen, $pos+$top+$left, 1;
            $sum += unpack "W", substr $oldscreen, $pos+$top, 1;
            $sum += unpack "W", substr $oldscreen, $pos+$top+$right, 1
+;
            $sum += unpack "W", substr $oldscreen, $pos+$left, 1;
            $sum += unpack "W", substr $oldscreen, $pos+$right, 1;
            $sum += unpack "W", substr $oldscreen, $pos+$bot+$left, 1;
            $sum += unpack "W", substr $oldscreen, $pos+$bot, 1;
            $sum += unpack "W", substr $oldscreen, $pos+$bot+$right, 1
+;
            $sum /= 255;
            print "$x\t$y\t$v\t$sum\n" if $sum < 8;
            unless ($v) {
                if ($sum == 5 or $sum == 6) {
                    $new = $bl;
                } else {
                    $new = $wh;
                }
            } else {
                if ($sum == 5) {
                    $new = $bl;
                } else {
                    $new = $wh;
                }            
            }
            
            $row .= $new x ($boxsize*3);
        }
        $newscreen .= $row x $boxsize;
        $row = '';
    }
    
    return $newscreen;
}

sub draw {
    my $x = shift;
    my $y = shift;
    my $s = shift;
    
    my @lines = split /\n/, $s;
    foreach my $i (0..$#lines) {
        my @line = split //, $lines[$i];
        #print "@line";
        foreach my $j (0..$#line) {
            toggle($x+$j, $y+$i) if $line[$j] eq '*';
        }
    }
}

sub toggle {
    my $x = shift;
    my $y = shift;
    
    my $pos = $y*$xbox*$boxsize**2*3+$x*$boxsize*3;
    my $v = substr $screen, $pos, $boxsize*3;
    for my $i (0..$boxsize-1) {
        substr $screen, $pos+$xbox*$i*$boxsize*3, $boxsize*3, ~$v;
    }
}

__DATA__
__C__
SV* calculate_c (unsigned char* str, int xbox, int ybox, int boxsize) 
+{
    int sum;
    unsigned char v;
    unsigned char wh[3] = { 0xff, 0xff, 0xff };
    unsigned char bl[3] = { 0x00, 0x00, 0x00 };
    unsigned char new;
    int pos, x, y, i, j;
    int left, right, top, bot;
    int bs3 = 3*boxsize;
    //int newscreen = '';
    //int row = '';
    int len = xbox*ybox*bs3*boxsize;
    SV* newscreen = newSV(len);
    //char* newstr = SvPV(newscreen, len);
    
    SV* whsv = newSV(bs3);
    SV* blsv = newSV(bs3);
    for (j = 0; j < boxsize; j++) {
        sv_insert(whsv, 3*j, 3, wh, 3);
        sv_insert(blsv, 3*j, 3, bl, 3);
    }    
    char* whstr = SvPV(whsv, bs3);
    char* blstr = SvPV(blsv, bs3); 
    
    pos = 0; i = 0;
    for (y = 0; y < ybox; y++) {
        if (y == 0) {
            top = (ybox-1)*bs3*boxsize*xbox;
            bot = bs3*boxsize*xbox;
        } else if (y == ybox-1) {
            top = -bs3*boxsize*xbox;
            bot = (1-ybox)*bs3*boxsize*xbox;
        } else {
            top = -bs3*boxsize*xbox;
            bot = bs3*boxsize*xbox;
        }
        
        for (x = 0; x < xbox; x++) {
            if (x == 0) {
                left = (xbox-1)*bs3;
                right = bs3;
            } else if (x < xbox-1) {
                left = -bs3;
                right = bs3;
            } else {
                left = -bs3;
                right = (1-xbox)*bs3;
            }
            //pos = bs3*(y*xbox*boxsize+x); //pos += boxsize*3;
            //pos += bs3;
            //printf("%d\t%d\t%d\t%d\n", x, y, pos, pos+bot);
            v = str[pos];
            sum = (int) str[pos+top+left];
            sum += (int) str[pos+top];
            sum += (int) str[pos+top+right];
            sum += (int) str[pos+left];
            sum += (int) str[pos+right];
            sum += (int) str[pos+bot+left];
            sum += (int) str[pos+bot];
            sum += (int) str[pos+bot+right];
            //sum /= 255;

            //if (sum < 8) printf("%d\t%d\t%d\t%d\n", x, y, v, sum);
            
            if (boxsize == 1) { 
                if (sum == 5*255 || (sum == 6*255 && v == 0)) {
                    sv_insert(newscreen, pos, 3, bl, 3);
                } else {
                    sv_insert(newscreen, pos, 3, wh, 3);
                }
            } else {
                if (sum == 5*255 || (sum == 6*255 && v == 0)) {
                    //for (i = 0; i < boxsize; i++) {
                        for (j = 0; j < boxsize; j++) {
                            sv_insert(newscreen, pos+3*i+bs3*xbox*j, b
+s3, blstr, bs3);
                        }
                    //}
                } else {
                    //for (i = 0; i < boxsize; i++) {
                        for (j = 0; j < boxsize; j++) {
                            sv_insert(newscreen, pos+3*i+bs3*xbox*j, b
+s3, whstr, bs3);
                        }
                    //}
                }                
            }
            pos += bs3;
        }
        pos += xbox*bs3*(boxsize-1);
    }
    sv_2mortal(whsv);
    sv_2mortal(blsv);
    return newscreen;
}

[download]

A few interesting Life objects are defined but commented out in this version.


The second version features a somewhat improved algorithm that stores and processes the live cells only - this is pure perl, partly because it's not too slow if there are few live cells, partly because I didn't figure out how to mongle hash refs in Inline C yet.
#!/usr/bin/perl

use strict;
#use warnings;
use Gtk2 -init;
use Gtk2::Ex::Dialogs;
use Gtk2::Gdk::Keysyms;
use Glib ':constants';
#use Goo::Canvas;
use Data::Dumper;
use Time::HiRes qw( gettimeofday tv_interval  );

$|++;

###########################
# setting up default values
# edit these
my $xbox = 400;
my $ybox = 400;
my $boxsize = 2;
my $timer = 0;
my $run = 0;
my @birth_rules = (0,0,0,1,0,0,0,0,0);
my @survival_rules = (0,0,1,1,0,0,0,0,0);

###########################

my $sx; my $sy;
my $t0 = [gettimeofday()];
my $fps = 0; my $it = 0;
my $wh = pack("W", 255) x (3*$boxsize);
my $bl = pack("W", 0) x (3*$boxsize);

my $screen = pack("W", 255) x (3*$xbox*$ybox*$boxsize**2);
my %pixels;
my %neighbors;

#print length $screen;
toggle(100,100);
toggle(101,100);
toggle(102,100);
toggle(102,101);
toggle(101,102);

#for my $y (0..$ybox-1) { for my $x (0..$xbox/5-1) {toggle(5*$x+1+$y%2
+, $y)}};
#for my $y (0..$ybox-1) {toggle(50, $y)}
#my $start = 60;
#for my $y ($start..$start+8) { for my $x (50..50+$y) {toggle($x+$y*34
+-$start*34-20, $y*40-$start*40+50)}};


#toggle(50,50);

# Create the main window
my $win = new Gtk2::Window ( "toplevel" );
$win->signal_connect ("delete_event", sub { $run = 0; print "Average f
+ps = ", $fps/$it, "\n"; Gtk2->main_quit; });
#$win->signal_connect ("configure_event", \&win_expose);
$win->set_title( "Fucked up Game of Life demo" );
$win->set_border_width (6);
#$win->maximize;
$win->set_resizable (0);
$win->resize(700, 500);

my $vbox = Gtk2::VBox->new (0, 6);
$win->add ($vbox);

# The DrawingArea that holds the pixbuf that holds the image
my $da = Gtk2::DrawingArea->new;
$da->set_size_request($xbox*$boxsize, $ybox*$boxsize);
$vbox->pack_start($da, 1, 1, 0);  
$da->signal_connect('motion_notify_event' => \&on_background_motion_no
+tify);
$da->signal_connect('button_press_event' => \&on_background_motion_not
+ify);
$da->signal_connect('key_press_event' => \&on_key_press);
$da->can_focus(TRUE);
$da->set_events ([ @{ $da->get_events },
                         'leave-notify-mask',
                         'pointer-motion-mask',
                         'pointer-motion-hint-mask',
                         'button-press-mask',
                         'key-press-mask', ]);
#print $da->get_events ;
$win->show_all;
my $gc1 = Gtk2::Gdk::GC->new ($da->window); 

my $id = Glib::Timeout->add ($timer, \&timeout_handler);

main Gtk2;

##############################################

sub timeout_handler {
    update() if $run;
    return 1;  # return 0 or 1 to kill/keep timer going
}


# Return: run/stop
# space: single step
# Keypad +/- : increase/decrease speed
sub on_key_press {
    my ( $canvas, $event ) = @_;
    my $oldtimer = $timer;
    
    $run = !$run if $event->keyval == $Gtk2::Gdk::Keysyms{Return};
    update(1) if $event->keyval == $Gtk2::Gdk::Keysyms{space};
    $timer = int(1.1*$timer) > $timer+1 ? int(1.1*$timer) : $timer+1 i
+f $event->keyval == $Gtk2::Gdk::Keysyms{KP_Subtract};
    $timer = int(0.9*$timer) if $event->keyval == $Gtk2::Gdk::Keysyms{
+KP_Add} and $timer > 0;
    if ($oldtimer != $timer) {
        Glib::Source->remove($id);
        $id = Glib::Timeout->add ($timer, \&timeout_handler);
    }

    return TRUE;
}

# click to toggle pixels
sub on_background_motion_notify {
    my ($da, $event) = @_;

    my (undef, $ex, $ey, $state) = $event->window->get_pointer; 
    
    my $y = int(($ey)/$boxsize); #///
    my $x = int(($ex)/$boxsize);
    return TRUE if ($x < 0 or $x >= $xbox or $y < 0 or $y >= $ybox);
    #print "$x\t$y\n";
    #print Dumper $event;
    my $type = $event->type;
    if ($type eq 'motion-notify') {
        if ( $state >= 'button1-mask' ) {
            toggle($x, $y) unless $sx == $x and $sy == $y;
            update();
            $sx = $x;
            $sy = $y;
        }        
    } else {
        $sx = $x;
        $sy = $y;
        toggle($x, $y);
        update();
        print " $x\t$y\n";
    }
#    if ( $state >= 'button1-mask' ) {
#        toggle($x, $y) ;#unless $event->type eq 'motion-notify';
#        update();
#    }

    return TRUE;
}

sub update {
    my $doit = shift;
    #$screen = calculate_c($screen, $xbox, $ybox, $boxsize) if $run or
+ $doit;
    if ($run or $doit) {
        calculate();
        makescreen();
        if ($it % 16) {
            my @y = keys %pixels;
            foreach my $y (@y) {
                delete $pixels{$y} unless scalar keys %{ $pixels{$y} }
+;
            }
        }
    }
    #print length $screen,"\n";
    #print STDERR $screen;
    #print "\n";
    
    my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data (
        $screen, 'rgb', FALSE, 8, 
        $xbox*$boxsize, 
        $ybox*$boxsize, 
        3*$xbox*$boxsize
    );

    #my $gc1 = Gtk2::Gdk::GC->new ($da->window); 
    $da->window->draw_pixbuf($gc1, $pixbuf,  0, 0, 
        0, 0, $xbox*$boxsize, 
        $ybox*$boxsize, 

        'none', 0, 0,
    );

    my $tt = 1/tv_interval($t0);
    $fps += $tt;
    $it++;
    print "$tt fps\r";
    $t0 = [gettimeofday()];

    return TRUE;
}

sub calculate {
    my ($left, $right, $top, $bot);

    %neighbors = ();
    foreach my $y (keys %pixels) {
        $top = ($y==0) ? $ybox-1 : -1;
        $bot = ($y==$ybox-1) ? 1-$ybox : 1;
        
        foreach my $x (keys %{ $pixels{$y} }) {
            $left = ($x==0) ? $xbox-1 : -1;
            $right = ($x==$xbox-1) ? 1-$xbox : 1;
            
            $neighbors{$y+$top}{$x+$left  }++;
            $neighbors{$y     }{$x+$left  }++;
            $neighbors{$y+$bot}{$x+$left  }++;
            $neighbors{$y+$top}{$x        }++;
            $neighbors{$y+$bot}{$x        }++;
            $neighbors{$y+$top}{$x+$right }++;
            $neighbors{$y     }{$x+$right }++;
            $neighbors{$y+$bot}{$x+$right }++;
            $neighbors{$y     }{$x        } += 0;            
        }
    }
    
    #my %xhash; my %yhash;
    #foreach my $x (keys %neighbors, keys %pixels) { $xhash{$x}++ }
    #foreach my $x (keys %xhash) {
    foreach my $y (keys %neighbors) {
        #%yhash = ();
        #foreach my $y (keys %{ $neighbors{$x} }, keys %{ $pixels{$x} 
+}) { $yhash{$x}++ }
        #foreach my $y (keys %yhash) {
        foreach my $x (keys %{ $neighbors{$y} }) {
        #print "N$x\t$y\t$neighbors{$y}{$x}\n";
            if ($pixels{$y}{$x}) {
                delete $pixels{$y}{$x} unless $survival_rules[ $neighb
+ors{$y}{$x} ]; 
            } else {
                $pixels{$y}{$x} = 1 if $birth_rules[ $neighbors{$y}{$x
+} ]; 
            }
            #print "N$x\t$y\t$neighbors{$y}{$x}\t$pixels{$y}{$x}\n";
        }
    }    
}

sub makescreen {
    #my $row;
    my @xs = 0..$xbox-1;
    
    #foreach my $x (sort {$a <=> $b} keys %pixels) {
    #    %{ $pixels{$x} }
    #}
    $screen = '';
    foreach my $y (0..$ybox-1) {

        #foreach my $x (0..$xbox-1) {
            #print "P$x\t$y\t$pixels{$y}{$x}\n" if exists $pixels{$y}{
+$x};
            #$row .= (exists $pixels{$y}{$x} ? $bl : $wh );
        #}
        if (exists $pixels{$y}) {
            #$row = join '', map { exists $pixels{$y}{$_} ? $bl : $wh 
+} (0..$xbox-1);
            $screen .= ( join '', map { exists $pixels{$y}{$_} ? $bl :
+ $wh } @xs ) x $boxsize;
        } else {
            #$row = $wh x $xbox;
            $screen .= $wh x ($xbox*$boxsize); 
        }
        #$screen .= $row x $boxsize;
        #$row = '';
    }
}

sub toggle {
    my $x = shift;
    my $y = shift;
    
    my $pos = $y*$xbox*$boxsize**2*3+$x*$boxsize*3;
    my $v = substr $screen, $pos, $boxsize*3;
    for my $i (0..$boxsize-1) {
        substr $screen, $pos+$xbox*$i*$boxsize*3, $boxsize*3, ~$v;
    }
    if ($pixels{$y}{$x}) {
        delete $pixels{$y}{$x};
    } else {
        $pixels{$y}{$x} = 1;
    } 
}

[download]

The user interface is simple: clicks within the drawing area toggle cells; Return starts/stops continuous iteration; Space does a single iteration; Keypad +/- changes speed.

The current fps is vomited into the standard output while the iterations are running; the average fps is printed before the program exits.

The first version may be used as a benchmark of sorts, as its speed is (in first approximation) independent of the displayed content. On my machine it does 23-24 fps with the posted settings ($xbox = $ybox = 400; $boxsize = 2).

Both versions are probably groan-inducingly horrible - comments and suggestions for improvements are welcome.

Replies are listed 'Best First'.
Re: Game of Life with GTK2
by zentara (Cardinal) on Jan 28, 2010 at 14:28 UTC
    I get Invalid type 'W' in pack at ./819984.pl line 36. in both programs.

    Otherwise it looks like a nice program.

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku
[reply]
      It seems that "W" is a 5.10 addition to pack and you are using 5.8.x.

      Replace all those W's with C's - it should work that way.
[reply]
[d/l]

Back to Cool Uses for Perl

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: CUFP [id://819984]
Approved by hossman
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others admiring the Monastery: (2)
As of 2025-07-09 22:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found
    Notices?
    • erzuuli‥ Anonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.