no display name and no $DISPLAY environment variable
    while executing
"load /enadisk/commun/linux/local/ActiveTcl-8.6.11/lib/libtk8.6.so Tk"
    ("package ifneeded Tk 8.6.11" script)
    invoked from within
"package require Tk"
    (in namespace eval "::request" script line 22)
    invoked from within
"namespace eval ::request $script"
    ("::try" body line 12)
OUTPUT BUFFER:
# Copyright:      2005-2010 Paul Obermeier (obermeier@tcl3d.org)
#
#                 See the file "Tcl3D_License.txt" for information on 
#                 usage and redistribution of this file, and for a
#                 DISCLAIMER OF ALL WARRANTIES.
#
# Module:         Tcl3D -> tcl3dOgl
# Filename:       Sierpinski.tcl
#
# Author:         Paul Obermeier
#
# Description:    Tcl3D demo displaying a 3D Sierpinski Tetrahedron.
#
#                 Derived from a demo by Gerard Sookahet (tetra-3dc.tcl),
#                 which used the 3dcanvas package.
#                 The original version is at: http://wiki.tcl.tk/11832.
#
#                 Incorporates optimization functions by Philip Quaife.
#                 See the Tcl'ers Wiki http://wiki.tcl.tk/14820 for a
#                 description of his optimizations.

package require Tk
package require tcl3d 0.5.0

set vdist       600
set rdepth      4
set xRotate     0.0
set yRotate     0.0
set zRotate     0.0
set animStarted 0
set frameCount  0
set useOpt      0
set buildInfo   "Info"
set appName     "Tcl3D demo: Sierpinski Tetrahedron"

# Create a stop watch for time measurement.
set stopwatch [tcl3dNewSwatch]

# Show errors occuring in the Togl callbacks.
proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    exit
}

# Print info message into widget a the bottom of the window.
proc PrintInfo { msg } {
    if { [winfo exists .fr.info] } {
        .fr.info configure -text $msg
    }
}

proc GetFPS { { elapsedFrames 1 } } {
    set currentTime [tcl3dLookupSwatch $::stopwatch]
    set fps [expr $elapsedFrames / ($currentTime - $::s_lastTime)]
    set ::s_lastTime $currentTime
    return $fps
}

proc DisplayFPS {} {
    global frameCount

    incr frameCount
    if { $frameCount == 100 } {
        wm title . [format "%s (%.0f fps)" $::appName [GetFPS $frameCount]]
        set frameCount 0
    }
}

proc trans { w args } {
    $w postredisplay
}

proc rotX { w angle } {
    set ::xRotate [expr $::xRotate + $angle]
    $w postredisplay
}

proc rotY { w angle } {
    set ::yRotate [expr $::yRotate + $angle]
    $w postredisplay
}

proc rotZ { w angle } {
    set ::zRotate [expr $::zRotate + $angle]
    $w postredisplay
}

proc handleRot {x y win} {
    global cx cy

    rotY $win [expr {180 * (double($x - $cx) / [winfo width $win])}]
    rotX $win [expr {180 * (double($y - $cy) / [winfo height $win])}]

    set cx $x
    set cy $y
}

proc ShowAnimation { w } {
    if { $::animStarted == 0 } {
        return
    }
    set ::yRotate [expr {$::yRotate + 0.1}]
    set ::zRotate [expr {$::zRotate + 0.1}]
    $w postredisplay
    set ::animId [tcl3dAfterIdle ShowAnimation $w]
}

proc StartAnimation {} {
    ShowAnimation $::frTogl.toglwin
}

proc StopAnimation {} {
    if { [info exists ::animId] } {
        after cancel $::animId 
        set ::animStarted 0
    }
}

# Return the middle coordinates of two 3d points
proc MidPoint { l } {
    set X 0
    set Y 0
    set Z 0
    foreach {x y z} $l {
        set X [expr {$X + $x}]
        set Y [expr {$Y + $y}]
        set Z [expr {$Z + $z}]
    }
    return [list [expr {$X/2}] [expr {$Y/2}] [expr {$Z/2}]]
}

proc Sierpinski { w level l } {
    global rdepth

    if {$level > $rdepth} then return
    set i 1
    foreach {x y z} $l {
        set p($i) "$x $y $z"
        incr i
    }
    set p12 [MidPoint [concat $p(1) $p(2)]]
    set p13 [MidPoint [concat $p(1) $p(3)]]
    set p14 [MidPoint [concat $p(1) $p(4)]]
    set p23 [MidPoint [concat $p(2) $p(3)]]
    set p24 [MidPoint [concat $p(2) $p(4)]]
    set p34 [MidPoint [concat $p(3) $p(4)]]
    incr level
    if {$level == $rdepth} then {
        DrawTetra $w [concat $p(1) $p(2) $p(3) $p(4)]
    }
    Sierpinski $w $level [concat $p(1) $p12 $p13 $p14]
    Sierpinski $w $level [concat $p(2) $p12 $p23 $p24]
    Sierpinski $w $level [concat $p(3) $p13 $p23 $p34]
    Sierpinski $w $level [concat $p(4) $p14 $p24 $p34]
}

