Scene

3D widget using OpenGL for rendering. Part of the eTcl distribution for Win32, Linux and MacOS X.

http://www.evolane.com/software/scene/index.html

or

http://www.evolane.com/software/

2007-09-30 EH A simple sample to plot a 3D surface for function f(x,y). Use left button to rotate scene, right button to zoom in/out.

   # Load packages
   package require Tk
   package require scene

   proc hsv2rgb {h s v} {
     if {$s<1.e-6} {
       return [list $v $v $v]
     }

     set h [expr {fmod($h/60.,6.)}]

     set f [expr {fmod($h,1.)}]
     set p [expr {$v*(1.-$s)}]
     set q [expr {$v*(1.-$s*$f)}]
     set t [expr {$v*(1.-$s*(1.-$f))}]

     if {$h<1.0} {
       return [list $v $t $p]
     }
     if {$h<2.0} {
       return [list $q $v $p]
     }
     if {$h<3.0} {
       return [list $p $v $t]
     }
     if {$h<4.0} {
       return [list $p $q $v]
     }
     if {$h<5.0} {
       return [list $t $p $v]
     }

     return [list $v $p $q]
   }

   proc plot3dShape {w} {
     variable plot3d

     if {![info exists plot3d(shape)] || !$plot3d(shape)} {
       set plot3d(shape) 1
       $w render
     }
   }

   proc plot3dRedraw {w clist} {
     variable plot3d

     foreach l $clist {
       $w lcall $l
     }

     if {[info exists plot3d(shape)] && $plot3d(shape)} {
       # Capture scene content with transparency
       # into a Tk photo
       set img [$w dump]

       # Apply shape
       catch {shape set [winfo toplevel $w] -bound photo $img}

       # Drop image
       image delete $img
     }
   }

   proc plot3d {w f} {
     set xmin -1
     set xmax 1

     set ymin -1
     set ymax 1

     set zmin 0.0
     set zmax 0.0

     set nbx  50
     set nby  50

     set gridx 2
     set gridy 2

     for {set nx 0} {$nx<=$nbx} {incr nx} {
       for {set ny 0} {$ny<=$nby} {incr ny} {
         set x [expr {$xmin+(($xmax-$xmin)*$nx)/double($nbx)}]
         set y [expr {$ymin+(($ymax-$ymin)*$ny)/double($nby)}]

         set z [eval $f $x $y]

         if {$z<$zmin} {
           set zmin $z
         }
         if {$z>$zmax} {
           set zmax $z
         }

         set vertex($nx,$ny) [list $x $y $z]
       }
     }

     # Compile list
     set surfaceid [$w lbegin]

     # Draw surface
     $w enable offset
     $w begin quads
     for {set nx 0} {$nx<$nbx} {incr nx} {
       for {set ny 0} {$ny<$nby} {incr ny} {

         set z [lindex $vertex($nx,$ny) 2]

         # Up side (in color)
         if {0} {
           set hue [expr {360.0*(0.2+0.7*($z-$zmin)/($zmax-$zmin))}]
           set color [hsv2rgb $hue 1.0 0.8]
           $w color $color
         } else {
           set red   [expr {0.2+(0.7*$nx)/double($nbx)}]
           set green [expr {0.2+(0.7*$ny)/double($nby)}]
           set blue  [expr {0.2+0.7*($z-$zmin)/($zmax-$zmin)}]
           $w color  [list $red $green $blue]
         }

         eval $w vertex $vertex($nx,$ny)
         incr ny
         eval $w vertex $vertex($nx,$ny)
         incr nx
         eval $w vertex $vertex($nx,$ny)
         incr ny -1
         eval $w vertex $vertex($nx,$ny)
         incr nx -1

         # Down side (in grayscale)
         set gray  [expr {0.5+0.45*($z-$zmin)/($zmax-$zmin)}]
         $w color $gray

         eval $w vertex $vertex($nx,$ny)
         incr nx
         eval $w vertex $vertex($nx,$ny)
         incr ny
         eval $w vertex $vertex($nx,$ny)
         incr nx -1
         eval $w vertex $vertex($nx,$ny)
         incr ny -1
       }
     }
     $w end
     $w disable offset

     $w lend


     # Draw grid
     set gridid [$w lbegin]
     $w color [list 0 0 0]

     for {set nx 0} {$nx<=$nbx} {incr nx $gridx} {
       $w begin line_strip
       for {set ny 0} {$ny<=$nby} {incr ny} {
         eval $w vertex $vertex($nx,$ny)
       }  
       $w end
     }

     for {set ny 0} {$ny<=$nby} {incr ny $gridy} {
       $w begin line_strip
       for {set nx 0} {$nx<=$nbx} {incr nx} {
         eval $w vertex $vertex($nx,$ny)
       }
       $w end
     }

     $w lend

     # Draw bbox
     set boxid [$w lbegin]
     $w color [list 30 20 20]

     $w begin line_loop
     $w vertex $xmin $ymin $zmin
     $w vertex $xmax $ymin $zmin
     $w vertex $xmax $ymax $zmin
     $w vertex $xmin $ymax $zmin
     $w vertex $xmin $ymin $zmin
     $w end

     $w begin line_loop
     $w vertex $xmin $ymin $zmax
     $w vertex $xmax $ymin $zmax
     $w vertex $xmax $ymax $zmax
     $w vertex $xmin $ymax $zmax
     $w vertex $xmin $ymin $zmax
     $w end

     foreach x [list $xmin $xmax] {
       foreach y [list $ymin $ymax] {
         $w begin lines
         $w vertex $x $y $zmin
         $w vertex $x $y $zmax
         $w end
       }
     }
     $w lend

     # Callback to redraw/render scene
     set cmd [list plot3dRedraw $w [list $surfaceid $gridid $boxid]]
     $w configure -redraw $cmd
   }

   # Function to plot
   proc f {x y} {
     return [expr {cos(16.*($x*$x+$y*$y))/(1.+16.*($x*$x+$y*$y))}]
   }

   proc main {} {
     set w [scene .toto -width 320 -height 320 -bg black]
     pack $w -fill both -expand true

     $w navigate -mode camera
     $w enable cull_face
     plot3d $w f

     # Adding transparency (to see desktop behind scene) is still experimental
     #wm overrideredirect [winfo toplevel $w] 1
     #if {![catch {package require shape}]} {
     #  bind $w <Button-3> [list after idle [list plot3dShape $w]]
     #}

     tkwait window $w
     return
   }

   main
   exit

Category 3D Graphics