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 18)
    invoked from within
"namespace eval ::request $script"
    ("::try" body line 12)

OUTPUT BUFFER:

# Copyright: 2008-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: Tcl3DSpecificDemos # Filename: rtVis.tcl # # Author: Paul Obermeier # # Description: Ray Tracing visualization program. # The comments of the rtvis* procedures explain how to # use the ray-tracing visualization commands. set auto_path [linsert $auto_path 0 [file dirname [info script]]] package require Tk package require tcl3d 0.3.3 # Define virtual events for OS independent mouse handling. tcl3dAddEvents # Font to be used in the Tk listbox. set g_listFont {-family {Courier} -size 10} # Create a photo image to hold the pixel color values. set g_Photo [image create photo] set g_WinWidth 512 set g_WinHeight 512 # Determine the directory of this script. set g_ScriptDir [file dirname [info script]] set g_LastDir $g_ScriptDir proc bgerror { msg } { tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo" exit } # Draw a textured box with style "type". Type can be GL_QUADS or GL_LINE_LOOPS. # The box is specified by the lower-left and upper-right corners. # A C version of this proc called tcl3dBox was introduced after version 0.3.3. proc tcl3dBoxTcl { lowerLeft upperRight type } { set llx [lindex $lowerLeft 0] set lly [lindex $lowerLeft 1] set llz [lindex $lowerLeft 2] set urx [lindex $upperRight 0] set ury [lindex $upperRight 1] set urz [lindex $upperRight 2] # Front Face glBegin $type glNormal3f 0.0 0.0 0.5 glTexCoord2f 0.0 0.0 ; glVertex3f $llx $lly $urz glTexCoord2f 1.0 0.0 ; glVertex3f $urx $lly $urz glTexCoord2f 1.0 1.0 ; glVertex3f $urx $ury $urz glTexCoord2f 0.0 1.0 ; glVertex3f $llx $ury $urz glEnd # Back Face glBegin $type glNormal3f 0.0 0.0 -0.5 glTexCoord2f 1.0 0.0 ; glVertex3f $llx $lly $llz glTexCoord2f 1.0 1.0 ; glVertex3f $llx $ury $llz glTexCoord2f 0.0 1.0 ; glVertex3f $urx $ury $llz glTexCoord2f 0.0 0.0 ; glVertex3f $urx $lly $llz glEnd # Top Face glBegin $type glNormal3f 0.0 0.5 0.0 glTexCoord2f 0.0 1.0 ; glVertex3f $llx $ury $llz glTexCoord2f 0.0 0.0 ; glVertex3f $llx $ury $urz glTexCoord2f 1.0 0.0 ; glVertex3f $urx $ury $urz glTexCoord2f 1.0 1.0 ; glVertex3f $urx $ury $llz glEnd # Bottom Face glBegin $type glNormal3f 0.0 -0.5 0.0 glTexCoord2f 1.0 1.0 ; glVertex3f $llx $lly $llz glTexCoord2f 0.0 1.0 ; glVertex3f $urx $lly $llz glTexCoord2f 0.0 0.0 ; glVertex3f $urx $lly $urz glTexCoord2f 1.0 0.0 ; glVertex3f $llx $lly $urz glEnd # Right Face glBegin $type glNormal3f 0.5 0.0 0.0 glTexCoord2f 1.0 0.0 ; glVertex3f $urx $lly $llz glTexCoord2f 1.0 1.0 ; glVertex3f $urx $ury $llz glTexCoord2f 0.0 1.0 ; glVertex3f $urx $ury $urz glTexCoord2f 0.0 0.0 ; glVertex3f $urx $lly $urz glEnd # Left Face glBegin $type glNormal3f -0.5 0.0 0.0 glTexCoord2f 0.0 0.0 ; glVertex3f $llx $lly $llz glTexCoord2f 1.0 0.0 ; glVertex3f $llx $lly $urz glTexCoord2f 1.0 1.0 ; glVertex3f $llx $ury $urz glTexCoord2f 0.0 1.0 ; glVertex3f $llx $ury $llz glEnd } # C-based tcl3dBox function introduced in Tcl3D version 0.4.0. if { [info commands tcl3dBox] eq "" } { rename tcl3dBoxTcl tcl3dBox } # Print message into info widget at the bottom of the window. proc PrintInfo { msg } { if { [winfo exists .fr.info] } { .fr.info configure -text $msg } } # Print message into status widget at the bottom of the window. proc PrintOut { msg } { global g_Gui $g_Gui(out) insert end "$msg\n" $g_Gui(out) see end update } proc InitVars {} { global g_Img g_Cur g_Gui g_Args g_Draw g_AccStructs catch {$g_Img(canvas) delete "Patches"} catch {$g_Gui(out) delete 1.0 end} catch {$g_Gui(aabb,lbox) delete 0 end} catch {unset g_Img} catch {unset g_Cur} catch {unset g_Draw} catch {unset g_AccStructs} set g_Draw(bbox,xmin) 1.0E10 set g_Draw(bbox,ymin) 1.0E10 set g_Draw(bbox,zmin) 1.0E10 set g_Draw(bbox,xmax) -1.0E10 set g_Draw(bbox,ymax) -1.0E10 set g_Draw(bbox,zmax) -1.0E10 set g_Draw(camDist) 5.0 set g_AccStructs(curAsList) [list] set g_Args(ray,prim,color) [list 1 1 1] set g_Args(ray,refl,color) [list 1 1 0] set g_Args(ray,shad,color) [list 0 1 1] set g_Args(geom,1,color) [list 1 0.0 0.0] set g_Args(geom,0,color) [list 1 0.5 0.0] set g_Args(aabb,0,color) [list 0 1 0.0] set g_Args(aabb,1,color) [list 0 1 0.5] set g_Args(thread,maxThreads) 5 set g_Args(thread,numThreadColumns) 5 set g_Args(thread,0,color) "red" set g_Args(thread,1,color) "green" set g_Args(thread,2,color) "blue" set g_Args(thread,3,color) "yellow" for { set thread 0 } { $thread < $g_Args(thread,maxThreads) } { incr thread } { set g_Args(thread,$thread,show) 1 } set g_Args(patches,show) 1 # Variables to select which types of objects should be drawn. set g_Args(ray,show) 1 set g_Args(ray,prim,show) 1 set g_Args(ray,refl,show) 1 set g_Args(ray,shad,show) 1 set g_Args(geom,show) 1 set g_Args(geom,showStatic) 1 set g_Args(geom,showDynamic) 1 set g_Args(geom,useLines) 1 set g_Args(lgt,show) 1 set g_Args(lgt,useLines) 1 set g_Args(aabb,maxLevels) 25 set g_Args(aabb,numLevelColumns) 5 set g_Args(aabb,show) 1 set g_Args(aabb,useLines) 1 for { set level 1 } { $level <= $g_Args(aabb,maxLevels) } { incr level } { set g_Args(aabb,$level,show) 1 } set g_Args(ray,cutoff) 1000 set g_Args(fov) 60.0 } proc InitPhoto { w h } { global g_Photo g_Gui $g_Photo configure -width $w -height $h $g_Photo blank $g_Gui(canvas) configure -width $w -height $w } proc ResetTfms {} { global g_Gui set g_Gui(tx) 0.0 set g_Gui(ty) 0.0 set g_Gui(tz) 0.0 set g_Gui(rx) 0.0 set g_Gui(ry) 0.0 set g_Gui(rz) 0.0 set g_Gui(rotCenX) 0.0 set g_Gui(rotCenY) 0.0 set g_Gui(rotCenZ) 0.0 } proc SetViewPoint { type } { global g_Gui g_Draw g_Args ResetTfms if { $type eq "origin" } { set g_Draw(camDist) 5.0 } else { set xsize [expr {$g_Draw(bbox,xmax) - $g_Draw(bbox,xmin)}] set ysize [expr {$g_Draw(bbox,ymax) - $g_Draw(bbox,ymin)}] set zsize [expr {$g_Draw(bbox,zmax) - $g_Draw(bbox,zmin)}] set maxSize 0.0 set maxSize [Max $maxSize $xsize] set maxSize [Max $maxSize $ysize] set maxSize [Max $maxSize $zsize] set g_Draw(camDist) [expr {0.5 * $maxSize / \ tan (3.1415926 / 180.0 * (0.5 * $g_Args(fov)))}] set g_Gui(rotCenX) [expr {-1.0 * ($g_Draw(bbox,xmin) + $xsize * 0.5)}] set g_Gui(rotCenY) [expr {-1.0 * ($g_Draw(bbox,ymin) + $ysize * 0.5)}] set g_Gui(rotCenZ) [expr {-1.0 * ($g_Draw(bbox,zmin) + $zsize * 0.5)}] } $g_Gui(toglwin) postredisplay } proc UpdateViewPoint {} { global g_Gui SetViewPoint $g_Gui(viewPoint) } proc RotX { w angle } { global g_Gui set g_Gui(rx) [expr {$g_Gui(rx) + $angle}] $w postredisplay } proc RotY { w angle } { global g_Gui set g_Gui(ry) [expr {$g_Gui(ry) + $angle}] $w postredisplay } proc RotZ { w angle } { global g_Gui set g_Gui(rz) [expr {$g_Gui(rz) + $angle}] $w postredisplay } proc HandleRot {x y win} { global cx cy RotY $win [expr {180.0 * (double($x - $cx) / [winfo width $win])}] RotX $win [expr {180.0 * (double($y - $cy) / [winfo height $win])}] set cx $x set cy $y } proc IncrTransScale { val } { global g_Gui set g_Gui(transScale) [expr $g_Gui(transScale) + $val] if { $g_Gui(transScale) <= 0.0 } { set g_Gui(transScale) 0.1 } } proc HandleTrans {axis x y win} { global cx cy global g_Gui if { $axis != "Z" } { set g_Gui(tx) [expr {$g_Gui(tx) + $g_Gui(transScale) * double($x - $cx)}] set g_Gui(ty) [expr {$g_Gui(ty) - $g_Gui(transScale) * double($y - $cy)}] } else { set g_Gui(tz) [expr {$g_Gui(tz) + $g_Gui(transScale) * (double($cy - $y))}] } set cx $x set cy $y $win postredisplay } proc CalcBBox { v } { global g_Draw set x [lindex $v 0] set y [lindex $v 1] set z [lindex $v 2] if { $x > $g_Draw(bbox,xmax) } { set g_Draw(bbox,xmax) $x } if { $x < $g_Draw(bbox,xmin) } { set g_Draw(bbox,xmin) $x } if { $y > $g_Draw(bbox,ymax) } { set g_Draw(bbox,ymax) $y } if { $y < $g_Draw(bbox,ymin) } { set g_Draw(bbox,ymin) $y } if { $z > $g_Draw(bbox,zmax) } { set g_Draw(bbox,zmax) $z } if { $z < $g_Draw(bbox,zmin) } { set g_Draw(bbox,zmin) $z } } # # Utility procedures for drawing the Ray-Tracing information. # # Draw a triangle given by it's vertices (v1, v2, v3) with color "color". # If the global flag "useLines" is true, the triangle is drawn # in line mode; otherwise it is rendered solid. # v1, v2, v3 and color are 3D vectors supplied as Tcl lists. proc DrawTriangle { v1 v2 v3 color } { global g_Args if { $g_Args(geom,useLines) } { glBegin GL_LINE_LOOP } else { glBegin GL_TRIANGLES } glColor3fv $color glVertex3fv $v1 glVertex3fv $v2 glVertex3fv $v3 glEnd } # Draw a quad given by it's vertices (v1, v2, v3, v4) with color "color". # If the global flag "useLines" is true, the quad is drawn # in line mode; otherwise it is rendered solid. # v1, v2, v3, v4 and color are 3D vectors supplied as Tcl lists. proc DrawQuad { v1 v2 v3 v4 color } { global g_Args if { $g_Args(geom,useLines) } { glBegin GL_LINE_LOOP } else { glBegin GL_QUADS } glColor3fv $color glVertex3fv $v1 glVertex3fv $v2 glVertex3fv $v3 glVertex3fv $v4 glEnd } # Draw a single ray starting at origin "org" looking into direction "dir". # The ray is drawn as a line with length "len" and color "color". # org, dir and color are 3D vectors supplied as Tcl lists. proc DrawRay { org dir len color } { glBegin GL_LINES glColor3fv $color glVertex3fv $org set endPoint [list 0.0 0.0 0.0] lset endPoint 0 [expr {[lindex $org 0] + $len * [lindex $dir 0]}] lset endPoint 1 [expr {[lindex $org 1] + $len * [lindex $dir 1]}] lset endPoint 2 [expr {[lindex $org 2] + $len * [lindex $dir 2]}] glVertex3fv $endPoint glEnd } # Draw a box given by it's lower-left (ll) and upper-right corner "ur" # with color "color". # If the global flag "useLines" is true, the box is drawn # in line mode; otherwise it is rendered solid. # ll, ur and color are 3D vectors supplied as Tcl lists. proc DrawBox { ll ur color } { global g_Args glColor3fv $color if { $g_Args(aabb,useLines) } { tcl3dBox $ll $ur $::GL_LINE_LOOP } else { tcl3dBox $ll $ur $::GL_QUADS } } # Draw a sphere at position "pos" with radius "radius". The color of the # sphere is given with "color". If the global flag "useLines" is true, # the sphere is drawn in line mode; otherwise it is rendered solid. # pos and color are 3D vectors supplied as Tcl lists. proc DrawSphere { pos radius color } { global g_Args glPushMatrix glColor3fv $color glTranslatef [lindex $pos 0] [lindex $pos 1] [lindex $pos 2] if { $g_Args(lgt,useLines) } { glutWireSphere $radius 7 7 } else { glutSolidSphere $radius 7 7 } glPopMatrix } # Draw a point light at position "pos" with radius "radius" emitting into # all directions. The color of the light is given with "color". # If the global flag "useLines" is true, the light sphere is drawn in line mode; # otherwise it is rendered solid. # pos, dir and color are 3D vectors supplied as Tcl lists. proc DrawPointLgt { pos radius color } { DrawSphere $pos $radius $color } # Draw a spot light at position "pos" with radius "radius" emitting into # direction "dir". The color of the light is given with "color". # If the global flag "useLines" is true, the light sphere is drawn in line mode; # otherwise it is rendered solid. # pos, dir and color are 3D vectors supplied as Tcl lists. proc DrawSpotLgt { pos dir radius color } { DrawPointLgt $pos $radius $color DrawRay $pos $dir [expr {$radius*5.0}] $color } # # Procedures to supply data about Ray-Tracing information. # # Announce the image size of the rendered image. # width and height specify the number of pixels of the image. # This command must be specified before any of the rtvisPixel # or rtvisPatch commands. proc rtvisImageSize { width height } { global g_Img # puts "rtvisImageSize $width $height" set g_Img(width) $width set g_Img(height) $height InitPhoto $width $height } # Bounding box of the patch rendered by thread "thread". proc rtvisPatch { thread xmin ymin xmax ymax } { global g_Img # puts "rtvisPatch $thread $xmin $ymin $xmax $ymax" lappend g_Img(patches,coords) [list $xmin $ymin $xmax $ymax] lappend g_Img(patches,thread) $thread set g_Img(patches,threadNums,$thread) 1 } # Announce the rendering of pixel (x, y) by thread "thread". proc rtvisPixel { thread x y } { global g_Cur g_Img # puts "rtvisPixel $thread $x $y" set g_Cur(x) $x set g_Cur(y) $y set g_Cur(thread) $thread } # Rendering of pixel (x, y) by thread "thread" results in color (r, g, b, a). # The color values must be specified as floats in the range of [0, 1]. proc rtvisPixelValue { thread x y r g b a } { global g_Img g_Photo # puts "rtvisPixelValue $thread $x $y $r $g $b $a" if { $r > 1.0 } { set r 1.0 } if { $g > 1.0 } { set g 1.0 } if { $b > 1.0 } { set b 1.0 } set g_Img($x,$y,color) [list $r $g $b $a] set g_Img($x,$y,thread) $thread $g_Photo put [tcl3dRgbf2Name $r $g $b] -to $x [expr $g_Img(height) - $y] } # Announce a ray rendered by thread "thread" starting at origin "org" looking # into direction "dir". The intersection point of the ray with an object is # "len" units away from the origin. # The ray is of type "type": # Primary ray : 0 # Reflected ray : 1 # Shadow ray : 2 # org and dir are 3D vectors supplied as Tcl lists. proc rtvisRay { thread type org dir len } { global g_Args g_Cur g_Draw g_Img # puts "rtvisRay $thread $type $org $dir $len" if { $len > $g_Args(ray,cutoff) } { return } if { $type == 0 } { set type "prim" } elseif { $type == 1 } { set type "refl" } elseif { $type == 2 } { set type "shad" } else { PrintOut "Error: Unknown ray type $type" } lappend g_Img(rays,$g_Cur(x),$g_Cur(y)) \ "DrawRay \{$org\} \{$dir\} $len \{$g_Args(ray,$type,color)\}" lappend g_Draw(ray,$type,cmd) \ "DrawRay \{$org\} \{$dir\} $len \{$g_Args(ray,$type,color)\}" } # Announce a point lightsource located at position "pos" with radius "radius". # The lightsource emits light of color "color". # "castShadow" specifies, if this lightsource can cast shadows onto objects. # pos and color are 3D vectors supplied as Tcl lists. # The color values must be specified as floats in the range of [0, 1]. proc rtvisLgtPoint { pos color radius castShadow } { global g_Draw # puts "rtvisLgtPoint $pos $color $radius $castShadow" lappend g_Draw(lgt,cmd) \ "DrawPointLgt \{$pos\} $radius \{$color\}" } # Announce a spot lightsource located at position "pos" emitting into # direction "dir". The lightsource has radius "radius". # The lightsource emits light of color "color". # "castShadow" specifies, if this lightsource can cast shadows onto objects. # pos, dir and color are 3D vectors supplied as Tcl lists. # The color values must be specified as floats in the range of [0, 1]. proc rtvisLgtSpot { pos dir color radius castShadow } { global g_Draw # puts "rtvisLgtSpot $pos $dir $color $radius $castShadow" lappend g_Draw(lgt,cmd) \ "DrawSpotLgt \{$pos\} \{$dir\} $radius \{$color\}" } # Announce a geometry object of type triangle. # The vertices of the triangle are given with "v1", "v2" and "v3". # v1, v2, v3 are 3D vectors supplied as Tcl lists. # The optional parameter "isStatic" specifies, if the triangle belongs # to the static world (1), or to the dynamic world (0). proc rtvisTriangle { v1 v2 v3 { isStatic 1 } } { global g_Args g_Draw CalcBBox $v1 CalcBBox $v2 CalcBBox $v3 # puts "rtvisTriangle $v1 $v2 $v3 $isStatic" lappend g_Draw(geom,$isStatic,cmd) \ "DrawTriangle \{$v1\} \{$v2\} \{$v3\} \{$g_Args(geom,$isStatic,color)\}" } # Announce a geometry object of type quad. # The vertices of the quad are given with "v1", "v2", "v3" and "v4". # v1, v2, v3, v4 are 3D vectors supplied as Tcl lists. # The optional parameter "isStatic" specifies, if the quad belongs # to the static world (1), or to the dynamic world (0). proc rtvisQuad { v1 v2 v3 v4 { isStatic 1 } } { global g_Args g_Draw CalcBBox $v1 CalcBBox $v2 CalcBBox $v3 CalcBBox $v4 # puts "rtvisQuad $v1 $v2 $v3 $v4 $isStatic" lappend g_Draw(geom,$isStatic,cmd) \ "DrawQuad \{$v1\} \{$v2\} \{$v3\} \{$v4\} \{$g_Args(geom,$isStatic,color)\}" } # Announce a geometry object of type box. # The box is specified by it's lower-left (ll) and upper-right corners "ur". # ll and ur are 3D vectors supplied as Tcl lists. # The optional parameter "isStatic" specifies, if the box belongs # to the static world (1), or to the dynamic world (0). proc rtvisBox { ll ur { isStatic 1 } } { global g_Args g_Draw CalcBBox $ll CalcBBox $ur # puts "rtvisBox $ll $ur $isStatic" lappend g_Draw(geom,$isStatic,cmd) \ "DrawBox \{$ll\} \{$ur\} \{$g_Args(geom,$isStatic,color)\}" } # Announce an AABB cell at level "level". # Note: Level numbering must start at 1 !! # The lower-left and upper-right corner of the cell are given with "ll" and "ur". # ll and ur are 3D vectors supplied as Tcl lists. # If using multiple acceleration structures, an identifier can be specified # as optional parameter "asId". This identifier can be any string. proc rtvisAABB { level ll ur { asId "AS" } } { global g_Args g_Draw g_AccStructs # puts "rtvisAABB $level $ll $ur $asId" if { ! [info exists g_AccStructs($asId,as)] } { set g_AccStructs($asId,as) 1 lappend g_AccStructs(asList) $asId if { [llength $g_AccStructs(asList)] == 1 } { set g_AccStructs($asId,color) $g_Args(aabb,0,color) } else { set g_AccStructs($asId,color) $g_Args(aabb,1,color) } } lappend g_Draw(aabb,$asId,$level,cmd) \ "DrawBox \{$ll\} \{$ur\} \{$g_AccStructs($asId,color)\}" } # Announce a bounding sphere at level "level". # Note: Level numbering must start at 1 !! # The center of the sphere is specified with "pos", it's radius with # parameter "radius". # pos is a 3D vectors supplied as a Tcl list. # If using multiple acceleration structures, an identifier can be specified # as optional parameter "asId". This identifier can be any string. proc rtvisBS { level pos radius { asId "AS" } } { global g_Args g_Draw g_AccStructs # puts "rtvisBS $level $pos $radius $asId" if { ! [info exists g_AccStructs($asId,as)] } { set g_AccStructs($asId,as) 1 lappend g_AccStructs(asList) $asId if { [llength $g_AccStructs(asList)] == 1 } { set g_AccStructs($asId,color) $g_Args(aabb,0,color) } else { set g_AccStructs($asId,color) $g_Args(aabb,1,color) } } lappend g_Draw(aabb,$asId,$level,cmd) \ "DrawSphere \{$pos\} \{$radius\} \{$g_AccStructs($asId,color)\}" } proc Max { a b } { if { $a > $b } { return $a } else { return $b } } proc LoadScriptFile { fileName } { global g_Args g_Draw g_Gui g_Img g_AccStructs InitVars ResetTfms PrintOut "Loading script file $fileName ..." uplevel #0 source [list $fileName] UpdateViewPoint PrintOut "Creating display lists ..." CreateDisplayLists foreach asId $g_AccStructs(asList) { $g_Gui(aabb,lbox) insert end $asId } $g_Gui(aabb,lbox) selection set 0 set g_AccStructs(curAsList) [lindex $g_AccStructs(asList) 0] UpdateAABBLevelBtns for { set thread 0 } { $thread < $g_Args(thread,maxThreads) } { incr thread } { if { [info exists g_Img(patches,threadNums,$thread)] } { $g_Gui(thread,$thread,cb) configure -state normal } else { $g_Gui(thread,$thread,cb) configure -state disabled } } UpdateTogl if { [info exists g_Draw(geom,1,cmd)] } { PrintOut "Number of static triangles : [llength $g_Draw(geom,1,cmd)]" } if { [info exists g_Draw(geom,0,cmd)] } { PrintOut "Number of dynamic triangles: [llength $g_Draw(geom,0,cmd)]" } if { [info exists g_Draw(lgt,cmd)] } { PrintOut "Number of lightsources : [llength $g_Draw(lgt,cmd)]" } if { [info exists g_Draw(ray,prim,cmd)] } { PrintOut "Number of primary rays : [llength $g_Draw(ray,prim,cmd)]" } if { [info exists g_Draw(ray,refl,cmd)] } { PrintOut "Number of reflected rays : [llength $g_Draw(ray,refl,cmd)]" } if { [info exists g_Draw(ray,shad,cmd)] } { PrintOut "Number of shadow rays : [llength $g_Draw(ray,shad,cmd)]" } if { [info exists g_AccStructs(asList)] } { foreach asId $g_AccStructs(asList) { set sumCells 0 for { set level 1 } { $level <= $g_Args(aabb,maxLevels) } { incr level } { if { [info exists g_Draw(aabb,$asId,$level,cmd)] } { PrintOut "$asId tree level $level has [llength $g_Draw(aabb,$asId,$level,cmd)] cells" incr sumCells [llength $g_Draw(aabb,$asId,$level,cmd)] } } PrintOut "$asId tree total number of cells: $sumCells" } } } proc DrawPatchRays { patchNum } { global g_Img g_Draw set coords [lindex $g_Img(patches,coords) $patchNum] set xmin [lindex $coords 0] set ymin [lindex $coords 1] set xmax [lindex $coords 2] set ymax [lindex $coords 3] set ymin [expr $g_Img(height) - $ymin] set ymax [expr $g_Img(height) - $ymax] if { [info exists g_Draw(pixel,dl)] } { glDeleteLists $g_Draw(pixel,dl) 1 } set g_Draw(pixel,dl) [glGenLists 1] glNewList $g_Draw(pixel,dl) GL_COMPILE for { set x $xmin } { $x <= $xmax } { incr x } { for { set y $ymax } { $y <= $ymin } { incr y } { if { [info exists g_Img(rays,$x,$y)] } { foreach cmd $g_Img(rays,$x,$y) { set retVal [catch {eval $cmd} errMsg] if { $retVal != 0 } { PrintOut "Error eval $cmd: $errMsg" } } } } } glEndList } proc DrawPixelRays { x y } { global g_Img g_Draw set y [expr $g_Img(height) - $y] # puts "DrawPixelRays $x $y" if { [info exists g_Draw(pixel,dl)] } { glDeleteLists $g_Draw(pixel,dl) 1 } if { [info exists g_Img(rays,$x,$y)] } { set g_Draw(pixel,dl) [glGenLists 1] glNewList $g_Draw(pixel,dl) GL_COMPILE foreach cmd $g_Img(rays,$x,$y) { # puts "\t$cmd" set retVal [catch {eval $cmd} errMsg] if { $retVal != 0 } { PrintOut "Error eval $cmd: $errMsg" } } glEndList } } proc UpdateAABBLevelBtns {} { global g_Gui g_Args g_Draw g_AccStructs for { set level 1 } { $level <= $g_Args(aabb,maxLevels) } { incr level } { $g_Gui(aabb,$level,cb) configure -state disabled } foreach asId $g_AccStructs(curAsList) { for { set level 1 } { $level <= $g_Args(aabb,maxLevels) } { incr level } { if { [info exists g_Draw(aabb,$asId,$level,cmd)] } { $g_Gui(aabb,$level,cb) configure -state normal } } } } proc GetListboxEntry { wid } { global g_AccStructs set indList [$wid curselection] if { [llength $indList] > 0 } { set g_AccStructs(curAsList) [list] foreach ind $indList { set val [$wid get $ind] lappend g_AccStructs(curAsList) $val } } UpdateAABBLevelBtns UpdateTogl } proc CreateDisplayLists {} { global g_Args g_Draw g_AccStructs foreach rayType { "prim" "refl" "shad" } { if { [info exists g_Draw(ray,$rayType,cmd)] } { if { [info exists g_Draw(ray,$rayType,dl)] } { glDeleteLists $g_Draw(ray,$rayType,dl) 1 } set g_Draw(ray,$rayType,dl) [glGenLists 1] glNewList $g_Draw(ray,$rayType,dl) GL_COMPILE foreach cmd $g_Draw(ray,$rayType,cmd) { set retVal [catch {eval $cmd} errMsg] if { $retVal != 0 } { PrintOut "Error eval $cmd: $errMsg" } } glEndList } } # Draw static geometry if { [info exists g_Draw(geom,1,cmd)] } { if { [info exists g_Draw(geom,1,dl)] } { glDeleteLists $g_Draw(geom,1,dl) 1 } set g_Draw(geom,1,dl) [glGenLists 1] glNewList $g_Draw(geom,1,dl) GL_COMPILE foreach cmd $g_Draw(geom,1,cmd) { set retVal [catch {eval $cmd} errMsg] if { $retVal != 0 } { PrintOut "Error eval $cmd: $errMsg" } } glEndList } # Draw dynamic geometry if { [info exists g_Draw(geom,0,cmd)] } { if { [info exists g_Draw(geom,0,dl)] } { glDeleteLists $g_Draw(geom,0,dl) 1 } set g_Draw(geom,0,dl) [glGenLists 1] glNewList $g_Draw(geom,0,dl) GL_COMPILE foreach cmd $g_Draw(geom,0,cmd) { set retVal [catch {eval $cmd} errMsg] if { $retVal != 0 } { PrintOut "Error eval $cmd: $errMsg" } } glEndList } if { [info exists g_Draw(lgt,cmd)] } { if { [info exists g_Draw(lgt,dl)] } { glDeleteLists $g_Draw(lgt,dl) 1 } set g_Draw(lgt,dl) [glGenLists 1] glNewList $g_Draw(lgt,dl) GL_COMPILE foreach cmd $g_Draw(lgt,cmd) { set retVal [catch {eval $cmd} errMsg] if { $retVal != 0 } { PrintOut "Error eval $cmd: $errMsg" } } glEndList } if { [info exists g_AccStructs(asList)] } { foreach asId $g_AccStructs(asList) { for { set level 1 } { $level <= $g_Args(aabb,maxLevels) } { incr level } { if { [info exists g_Draw(aabb,$asId,$level,cmd)] } { if { [info exists g_Draw(aabb,$asId,$level,dl)] } { glDeleteLists $g_Draw(aabb,$asId,$level,dl) 1 } set g_Draw(aabb,$asId,$level,dl) [glGenLists 1] glNewList $g_Draw(aabb,$asId,$level,dl) GL_COMPILE foreach cmd $g_Draw(aabb,$asId,$level,cmd) { set retVal [catch {eval $cmd} errMsg] if { $retVal != 0 } { PrintOut "Error eval $cmd: $errMsg" } } glEndList } } } } } proc CreateCallback { toglwin } { glClearColor 0.0 0.1 0.1 0 glEnable GL_DEPTH_TEST } proc ReshapeCallback { toglwin { w -1 } { h -1 } } { global g_Args g_Draw set w [$toglwin width] set h [$toglwin height] glViewport 0 0 $w $h glMatrixMode GL_PROJECTION glLoadIdentity gluPerspective $g_Args(fov) [expr double($w)/double($h)] 0.1 2000.0 glMatrixMode GL_MODELVIEW glLoadIdentity gluLookAt 0.0 0.0 $g_Draw(camDist) 0.0 0.0 0.0 0.0 1.0 0.0 } proc DisplayCallback { toglwin } { global g_Args g_Draw g_Gui g_AccStructs glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT] # Viewport command is not really needed, but has been inserted for # Mac OSX. Presentation framework (Tk) does not send a reshape event, # when switching from one demo to another. glViewport 0 0 [$toglwin width] [$toglwin height] glMatrixMode GL_MODELVIEW glLoadIdentity gluLookAt 0.0 0.0 $g_Draw(camDist) 0.0 0.0 0.0 0.0 1.0 0.0 glPushMatrix glTranslatef $g_Gui(tx) $g_Gui(ty) [expr {-1.0 * $g_Gui(tz)}] glRotatef $g_Gui(rx) 1.0 0.0 0.0 glRotatef $g_Gui(ry) 0.0 1.0 0.0 glRotatef $g_Gui(rz) 0.0 0.0 1.0 glTranslatef $g_Gui(rotCenX) $g_Gui(rotCenY) $g_Gui(rotCenZ) if { $g_Args(ray,show) } { if { $g_Args(ray,prim,show) && [info exists g_Draw(ray,prim,dl)] } { glCallList $g_Draw(ray,prim,dl) } if { $g_Args(ray,refl,show) && [info exists g_Draw(ray,refl,dl)] } { glCallList $g_Draw(ray,refl,dl) } if { $g_Args(ray,shad,show) && [info exists g_Draw(ray,shad,dl)] } { glCallList $g_Draw(ray,shad,dl) } } if { $g_Args(geom,show) } { if { $g_Args(geom,showStatic) && [info exists g_Draw(geom,1,dl)] } { glCallList $g_Draw(geom,1,dl) } if { $g_Args(geom,showDynamic) && [info exists g_Draw(geom,0,dl)] } { glCallList $g_Draw(geom,0,dl) } } if { $g_Args(lgt,show) } { if { [info exists g_Draw(lgt,dl)] } { glCallList $g_Draw(lgt,dl) } } if { $g_Args(aabb,show) } { foreach asId $g_AccStructs(curAsList) { for { set level 1 } { $level <= $g_Args(aabb,maxLevels) } { incr level } { if { $g_Args(aabb,$level,show) && [info exists g_Draw(aabb,$asId,$level,dl)] } { glCallList $g_Draw(aabb,$asId,$level,dl) } } } } if { [info exists g_Draw(pixel,dl)] } { glCallList $g_Draw(pixel,dl) } glPopMatrix $toglwin swapbuffers } proc UpdateTogl { { rebuildDisplayLists false } } { global g_Args g_Gui g_Img if { $rebuildDisplayLists } { CreateDisplayLists } DisplayCallback $g_Gui(toglwin) catch { $g_Gui(canvas) delete "Patches" } if { $g_Args(patches,show) && [info exists g_Img(patches,coords)] } { set patchNum 0 foreach coords $g_Img(patches,coords) thread $g_Img(patches,thread) { if { $g_Args(thread,$thread,show) } { $g_Gui(canvas) create rectangle $coords \ -tags [list "Patches" "P_$patchNum" "T_$thread"] $g_Gui(canvas) bind "P_$patchNum" <1> "DrawPatchRays $patchNum ; UpdateTogl" } incr patchNum } foreach key [array names g_Img "patches,threadNums,*"] { set thread [lindex [split $key ","] 2] $g_Gui(canvas) itemconfigure "T_$thread" \ -outline $g_Args(thread,$thread,color) } } } proc ToggleAABBLevels { onOff } { global g_Args for { set level 1 } { $level <= $g_Args(aabb,maxLevels) } { incr level } { set g_Args(aabb,$level,show) $onOff } UpdateTogl } # Trigger loading of a default ray-trace file when running from within a starpack. proc StartAnimation {} { global g_ScriptDir g_Gui g_Args LoadScriptFile [file join $g_ScriptDir "as-Teapot.rt"] set g_Gui(tz) 10.0 set g_Args(ray,prim,show) 0 UpdateTogl } proc Cleanup { { fullCleanup true } } { global g_Gui g_Photo InitVars if { $fullCleanup } { if { [info exists g_Photo] } { image delete $g_Photo } foreach var [info globals g_*] { uplevel #0 unset $var } } } proc ExitProg {} { exit } proc AskOpen {} { set fileTypes { { "RT files" "*.rt" } { "All files" * } } if { $::tcl_platform(os) eq "Darwin" && [info exists ::starkit::topdir] } { set fileName [::tk::dialog::file:: open -filetypes $fileTypes \ -initialdir $::g_LastDir] } else { set fileName [tk_getOpenFile -filetypes $fileTypes \ -initialdir $::g_LastDir] } if { $fileName != "" } { set ::g_LastDir [file dirname $fileName] LoadScriptFile $fileName } } # Start of main program. InitVars ResetTfms set g_Gui(viewPoint) "geometry" set g_Gui(transScale) 0.1 frame .fr pack .fr -expand 1 -fill both # Create the main widgets and frames. set g_Gui(toglwin) .fr.toglwin togl $g_Gui(toglwin) -width $g_WinWidth -height $g_WinHeight \ -swapinterval 0 \ -double true -depth true \ -displayproc DisplayCallback \ -reshapeproc ReshapeCallback \ -createproc CreateCallback frame .fr.btns frame .fr.imgs frame .fr.out label .fr.info grid $g_Gui(toglwin) -row 0 -column 0 -sticky news grid .fr.btns -row 0 -column 1 -sticky new grid .fr.imgs -row 1 -column 0 -sticky new -columnspan 2 grid .fr.info -row 2 -column 0 -sticky news -columnspan 2 grid rowconfigure .fr 0 -weight 1 grid columnconfigure .fr 0 -weight 1 # Fill the btns frame. frame .fr.btns.frLoad pack .fr.btns.frLoad -side top -expand true -fill x radiobutton .fr.btns.frLoad.oriView -text "CoR: Origin" -variable g_Gui(viewPoint) \ -value "origin" -command UpdateViewPoint radiobutton .fr.btns.frLoad.midView -text "CoR: Geometry" -variable g_Gui(viewPoint) \ -value "geometry" -command UpdateViewPoint tcl3dToolhelpAddBinding .fr.btns.frLoad.oriView "Set center of rotation to origin" tcl3dToolhelpAddBinding .fr.btns.frLoad.midView "Set center of rotation to center of geometry" button .fr.btns.frLoad.open -text "Load script ..." -command AskOpen eval pack [winfo children .fr.btns.frLoad] -side left -anchor w -expand 1 -fill x # - Checkboxes to choose the types of information being displayed. frame .fr.btns.frRays pack .fr.btns.frRays -side top -expand true -fill x frame .fr.btns.frRays.frMain frame .fr.btns.frRays.frOpts eval pack [winfo children .fr.btns.frRays] -side top -anchor w -expand 1 -fill x checkbutton .fr.btns.frRays.frMain.showRays -variable g_Args(ray,show) \ -text "Show rays" -anchor w -bg gray -command UpdateTogl eval pack [winfo children .fr.btns.frRays.frMain] -side top -anchor w -expand 1 -fill x checkbutton .fr.btns.frRays.frOpts.showPrim -variable g_Args(ray,prim,show) \ -text "Primary" -anchor w -command UpdateTogl checkbutton .fr.btns.frRays.frOpts.showRefl -variable g_Args(ray,refl,show) \ -text "Reflected" -anchor w -command UpdateTogl checkbutton .fr.btns.frRays.frOpts.showShad -variable g_Args(ray,shad,show) \ -text "Shadow" -anchor w -command UpdateTogl eval pack [winfo children .fr.btns.frRays.frOpts] -side left -anchor w -expand 1 -fill x frame .fr.btns.frGeom pack .fr.btns.frGeom -side top -expand true -fill x frame .fr.btns.frGeom.frMain frame .fr.btns.frGeom.frOpts eval pack [winfo children .fr.btns.frGeom] -side top -anchor w -expand 1 -fill x checkbutton .fr.btns.frGeom.frMain.showGeom -variable g_Args(geom,show) \ -text "Show geometry" -anchor w -bg gray -command UpdateTogl eval pack [winfo children .fr.btns.frGeom.frMain] -side top -anchor w -expand 1 -fill x checkbutton .fr.btns.frGeom.frOpts.showGeom1 -variable g_Args(geom,showStatic) \ -text "Static" -anchor w -command "UpdateTogl" checkbutton .fr.btns.frGeom.frOpts.showGeom0 -variable g_Args(geom,showDynamic) \ -text "Dynamic" -anchor w -command "UpdateTogl" checkbutton .fr.btns.frGeom.frOpts.useLines -variable g_Args(geom,useLines) \ -text "Lines" -anchor w -command "UpdateTogl true" eval pack [winfo children .fr.btns.frGeom.frOpts] -side left -anchor w -expand 1 -fill x frame .fr.btns.frLgt pack .fr.btns.frLgt -side top -expand true -fill x checkbutton .fr.btns.frLgt.showLgt -variable g_Args(lgt,show) \ -text "Show lightsources" -anchor w -bg gray -command UpdateTogl checkbutton .fr.btns.frLgt.useLines -variable g_Args(lgt,useLines) \ -text "Lines" -anchor w -command "UpdateTogl true" eval pack [winfo children .fr.btns.frLgt] -side top -anchor w -expand 1 -fill x frame .fr.btns.frAABB pack .fr.btns.frAABB -side top -expand true -fill x checkbutton .fr.btns.frAABB.showAABB -variable g_Args(aabb,show) \ -text "Show acc. structures" -anchor w -bg gray -command UpdateTogl checkbutton .fr.btns.frAABB.useLines -variable g_Args(aabb,useLines) \ -text "Lines" -anchor w -command "UpdateTogl true" frame .fr.btns.frAABB.frLB eval pack [winfo children .fr.btns.frAABB] -side top -anchor w -expand 1 -fill x set g_Gui(aabb,lbox) [tcl3dCreateScrolledListbox \ .fr.btns.frAABB.frLB "" -height 3 -selectmode extended \ -exportselection false] bind $g_Gui(aabb,lbox) <> "GetListboxEntry $g_Gui(aabb,lbox)" labelframe .fr.btns.frLev -text "Levels" pack .fr.btns.frLev -side top -expand true -fill x set row 0 set col 0 for { set level 1 } { $level <= $g_Args(aabb,maxLevels) } { incr level } { checkbutton .fr.btns.frLev.cb_$row$col -variable g_Args(aabb,$level,show) \ -text $level -anchor w -state disabled -command UpdateTogl set g_Gui(aabb,$level,cb) .fr.btns.frLev.cb_$row$col grid .fr.btns.frLev.cb_$row$col -row $row -column $col incr col if { $col % $g_Args(aabb,numLevelColumns) == 0 } { incr row set col 0 } } button .fr.btns.frLev.b_on -text "All on" -command "ToggleAABBLevels 1" button .fr.btns.frLev.b_off -text "All off" -command "ToggleAABBLevels 0" grid .fr.btns.frLev.b_on -row $row -column 0 -columnspan 2 -sticky nwe grid .fr.btns.frLev.b_off -row $row -column 2 -columnspan 2 -sticky nwe frame .fr.btns.frPatches pack .fr.btns.frPatches -side top -expand true -fill x checkbutton .fr.btns.frPatches.showPatches -variable g_Args(patches,show) \ -text "Show patches" -anchor w -bg gray -command UpdateTogl eval pack [winfo children .fr.btns.frPatches] -side top -anchor w -expand 1 -fill x labelframe .fr.btns.frThreads -text "Threads" pack .fr.btns.frThreads -side top -expand true -fill x set row 0 set col 0 for { set thread 0 } { $thread < $g_Args(thread,maxThreads) } { incr thread } { checkbutton .fr.btns.frThreads.cb_$row$col -variable g_Args(thread,$thread,show) \ -text $thread -anchor w -state disabled -command UpdateTogl set g_Gui(thread,$thread,cb) .fr.btns.frThreads.cb_$row$col grid .fr.btns.frThreads.cb_$row$col -row $row -column $col -sticky nwe incr col if { $col % $g_Args(thread,numThreadColumns) == 0 } { incr row set col 0 } } # - A canvas for displaying the rendered image. # - Checkboxes to choose thread dependent patch (tile) display. set g_Gui(canvas) .fr.imgs.c canvas $g_Gui(canvas) -borderwidth 0 -relief flat -highlightthickness 0 \ -width 100 -height 100 $g_Gui(canvas) create image 0 0 -image $g_Photo -anchor nw -tags "Image" eval pack [winfo children .fr.imgs] -side left -anchor w -expand 1 frame .fr.imgs.frOut pack .fr.imgs.frOut -side top -expand true -fill both set g_Gui(out) [tcl3dCreateScrolledText .fr.imgs.frOut "Output messages" \ -height 10 -borderwidth 1] $g_Gui(canvas) bind "Image" <1> "DrawPixelRays %x %y ; UpdateTogl" if { $::tcl_platform(os) eq "Darwin" } { bind .fr.toglwin <1> {set cx %x; set cy %y} bind .fr.toglwin <3> {set cx %x; set cy %y} bind .fr.toglwin <2> {set cx %x; set cy %y} bind .fr.toglwin {HandleRot %x %y %W} bind .fr.toglwin {HandleTrans X %x %y %W} bind .fr.toglwin {HandleTrans Z %x %y %W} } else { bind .fr.toglwin <1> {set cx %x; set cy %y} bind .fr.toglwin <2> {set cx %x; set cy %y} bind .fr.toglwin <3> {set cx %x; set cy %y} bind .fr.toglwin {HandleRot %x %y %W} bind .fr.toglwin {HandleTrans X %x %y %W} bind .fr.toglwin {HandleTrans Z %x %y %W} } bind . "IncrTransScale 0.1" bind . "IncrTransScale -0.1" wm title . "Tcl3D demo: Ray-Tracing visualization" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind . "ExitProg" PrintInfo [format "Running on %s with a %s (OpenGL %s, Tcl %s)" \ $tcl_platform(os) [glGetString GL_RENDERER] \ [glGetString GL_VERSION] [info patchlevel]] if { [file tail [info script]] eq [file tail $::argv0] } { # If started directly from tclsh or wish, then check for commandline parameters. if { $argc >= 1 } { LoadScriptFile [lindex $argv 0] } }