proc DrawTetra { w l } {
    set i 1
    foreach {x y z} $l {
        set p($i) [list $x $y $z]
        incr i
    }
    glBegin GL_TRIANGLES
        glColor3f 1 0 0 ; # RED
        glVertex3fv $p(1)
        glVertex3fv $p(2)
        glVertex3fv $p(3)

        glColor3f 1 1 0 ; # YELLOW
        glVertex3fv $p(2)
        glVertex3fv $p(3)
        glVertex3fv $p(4)

        glColor3f 0 0 1 ; # BLUE
        glVertex3fv $p(1)
        glVertex3fv $p(3)
        glVertex3fv $p(4)

        glColor3f 0 1 0 ; # GREEN
        glVertex3fv $p(1)
        glVertex3fv $p(2)
        glVertex3fv $p(4)
    glEnd
    incr ::numTrias 4
}

proc MidPointOpt { p1 p2 } {
    list [expr {([lindex $p1 0]+[lindex $p2 0])/2}] \
         [expr {([lindex $p1 1]+[lindex $p2 1])/2}] \
         [expr {([lindex $p1 2]+[lindex $p2 2])/2}]
}

proc SierpinskiOptNR { w level p1 p2 p3 p4 } {
    global rdepth

    set nextpoints [list $level $p1 $p2 $p3 $p4]

    while {[llength $nextpoints]} {
        set points $nextpoints
        set nextpoints [list]
        foreach {l p1 p2 p3 p4} $points {
            set p12 [MidPointOpt $p1 $p2]
            set p13 [MidPointOpt $p1 $p3]
            set p14 [MidPointOpt $p1 $p4]
            set p23 [MidPointOpt $p2 $p3]
            set p24 [MidPointOpt $p2 $p4]
            set p34 [MidPointOpt $p3 $p4]
            set level [expr {$l + 1}]
            if {$level == $rdepth } then {
                DrawTetraOpt $w $p1 $p2 $p3 $p4
            } else {
                lappend nextpoints $level $p1 $p12 $p13 $p14
                lappend nextpoints $level $p2 $p12 $p23 $p24
                lappend nextpoints $level $p3 $p13 $p23 $p34
                lappend nextpoints $level $p4 $p14 $p24 $p34
            }
        }
    }
}

### Move proc here so we can inline it in the next proc

proc DrawTetraOpt { w p1 p2 p3 p4 } {
    glBegin GL_TRIANGLES
        glColor3f 1 0 0 ; # RED
        glVertex3fv $p1
        glVertex3fv $p2
        glVertex3fv $p3

        glColor3f 1 1 0 ; # YELLOW
        glVertex3fv $p2
        glVertex3fv $p3
        glVertex3fv $p4

        glColor3f 0 0 1 ; # BLUE
        glVertex3fv $p1
        glVertex3fv $p3
        glVertex3fv $p4

        glColor3f 0 1 0 ; # GREEN
        glVertex3fv $p1
        glVertex3fv $p2
        glVertex3fv $p4
    glEnd
    incr ::numTrias 4
}

proc SierpinskiOpt { w level p1 p2 p3 p4 } {
    global rdepth

    if {$level > $rdepth} then return

    set p12 [MidPointOpt $p1 $p2]
    set p13 [MidPointOpt $p1 $p3]
    set p14 [MidPointOpt $p1 $p4]
    set p23 [MidPointOpt $p2 $p3]
    set p24 [MidPointOpt $p2 $p4]
    set p34 [MidPointOpt $p3 $p4]
    incr level
    if {$level == $rdepth} then {
        DrawTetraOpt $w $p1 $p2 $p3 $p4
    }
    SierpinskiOpt $w $level $p1 $p12 $p13 $p14
    SierpinskiOpt $w $level $p2 $p12 $p23 $p24
    SierpinskiOpt $w $level $p3 $p13 $p23 $p34
    SierpinskiOpt $w $level $p4 $p14 $p24 $p34
}

###
### SPECIALIZE : Inline MidPoint  in SierpinskiOpt
###

rename SierpinskiOpt {}
rename SierpinskiOptNR SierpinskiOpt

set map {}
foreach {txt p1 p2 } [regexp -inline -all {[[]MidPointOpt (.*?) (.*?)[]]} [set body [info body SierpinskiOpt]]] {
    lappend map $txt
    set x   [subst -nocommand {[expr {([lindex $p1 0]+[lindex $p2 0])/2}]}]
    set y   [subst -nocommand {[expr {([lindex $p1 1]+[lindex $p2 1])/2}]}]
    set z   [subst -nocommand {[expr {([lindex $p1 2]+[lindex $p2 2])/2}]}]
    lappend map "\[list $x $y $z \]"
}
set body [string map $map $body]

