use OpenGL;

#5 KappaTau Space Curves

rocker.pl

• package main
  • kappa
  • tau
  • NextPoint
  • DrawCurve
  • init
  • display
  • reshape
  • spinDisplay
  • CrossProduct
  • DotProduct
  • GetVectorLength
  • AddVectors
  • ScaleVector
  • NormalizeVector
  • DrawArrow
  • DrawAxes
  • max
  • Rainbow
• EOF

#!/usr/local/bin/perl
#
# rocker.pl : draw a KappaTau curve
# (c) 2013 jl_morel@bribes.org - http://http://bribes.org/perl
use strict;
use warnings;
use OpenGL qw/ :all /;
use Math::Trig;

#------ Base vectors

my @i = ( 1, 0, 0 );
my @j = ( 0, 1, 0 );
my @k = ( 0, 0, 1 );
my @O = ( 0, 0, 0 );            #origin

#------ Initialization

my $s     = 0;                  # Natural parameter s (arclength)
my $smax  = 4 * pi;
my $ds    = 0.0001;             # s increment
my $width = 0.1;                # Frenet ribbon width
my @P     = ( 0, -0.5, -1 );    # Starting point
my @T     = @i;                 # initial Frenet-Serret frame
my @N     = @j;
my @B     = @k;
my $curve;                      # OpenGL display list for the curve

sub kappa {                     # curvature function
  my $s = shift;
  return 1;
}

sub tau {                       # torsion function
  my $s = shift;
  return sin $s;
}

#------ NextPoint
# Calculates the next point P(s+ds) from P(s) using the Frenet–Serret formulas

sub NextPoint {
  @P = AddVectors( @P, ScaleVector( @T, $ds ) );
  $s += $ds;
  @T = AddVectors( @T, ScaleVector( @N, kappa($s) * $ds ) );
  @B = AddVectors( @B, ScaleVector( @N, -tau($s) * $ds ) );
  @T = NormalizeVector(@T);
  @B = NormalizeVector(@B);
  @N = CrossProduct( @B, @T );
}

#------ DrawCurve
# Returns an OpenGL display list of the curve

sub DrawCurve {
  my $curve = glGenLists(1);
  glNewList( $curve, GL_COMPILE );

  my @P0 = @P;                # initialization
  my @R0 = AddVectors( @P, ScaleVector( @B, $width ) );

  glBegin(GL_TRIANGLES);
  for ( my $i = 1 ; $i <= $smax / $ds ; $i++ ) {
    NextPoint();
    if ( $i % 100 == 0 ) {    # we draw only every 100 points
      my @R = AddVectors( @P, ScaleVector( @B, $width ) );

      # We colorize with the angle (@N, @j) (mod pi)
      glColor3f( Rainbow( 1 / pi * acos DotProduct( @N, @j ) ) );

      # The quadrilateral @P0 @R0 @R @P is not a Quad
      glVertex3f(@P0);        # we draw the triangle @P0 @R0 @R
      glVertex3f(@R0);
      glVertex3f(@R);

      glVertex3f(@P0);        # then the triangle @P0 @R @P
      glVertex3f(@R);
      glVertex3f(@P);

      @P0 = @P;               # save for next step
      @R0 = @R;
    }
  }
  glEnd();
  glEndList;
  return $curve;
}

#------ Initialization routine

sub init {
  glClearColor( 1, 1, 1, 1 );    # White background
  glEnable(GL_DEPTH_TEST);       # Enable hidden surface removal
  glEnable(GL_MULTISAMPLE);      # Enable multisample antialiasing
  $curve = DrawCurve();
}

#------ Draw the scene

my $spin = 0.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( 2.5, 2.5, 2.5 );
  glRotatef( $spin, 0.0, 1.0, 0.0 );

  DrawAxes(0.5);    # Axes

  glColor3f( 0.8, 0.8, 0.8 );
  glutWireCube(2);    # Gray wired cube

  glCallList($curve); # Curve

  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();
  gluPerspective( 45.0, $h ? $w / $h : 0, 1.0, 20.0 );
  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
  }
}

#------ Main

