A Textured Globe.  The following are two textured globe objects: the left one was rendered with a GLW widget and the right one was rendered with a glw image displayed with a canvas widget.  The attached source code highlights a architecture of a molular GUI implementation for scriptive OpenGL rendering with both a GLW widget and a glw image.  It shows how a token of a pointer created by gluNewQuadric is returned as a Tcl string and then passed into a suite of gluQuadric functions via Tcl scripts for quadric primitive rendering.  It also shows how to use a Tcl command glphoto to import texture data from a Tk Photo image.

 

A textured globe rendered  with a GLW widget

A textured globe rendered with a glw image displayed in a canvas widget

proc globe.init w {
    global gimgHome 
    set old [glw current $w]

    GLfloat ambient_light {0.35 0.4 0.45 1.0}
    GLfloat source_light {0.9 0.85 0.8 1.0}
    GLfloat light_pos {5.5 1 0 1}
    GLfloat angle
    GLfloat angle2
    GLint moving 
    GLint startx
    GLint starty

    # Set up a simple lighting model
    glEnable GL_LIGHTING
    glLightModel GL_LIGHT_MODEL_AMBIENT ambient_light
    glLight GL_LIGHT0 GL_DIFFUSE source_light
    glLight GL_LIGHT0 GL_POSITION light_pos
    glEnable GL_LIGHT0

    # Enable material properties for lighting
    glEnable GL_COLOR_MATERIAL
    glColorMaterial GL_FRONT GL_AMBIENT_AND_DIFFUSE

    glEnable GL_TEXTURE_2D
    glPixelStore GL_UNPACK_ALIGNMENT 1

    set imgFileName [file join $gimgHome gif globe3t.ppm]

    globe.texture $imgFileName 3 GL_RGB GL_LINEAR

    glEnable GL_CULL_FACE
    glClearColor 0 0 0 0
    glw current $old
}
proc globe.texture {fileName depth colorType filterType} {
    image create photo globe -file $fileName
    set width [image width globe]
    set height [image height globe]
    glphoto texImage globe

    # Set Filtering type
    glTexParameter GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $filterType
    glTexParameter GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $filterType

    # Set Texture Environment
    glTexEnv GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE GL_MODULATE

    # Build Mipmaps
    gluBuild2DMipmaps GL_TEXTURE_2D $depth $width $height \
        $colorType GL_UNSIGNED_BYTE texImage

    # Free up the array
    gldel texImage
}
proc globe.sphere {} {
    glPushMatrix
    glRotate 90 1 0 0
    glColor 1 1 1 1

    set q [gluNewQuadric]

    gluQuadricDrawStyle $q GLU_FILL
    gluQuadricNormals $q GLU_SMOOTH
    gluQuadricTexture $q GL_TRUE

    gluSphere $q 1.0 24 24
    gluDeleteQuadric $q

    glPopMatrix
}
proc globe.display w {
    set old [glw current $w]
    glClear GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT
    glClear GL_COLOR_BUFFER_BIT
    glLight GL_LIGHT0 GL_POSITION light_pos

    glPushMatrix
    glTranslate 0 0 -4
    glRotate angle2 1 0 0
    glRotate angle 0 1 0
    globe.sphere
    glPopMatrix
    glFlush
    glw draw
    glw current $old
}
proc globe.reshape {w width height} {
    set old [glw current $w]
    glViewport 0 0 $width $height
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    if {$height == 0} {
        gluPerspective 45 $width 1.0 2000.0
    } else {
        gluPerspective 45 [expr $width/double($height)] 1.0 2000.0
    }
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    glw current $old
}
proc globe.mouse {w state x y} {
    set old [glw current $w]
    if {$state == "BUTTON_DOWN"} {
        glset moving 1
        glset startx $x
        glset starty $y
    }

    if {$state == "BUTTON_UP"} {
        glset moving 0
    }
    glw current $old
}
proc globe.motion {w x y} {
    set old [glw current $w]
    if {[glv moving]} {
        glset angle [expr [glv angle] + $x - [glv startx]]
        glset angle2 [expr [glv angle2] + $y - [glv starty]]
        glset startx $x
        glset starty $y
        globe.display $w
    }
    glw current $old
}
proc globe.rotate w {
    set old [glw current $w]
    glset angle [expr [glv angle] + 1.0]
    if { [glv angle] == 360.0 } {
        glset angle 0
    }
    globe.display $w
    glw current $old
}
proc globe.keypress {w keycode keysym} {
    set old [glw current $w]
    switch $keysym {
        "Escape" { glw delete $w}
        "w" { glPolygonMode GL_FRONT_AND_BACK GL_LINE }
        "W" { glPolygonMode GL_FRONT_AND_BACK GL_FILL }
        "q" -
        "Q" {globe.queue $w}
    }
    catch {
        globe.display $w
        glw current $old
    }
}
proc globe.create w {
    glw $w -width 256 -height 256
    globe.init $w

    bind $w <Configure>     "globe.reshape $w %w %h"
    bind $w <Expose>        "globe.display $w"
    bind $w <ButtonRelease> "globe.mouse $w BUTTON_UP %x %y"
    bind $w <ButtonPress>   "globe.mouse $w BUTTON_DOWN %x %y"
    bind $w <Motion>        "globe.motion $w %x %y"
    bind $w <KeyPress>      "globe.keypress $w %k %K"

    focus $w
    return $w
}
proc globe.queue w {
    set old [glw current $w]
    if [catch "glv qid"] {
        GLint qid [queue.put "globe.rotate $w"]
    } else {
        queue.remove [glv qid]
        gldel qid
    }
    glw current $old 
}
proc globe.img img {
    image create glw $img -width 256 -height 256
    globe.init $img
    globe.reshape $img 256 256
    globe.display $img
    return $img
}
proc globe.img.keypress {w img keycode keysym} {
    switch $keysym {
        "Escape" {destroy $w}
        default {globe.keypress $img $keycode $keysym}
    }
}
proc globe.img.config {w img wwd wht} {
    set bd [$w cget -bd]
    set width [expr $wwd - 2 * $bd]
    set height [expr $wht - 2 * $bd]
    $img config -width $width -height $height
    globe.reshape $img $width $height
    globe.display $img
}
proc globe.img.bind {w img} {
    bind $w <Configure>     "globe.img.config $w $img %w %h"
    bind $w <ButtonRelease> "globe.mouse $img BUTTON_UP %x %y"
    bind $w <ButtonPress>   "globe.mouse $img BUTTON_DOWN %x %y"
    bind $w <Motion>        "globe.motion $img %x %y"
    bind $w <KeyPress>      "globe.img.keypress $w $img %k %K" 
    focus $w
}
proc globecanv.create canv {
    canvas $canv -width 256 -height 256
    $canv create image 0 0 -image [globe.img globe$canv] -anchor nw
    $canv create text 50 50 -fill red -anchor nw \
        -text "GLW Image - Rotating Globe"
    globe.img.bind $canv globe$canv
    bind $canv <Destroy> "image delete globe$canv"
    return $canv
}