Qef's Website

I used to play with OpenGL at university, but I've just discovered that there's a Perl binding for OpenGL, so I can now have fun with 3D graphics without the tedium of C :-)

My first finished program using the OpenGL module: It's the same idea as the C++ Menger Sponge program in my art gallery, but it's based on a tetrahedron. Nothing original about it, but it's quite fun. The maths for proportioning the tetrahedra was stolen from some website.

Here's what it looks like (pause while I hack an image feature into my blog…):

And here's the source. It was originally derived from the light program, which is one of the examples which comes with the Perl module. Not much is left of the original though.

#!/usr/bin/perl -w
use strict;
use OpenGL;

my $max_depth = @ARGV ? shift : 2;

my $a = 2;
my $x = 1/3 * sqrt(3) * $a;
my $d = 1/6 * sqrt(3) * $a;
my $h = 1/3 * sqrt(6) * $a;
my $ha = 0.5 * $a;

my @face = (
   [ 0, 1, 2 ],
   [ 0, 3, 1 ],
   [ 0, 3, 2 ],
   [ 1, 2, 3 ],
);

glpOpenWindow(
   width => 500,
   height => 500,
   attributes => [
      GLX_DOUBLEBUFFER, GLX_RGBA, GLX_RED_SIZE, 1,
      GLX_GREEN_SIZE, 1, GLX_BLUE_SIZE, 1,
   ]
);

glDepthFunc(GL_LESS);
glEnable(GL_DEPTH_TEST);

glMatrixMode(GL_PROJECTION);
glLoadIdentity();
glOrtho(-1.5, 1.5, -1.5, 1.5, -10, 10);
glMatrixMode(GL_MODELVIEW);

my $list = glGenLists(1);
glNewList($list, GL_COMPILE);
glBegin(GL_TRIANGLES);
sierpinski($max_depth, [
   [ [ 1, 0, 0 ], [ $x,  0,    0  ] ],
   [ [ 0, 1, 0 ], [ -$d, $ha,  0  ] ],
   [ [ 0, 0, 1 ], [ -$d, -$ha, 0  ] ],
   [ [ 1, 1, 1 ], [ 0,   0,    $h ] ],
]);
glEnd;
glEndList;

my $spin = 0;
while (1) {
   glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);

   glLoadIdentity();
   glRotatef(23 * sin($spin * 3.14 / 180), 1, 0, 0);
   glRotatef($spin, 0, 1, 0);

   glCallList($list);

   glFlush();
   glXSwapBuffers();

   ++$spin;
}


sub avg
{
   my ($a, $b) = @_;

   return 0.5 * ($a + $b) unless ref $a;
   return [ map { avg($a->[$_], $b->[$_]) } 0 .. $#$a ];
}

sub sierpinski
{
   my ($depth, $v) = @_;

   tetrahedron($v), return unless $depth;

   for my $i (0 .. 3) {
      sierpinski($depth - 1, [
         map { avg($v->[$i], $v->[$_]) } 0 .. 3
      ]);
   }
}

sub tetrahedron {
   my ($vertex) = @_;

   foreach my $face (@face) {
      foreach my $n (@$face) {
         my ($color, $position) = @{$vertex->[$n]};
         glColor3f(@$color);
         glVertex3f(@$position);
      }
   }
}