glutInit();
glutInitDisplayMode(
      GLUT_DOUBLE                         # Double buffering
    | GLUT_RGB                            # RGB mode
    | GLUT_DEPTH                          # Hidden surface removal
    | GLUT_MULTISAMPLE                    # Multisample antialiasing
);
glutInitWindowPosition( 0, 0 );
glutInitWindowSize( 300, 300 );
glutCreateWindow("KappaTau curve");
init();
glutDisplayFunc( \&display );
glutReshapeFunc( \&reshape );
glutMouseFunc( \&mouse );
glutIdleFunc( \&spinDisplay );
glutMainLoop();

# ============ Some auxiliary routines

#------ Returns the cross product of 2 vectors

sub CrossProduct {
  return (
    $_[1] * $_[5] - $_[2] * $_[4],
    $_[3] * $_[2] - $_[0] * $_[5],
    $_[0] * $_[4] - $_[1] * $_[3]
  );
}

#------ Returns the dot product of 2 vectors

sub DotProduct {
  return $_[0] * $_[3] + $_[1] * $_[4] + $_[2] * $_[5];
}

#------ Returns the length of a vector

sub GetVectorLength {
  return sqrt( $_[0] * $_[0] + $_[1] * $_[1] + $_[2] * $_[2] );
}

#------ Returns the sum of 2 vectors

sub AddVectors {
  return ( $_[0] + $_[3], $_[1] + $_[4], $_[2] + $_[5] );
}

#------ Returns the vector scaled by the last parameter

sub ScaleVector {
  return ( $_[0] * $_[3], $_[1] * $_[3], $_[2] * $_[3] );
}

#------ Returns a normalized vector (length = 1)

sub NormalizeVector {
  return ( 0, 0, 0 ) if ( my $norm = GetVectorLength(@_) ) == 0;
  return ScaleVector( @_, 1 / $norm );
}

#------ DrawArrow
# Usage: DrawArrow( @A, @V [,$k] );
# Draws an arrow representing the vector @V with the point @A as origin.
# The optional parameter scales the arrow thickness (default to 1).

sub DrawArrow {
  my ( $ox, $oy, $oz, $x, $y, $z, $k ) = @_;
  $k ||= 1;
  my $norm = GetVectorLength( $x, $y, $z );
  my @u = NormalizeVector( $x, $y, $z );
  my @v = CrossProduct( @k, @u );
  my $alpha          = rad2deg acos DotProduct( @k, @u );
  my $CylinderRadius = 0.025 * $k;
  my $ConeHeight     = 0.1 * $k;
  my $ConeRadius     = 0.06 * $k;
  my $CylinderHeight = $norm - $ConeHeight;

  # Setup the quadric object
  my $Qobj = gluNewQuadric();
  gluQuadricDrawStyle( $Qobj, GLU_FILL );
  gluQuadricNormals( $Qobj, GLU_SMOOTH );
  gluQuadricOrientation( $Qobj, GLU_OUTSIDE );
  gluQuadricTexture( $Qobj, GL_FALSE );

  glPushMatrix();
    glTranslatef( $ox, $oy, $oz );
      glRotatef( $alpha, @v );
      gluCylinder( $Qobj, $CylinderRadius, $CylinderRadius, $CylinderHeight, 10, 1 );
      glPushMatrix();
      gluDisk( $Qobj, 0, $CylinderRadius, 10, 1 );
      glTranslatef( 0.0, 0.0, $CylinderHeight );
      gluCylinder( $Qobj, $ConeRadius, 0.0, $ConeHeight, 10, 1 );
      glRotatef( 180, @j );
      gluDisk( $Qobj, $CylinderRadius, $ConeRadius, 10, 1 );
    glPopMatrix();
  glPopMatrix();
}

#------ DrawAxes
# Usage: DrawAxes( [$k] );
# Draws the unit vectors of the cartesian coordinates system at the origine O.
# The optional parameter scales the arrow thickness (default to 1).

sub DrawAxes {
  my $k = shift;
  glColor3f(@i);
  DrawArrow( @O, @i, $k );
  glColor3f(@j);
  DrawArrow( @O, @j, $k );
  glColor3f(@k);
  DrawArrow( @O, @k, $k );
}

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

Back to Top