#!/usr/bin/perl =head1 NAME tessellation.pl - Show workings of perl based tessellation =head1 SOURCE general ideas taken from: http://glprogramming.com/red/chapter11.html =head1 AUTHOR Paul Seamons =cut use OpenGL qw(:all); use strict; use warnings; print "Starting $0\n"; my $color_toggle = 1; my $edge_toggle = 1; my $solid_toggle = 1; my $antialias_toggle = 1; my $defaults_toggle = 0; my $opaque_toggle = 'off'; my $opaque_cycle = 0; my ($w, $h) = (800, 600); main(); exit; sub main { glutInit(); glutInitWindowSize($w, $h); glutInitDisplayMode(GLUT_RGB | GLUT_DOUBLE); glutCreateWindow("Tessellation"); glClearColor (0.0, 0.0, 0.0, 0.0); init(); glutDisplayFunc(\&render_scene); glutKeyboardFunc(sub { if ($_[0] == 27 || $_[0] == ord('q')) { exit; } elsif ($_[0] == ord('e')) { $edge_toggle = ($edge_toggle) ? 0 : 1; } elsif ($_[0] == ord('a')) { $antialias_toggle = ($antialias_toggle) ? 0 : 1; } elsif ($_[0] == ord('s')) { $solid_toggle = ($solid_toggle) ? 0 : 1; } elsif ($_[0] == ord('d')) { $defaults_toggle = ($defaults_toggle) ? 0 : 1; } elsif ($_[0] == ord('o')) { $opaque_toggle = ($opaque_toggle eq 'off') ? 'polygon_data' : ($opaque_toggle eq 'polygon_data') ? 'vertex_data' : 'off'; } elsif ($_[0] == ord('y')) { $opaque_cycle++; } else { $color_toggle = ($color_toggle) ? 0 : 1; } render_scene(); }); print "'q' - Quit 'e' - Toggle edge flags (show triangles) 's' - Toggle solid (polygon vs lines) 'a' - Toggle anti-alias lines 'd' - Toggle perl callbacks vs default c implemented callbacks 'c' - Toggle color (perl callbacks only) 'o' - Toggle opaque data passing (off, polygon_data, vertex_data) (perl callbacks only) 'y' - Cycle the type of opaque data passed (perl callbacks only) "; glutMainLoop(); } sub init { glViewport(0,0, $w,$h); glMatrixMode(GL_PROJECTION()); glLoadIdentity(); if ( @_ ) { gluPerspective(45.0,4/3,0.1,100.0); } else { glFrustum(-0.1,0.1,-0.075,0.075,0.175,100.0); } glMatrixMode(GL_MODELVIEW()); glLoadIdentity(); } sub render_scene { glClear (GL_COLOR_BUFFER_BIT); glLoadIdentity(); glTranslatef(0, 0, -6); print "Callbacks: ".($defaults_toggle ? "c based" : ' perl') .", Solid: ".($solid_toggle ? ' on' : 'off') .", EdgeFlags: " .($edge_toggle ? ' on' : 'off') .", Color: " .($color_toggle ? ' on' : 'off') .", Anti-alias: " .($antialias_toggle ? ' on' : 'off') .", Opaque: $opaque_toggle" ."\n"; my $tess = gluNewTess('do_color'); my %opaque_printed; # ideally - these would be loaded into a call list - but this is just a sampling if ($defaults_toggle) { gluTessCallback($tess, GLU_TESS_BEGIN(), 'DEFAULT'); gluTessCallback($tess, GLU_TESS_ERROR(), 'DEFAULT'); gluTessCallback($tess, GLU_TESS_END(), 'DEFAULT'); gluTessCallback($tess, GLU_TESS_VERTEX(), 'DEFAULT'); gluTessCallback($tess, GLU_TESS_EDGE_FLAG(), 'DEFAULT') if $edge_toggle; gluTessCallback($tess, GLU_TESS_COMBINE(), 'DEFAULT'); } else { gluTessCallback($tess, GLU_TESS_BEGIN(), sub { glBegin(shift) }); gluTessCallback($tess, GLU_TESS_ERROR(), sub { my $errno = shift; my $err = gluErrorString($errno); print "got an error ($errno - $err)\n" }); gluTessCallback($tess, GLU_TESS_END(), sub { glEnd(); }); gluTessCallback($tess, GLU_TESS_EDGE_FLAG(), sub { glEdgeFlag(shift) }) if $edge_toggle; my $type = ($opaque_toggle eq 'vertex_data') ? GLU_TESS_VERTEX() : GLU_TESS_VERTEX_DATA(); gluTessCallback($tess, $type, sub { my ($x, $y, $z, $r, $g, $b, $a, $opaque) = @_; glColor4f($r, $g, $b, $a) if $color_toggle; glVertex3f($x, $y, $z); # the following is only a test of passing opaque polygon data or vertex data if ($opaque) { my $ref = ref($opaque) || 'SCALAR'; my $pv = ($ref eq 'CODE') ? $opaque->() : ($ref eq 'ARRAY') ? $opaque->[0] : ($ref eq 'HASH') ? $opaque->{'key'} : ($opaque =~ /^\d+$/) ? do { $ref = 'SCALAR NUM'; chr($opaque) } : $opaque; my $str = "Vertices were passed ".($pv eq 'p' ? 'polygon' : $pv eq 'v' ? 'vertex' : "other ($pv)")." data of type $ref\n"; print $str if ! $opaque_printed{$str}++; print "We received a non-vertex data type ($pv $ref)\n" if $opaque_toggle eq 'vertex_data' && $pv ne 'v'; } }); gluTessCallback($tess, GLU_TESS_COMBINE(), sub { my ($x, $y, $z, $v0, $v1, $v2, $v3, $w0, $w1, $w2, $w3, $polygon_data) = @_; # polygon data is passed to COMBINE in addition to COMBINE_DATA # GLU_TESS_COMBINE and GLU_TESS_COMBINE_DATA call the same code so polygon data is always passed # When GLU_TESS_VERTEX is used, the two-four opaque elements passed to gluTessVertex are passed as the final element of each vector data # In the GLU_TESS_VERTEX case an 8th return parameter can then be returned which can be any perl variable, # which is then eventually passed as the data to the GLU_TESS_VERTEX callback. return ( $x, $y, $z, $w0*$v0->[3] + $w1*$v1->[3] + $w2*$v2->[3] + $w3*$v3->[3], $w0*$v0->[4] + $w1*$v1->[4] + $w2*$v2->[4] + $w3*$v3->[4], $w0*$v0->[5] + $w1*$v1->[5] + $w2*$v2->[5] + $w3*$v3->[5], $w0*$v0->[6] + $w1*$v1->[6] + $w2*$v2->[6] + $w3*$v3->[6], ((@$v0 == 8 || @$v0 == 11) ? ($v0->[7] || $v1->[7] || $v2->[7] || $v3->[7]) : ()), # if we received vertex data - return some for the new vertex ); }); } glPolygonMode(GL_FRONT_AND_BACK, $solid_toggle ? GL_FILL : GL_LINE); glEnable (GL_BLEND); if ($antialias_toggle) { glEnable (GL_LINE_SMOOTH); glBlendFunc (GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glHint (GL_LINE_SMOOTH_HINT, GL_DONT_CARE); glHint (GL_POLYGON_SMOOTH_HINT, GL_DONT_CARE); } else { glDisable(GL_LINE_SMOOTH); } glColor3f(1,1,1); # triangle glPushMatrix(); glTranslatef(-2.2, 1.2, 0); glScalef(.9, .9, 0); my $tri1 = [[0,1,0, 1,0,0,1], [-1,-1,0, 0,1,0,1], [1,-1,0, 0,0,1,1]]; gluTessBeginPolygon($tess); gluTessBeginContour($tess); for my $q (@$tri1) { gluTessVertex_p($tess, @$q); } gluTessEndContour($tess); gluTessEndPolygon($tess); glPopMatrix(); # square glPushMatrix(); glTranslatef(0, 1.2, 0); glScalef(.9, .9, 0); my $quad0 = [[-1,1,0, 1,0,0,1], [1,1,0, 0,1,0,1], [1,-1,0, 0,0,1,1], [-1,-1,0, 1,1,0,1]]; $quad0 = [reverse @$quad0]; gluTessBeginPolygon($tess); gluTessBeginContour($tess); for my $q (@$quad0) { gluTessVertex_p($tess, @$q); } gluTessEndContour($tess); glColor3f(1,1,1); gluTessEndPolygon($tess); glPopMatrix(); # pontiac glPushMatrix(); glTranslatef(2.2, .1, 0); glScalef(.7, .7, 0); my $quad1 = [[-1,3,0, 1,0,0,1], [0,0,0, 1,1,0,1], [1,3,0, 0,0,1,1], [0,2,0, 0,1,0,1]]; gluTessBeginPolygon($tess); gluTessBeginContour($tess); for my $q (@$quad1) { gluTessVertex_p($tess, @$q); } gluTessEndContour($tess); glColor3f(1,1,1); gluTessEndPolygon($tess); glPopMatrix(); # window glPushMatrix(); glTranslatef(-2.2, -2.1, 0); glScalef(.45, .45, 0); my $quad2 = [ [[-2,3,0, 1,0,0,1], [-2,0,0, 1,1,0,1], [2,0,0, 0,0,1,1], [2,3,0, 0,1,0,1]], [[-1,2,0, 1,0,0,1], [-1,1,0, 1,1,0,1], [1,1,0, 0,0,1,1], [1,2,0, 0,1,0,1]], ]; gluTessBeginPolygon($tess); for my $c (@$quad2) { gluTessBeginContour($tess); for my $q (@$c) { gluTessVertex_p($tess, @$q); } gluTessEndContour($tess); } glColor3f(1,1,1); gluTessEndPolygon($tess); glPopMatrix(); # star glPushMatrix(); glTranslatef(0, -2.1, 0); glScalef(.6, .6, 0); my $coord3 = [ [ 0.0, 3.0, 0, 1,0,0,1], [-1.0, 0.0, 0, 0,1,0,1], [ 1.6, 1.9, 0, 1,0,1,1], [-1.6, 1.9, 0, 1,1,0,1], [ 1.0, 0.0, 0, 0,0,1,1], ]; gluTessProperty($tess, GLU_TESS_WINDING_RULE(), GLU_TESS_WINDING_NONZERO()); my @p_cycle = (sub { "p" }, ["p"], {key => "p"}, "p", ord('p')); my @v_cycle = (sub { "v" }, ["v"], {key => "v"}, "v", ord('v')); if ($opaque_toggle eq 'off') { gluTessBeginPolygon($tess); } else { gluTessBeginPolygon($tess, $p_cycle[$opaque_cycle % @p_cycle]); } gluTessBeginContour($tess); for my $q (@$coord3) { if ($opaque_toggle eq 'off') { gluTessVertex_p($tess, @$q); } else { gluTessVertex_p($tess, @$q, $v_cycle[$opaque_cycle % @v_cycle]); } } gluTessEndContour($tess); glColor3f(1,1,1); gluTessEndPolygon($tess); glPopMatrix(); # octagon glPushMatrix(); glTranslatef(2, -1.3, 0); glScalef(.35, .35, 0); my $coord4 = [ [ -1, 2.4, 0, 1, 0, 0,1], [ 1, 2.4, 0, 1, 1, 0,1], [ 2.4, 1, 0, 0, 1, 0,1], [ 2.4, -1, 0, 0, 1, 1,1], [ 1, -2.4, 0, 0, 0, 1,1], [ -1, -2.4, 0, 1, 0, 1,1], [ -2.4, -1, 0, 1, 1, 1,1], [ -2.4, 1, 0, .5,.5,.5,1], ]; $coord4 = [reverse @$coord4]; gluTessProperty($tess, GLU_TESS_WINDING_RULE(), GLU_TESS_WINDING_ODD()); gluTessBeginPolygon($tess); gluTessBeginContour($tess); for my $q (@$coord4) { gluTessVertex_p($tess, @$q); } gluTessEndContour($tess); glColor3f(1,1,1); gluTessEndPolygon($tess); glPopMatrix(); gluDeleteTess($tess); glutSwapBuffers(); }