http://www.perlmonks.org?node_id=819984

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; }

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; } }

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.