#!/usr/local/bin/perl # # tremoid.pl : draw an equitremoid # (c) 2013 jl_morel@bribes.org - http://http://bribes.org/perl use strict; use warnings; use Math::Trig; use OpenGL qw/ :all /; my $n = 8; # equitremoid order my $scale = 2.6; # image scale #------ Base vectors my @i = ( 1, 0, 0 ); my @j = ( 0, 1, 0 ); my @k = ( 0, 0, 1 ); my @O = ( 0, 0, 0 ); #------ Draw a Cylindrical Wedge sub DrawWedge { my $n = shift; # Setup the quadric object my $qd = gluNewQuadric(); gluQuadricDrawStyle( $qd, GLU_FILL ); gluQuadricNormals( $qd, GLU_SMOOTH ); gluQuadricOrientation( $qd, GLU_OUTSIDE ); gluQuadricTexture( $qd, GL_FALSE ); # The cylinder is cut with three plans to get a wedge glPushMatrix(); glClipPlane_p( GL_CLIP_PLANE0, -sin( pi / $n ), 0, -cos( pi / $n ), 0 ); glEnable(GL_CLIP_PLANE0); glClipPlane_p( GL_CLIP_PLANE1, -sin( pi / $n ), 0, cos( pi / $n ), 0 ); glEnable(GL_CLIP_PLANE1); glClipPlane_p( GL_CLIP_PLANE2,, 1, 0, 0, 1 ); glEnable(GL_CLIP_PLANE2); glTranslatef( -1, 0, -2 ); gluCylinder( $qd, 1, 1, 4, 50, 1 ); glDisable(GL_CLIP_PLANE0); glDisable(GL_CLIP_PLANE1); glDisable(GL_CLIP_PLANE2); glPopMatrix(); } #------ Draw the equitremoid of order n sub DrawEquitremoid { my $n = shift; for ( 0 .. $n - 1 ) { glRotatef( rad2deg( 2 * pi / $n ), @j ); glColor3f( Rainbow( $_ / ( $n - 1 ) ) ); DrawWedge($n); } } #------ Draw the bounding prism sub DrawPrism { my $n = shift; my $r = 1 / cos( pi / $n ); my @alpha = map { ( 2 * $_ + 1 + $n % 2 ) * pi / $n } ( 0 .. $n - 1 ); glColor3f( 0.8, 0.8, 0.8 ); # gray glBegin(GL_LINE_LOOP); # bottom glVertex3f( $r * cos($_), -1, $r * sin($_) ) foreach @alpha; glEnd(); glBegin(GL_LINE_LOOP); # up glVertex3f( $r * cos($_), 1, $r * sin($_) ) foreach @alpha; glEnd(); glBegin(GL_LINES); # edges foreach (@alpha) { glVertex3f( $r * cos($_), 1, $r * sin($_) ); glVertex3f( $r * cos($_), -1, $r * sin($_) ); } glEnd(); } #------ Draw the scene my $spin = 0; sub display { glClear( GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT ); glLoadIdentity(); gluLookAt( 2.0, 4.0, 10.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0 ); glPushMatrix(); glScalef( $scale, $scale, $scale ); glRotatef( $spin, @j ); DrawEquitremoid($n); # DrawPrism($n); glPopMatrix(); glutSwapBuffers(); # debug code # if ( ( my $e = glGetError() ) != GL_NO_ERROR ) { # print "error : ", gluErrorString($e), "\n"; # } } #------ GLUT Callback called when the window is resized sub reshape { my ( $w, $h ) = @_; glViewport( 0, 0, $w, $h ); glMatrixMode(GL_PROJECTION); glLoadIdentity(); # define the projection gluPerspective( 45, $h ? $w / $h : 0, 1, 20 ); glMatrixMode(GL_MODELVIEW); glLoadIdentity(); } #------ Routine for rotating the scene my $WaitUntil = 0; sub spinDisplay { my $TimeNow = glutGet(GLUT_ELAPSED_TIME); if ( $TimeNow >= $WaitUntil ) { $spin += 1.0; $spin = $spin - 360.0 if ( $spin > 360.0 ); glutPostRedisplay(); $WaitUntil = $TimeNow + 1000 / 25; # 25 frames/s } } #------ GLUT callback for the mouse sub mouse { my ( $button, $state, $x, $y ) = @_; if ( $button == GLUT_LEFT_BUTTON ) { glutIdleFunc( \&spinDisplay ) if ( $state == GLUT_DOWN ); } elsif ( $button == GLUT_RIGHT_BUTTON ) { glutIdleFunc(undef) if ( $state == GLUT_DOWN ); } } #------ Initialization routine my @light0_position = ( -2.0, 8.0, 5.0, 0.0 ); my @mat_amb_diff_color = ( 0.8, 0.8, 0.8, 1.0 ); my @light_diffuse = ( 2.0, 2.0, 2.0, 1.0 ); my @light_ambient = ( 0.2, 0.2, 0.2, 1 ); sub init { glClearColor( 1, 1, 1, 1 ); # White background glShadeModel(GL_SMOOTH); # Smooth shading glEnable(GL_MULTISAMPLE); # Enable multisample antialiasing glEnable(GL_DEPTH_TEST); # Enable hidden surface removal glEnable(GL_LIGHTING); glEnable(GL_LIGHT0); # Light and material glLightfv_p( GL_LIGHT0, GL_POSITION, @light0_position ); glLightfv_p( GL_LIGHT0, GL_DIFFUSE, @light_diffuse ); glLightfv_p( GL_LIGHT0, GL_AMBIENT, @light_ambient ); glMaterialfv_p( GL_FRONT, GL_AMBIENT_AND_DIFFUSE, @mat_amb_diff_color ); glEnable(GL_COLOR_MATERIAL); # Material track the current color glLightModeli( GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE ); } #------ Main glutInit(); glutInitDisplayMode( GLUT_DOUBLE # Double buffering | GLUT_RGB # RGB color mode | GLUT_DEPTH # Hidden surface removal | GLUT_MULTISAMPLE # Multisample antialiasing ); glutInitWindowSize( 300, 300 ); glutCreateWindow("Equitremoid"); init(); glutDisplayFunc( \&display ); glutReshapeFunc( \&reshape ); glutMouseFunc( \&mouse ); glutIdleFunc( \&spinDisplay ); glutMainLoop(); #------ Rainbow color map function # Usage: ($red, $green, $blue) = Rainbow( $x ); # $x must be between 0 and 1. # Returns the color of the rainbow (RGB list) associated with $x # from blue for $x = 0 to red for $x = 1. sub max { $_[0] < $_[1] ? $_[1] : $_[0] } # max auxiliary function sub Rainbow { my $dx = 0.8; my $s = ( 6 - 2 * $dx ) * $_[0] + $dx; return max( 0, ( 3 - abs( $s - 4 ) - abs( $s - 5 ) ) / 2 ), # Red max( 0, ( 4 - abs( $s - 2 ) - abs( $s - 4 ) ) / 2 ), # Green max( 0, ( 3 - abs( $s - 1 ) - abs( $s - 2 ) ) / 2 ); # Blue }