## Inline the DrawTetra proc also!

set body [string map [list {DrawTetraOpt $w $p1 $p2 $p3 $p4} [info body DrawTetraOpt]] $body]

catch {rename SierpinskiOpt {} }
proc SierpinskiOpt {w level p1 p2 p3 p4} $body

proc Init { w } {
    set edge 340
    set x1 [expr {sqrt(3)*$edge/3}]
    set x2 [expr {sqrt(3)*$edge/6}]
    set z3 [expr {sqrt(6)*$edge/3}]
    set y2 [expr {$edge/2}]
    # Vertices' coordinates of the regular tetrahedron
    set p1 [list $x1 0 0]
    set p2 [list -$x2 $y2 0]
    set p3 [list -$x2 -$y2 0]
    set p4 [list 0 0 $z3]

    if { [info exists ::sierList] } {
        glDeleteLists $::sierList 1
    }
    set ::sierList [glGenLists 1]
    glNewList $::sierList GL_COMPILE
    set ::numTrias 0
    if { $::useOpt } {
        set ::buildTime [time {SierpinskiOpt $w 0 $p1 $p2 $p3 $p4}]
    } else {
        set ::buildTime [time {Sierpinski $w 0 [concat $p1 $p2 $p3 $p4]}]
    }
    glEndList
    $w postredisplay
    set ::buildInfo [format "%d triangles: %d msec to build" \
                     $::numTrias [expr [lindex $::buildTime 0] / 1000]]
}

proc CreateCallback { w } {
    glClearColor 0 0 0 0
    glEnable GL_DEPTH_TEST
    glShadeModel GL_FLAT
    Init $w

    tcl3dStartSwatch $::stopwatch
    set ::startTime [tcl3dLookupSwatch $::stopwatch]
    set ::s_lastTime $::startTime
    set ::elapsedLastTime $::startTime
}

proc DisplayCallback { w } {
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
    glPushMatrix
    glTranslatef 0 0 [expr -1.0 * $::vdist]
    glRotatef $::xRotate 1.0 0.0 0.0
    glRotatef $::yRotate 0.0 1.0 0.0
    glRotatef $::zRotate 0.0 0.0 1.0
    glCallList $::sierList
    glPopMatrix

    if { $::animStarted } {
        DisplayFPS
    }

    $w swapbuffers
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    set w [$toglwin width]
    set h [$toglwin height]

    glViewport 0 0 $w $h
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluPerspective 60.0 [expr double($w)/double($h)] 1.0 2000.0
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    gluLookAt 0.0 0.0 5.0 0.0 0.0 0.0 0.0 1.0 0.0
}

wm title . $appName

set frMast [frame .fr]
set frTogl [frame .fr.togl]
set frBttn [frame .fr.bttn]
set frInfo [frame .fr.info]
pack $frMast -expand 1 -fill both

grid $frTogl -row 0 -column 0 -sticky news
grid $frBttn -row 1 -column 0 -sticky nws 
grid $frInfo -row 2 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1

togl $frTogl.toglwin -width 500 -height 500 \
                     -double true -depth true \
                     -displayproc DisplayCallback \
                     -reshapeproc ReshapeCallback \
                     -createproc  CreateCallback
pack $frTogl.toglwin -side top -expand 1 -fill both

label $frBttn.l1 -text "Recursive depth "
spinbox $frBttn.sdepth -from 1 -to 10 -textvariable rdepth -width 4
button $frBttn.b -text "Build" \
       -command { Init $frTogl.toglwin ; $frTogl.toglwin postredisplay }
checkbutton $frBttn.opt -text "Optimize" -indicatoron 1 \
                        -variable ::useOpt
label $frBttn.l2 -text "   View distance "
scale $frBttn.vd -from 0 -to 1000 -length 100 -orient horiz -showvalue false \
             -variable vdist -command "trans $frTogl.toglwin"
checkbutton $frBttn.b1 -text "Animate" -indicatoron [tcl3dShowIndicator] \
                       -variable ::animStarted \
                       -command { ShowAnimation $frTogl.toglwin }
eval pack [winfo children $frBttn] -side left -anchor w -expand 1

set glInfo [format "Running on %s with a %s (OpenGL %s, Tcl %s)" \
           $tcl_platform(os) [glGetString GL_RENDERER] \
           [glGetString GL_VERSION] [info patchlevel]]
label $frInfo.l1 -textvariable buildInfo -bg white
label $frInfo.l2 -text $glInfo
eval pack [winfo children $frInfo] -pady 2 -side top -expand 1 -fill x

bind .  { exit }
bind $frTogl.toglwin <1> {set cx %x; set cy %y}
bind $frTogl.toglwin  {handleRot %x %y %W}