Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Game of Life with GTK2

by kikuchiyo (Monk)
on Jan 27, 2010 at 17:40 UTC ( #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; }

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.

Comment on Game of Life with GTK2
Select or Download Code
Re: Game of Life with GTK2
by zentara (Archbishop) 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
      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.

Log In?
Username:
Password:

What's my password?
Create A New User
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? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (9)
As of 2014-07-31 23:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (255 votes), past polls