Scene

 

Un widget de rendu 3D basé sur [OpenGL]. Cette extension fait partie des distributions eTcl pour Win32, Linux and MacOSX.

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


2007-09-30 EH Un exemple simple de rendu de surface 3D pour une fonction mathématique f(x,y). Le bouton gauche de la souris permet de faire tourner la figure, le bouton droit de zoomer.

   # 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

2008-03-02 EH Un aute exemple, pour afficher un cube avec surfaces eclairées. Pour faire tourner le cube, cliquer avec le bouton gauche de la souris et se déplacer.

   #!/bin/sh
   # the next line restarts using wish \
   exec tclsh "$0" "$@"

   # Load packages
   package require Tk
   package require scene

   # Generic toolkit
   proc VectorCross {dx0 dy0 dz0 dx1 dy1 dz1} {
     set n0 [expr {$dy0*$dz1-$dz0*$dy1}]
     set n1 [expr {$dz0*$dx1-$dx0*$dz1}]
     set n2 [expr {$dx0*$dy1-$dy0*$dx1}]

     return [list $n0 $n1 $n2]
   }

   proc VectorUnitize {dx dy dz} {
     set norm [expr {sqrt($dx*$dx+$dy*$dy+$dz*$dz)}]

     if {$norm>0.0} {
       set dx [expr {$dx/$norm}]
       set dy [expr {$dy/$norm}]
       set dz [expr {$dz/$norm}]
     }

     return [list $dx $dy $dz]
   }

   proc ComputeNormal {x0 y0 z0 x1 y1 z1 x2 y2 z2} {
     set dx0 [expr {$x1-$x0}]
     set dy0 [expr {$y1-$y0}]
     set dz0 [expr {$z1-$z0}]

     set dx1 [expr {$x2-$x0}]
     set dy1 [expr {$y2-$y0}]
     set dz1 [expr {$z2-$z0}]

     return [VectorCross $dx0 $dy0 $dz0 $dx1 $dy1 $dz1]
   }

   proc FaceMaterial {w} {
     set alpha 0.7

     $w color [list 0 1.0 0.0 $alpha]

     $w material                       \
         -side     front               \
         -ambient  [list 1 0 0 $alpha] \
         -diffuse  [list 0 0 1 $alpha] \
         -specular [list 0 1 0 $alpha] \
         -emission [list 0.3 0.2 0.2 0.0] \
         -shininess 10.0

     return
   }

   proc DrawSolid {w lv z0 z1 texid} {
     if {[string compare "" $texid]} {
       set hastex 1
     } else {
       set hastex 0
     }

     set listid [$w lbegin]

     # Draw base
     $w begin polygon
     FaceMaterial $w
     $w normal 0.0 0.0 1.0
     foreach v $lv {
       eval $w vertex $v $z1
     }
     $w end

     # Draw top
     $w begin polygon
     FaceMaterial $w
     $w normal 0.0 0.0 -1.0
     for {set cpt [expr {[llength $lv]-1}]} {$cpt>=0} {incr cpt -1} {
       eval $w vertex [lindex $lv $cpt] $z0
     }
     $w end

     # Draw faces
     $w begin quads
     FaceMaterial $w

     set p0 [lindex $lv end]
     foreach p1 $lv {
       set n [eval VectorUnitize [eval ComputeNormal $p0 $z0 $p1 $z0 $p0 $z1]]
       eval [list $w normal] $n

       if {$hastex} {
         $w texmode modulate
         $w material -texture $texid
       }

       if {$hastex} { $w material -texcoords 0.0 0.0 }
       eval $w vertex $p0 $z0
       if {$hastex} { $w material -texcoords 1.0 0.0 }
       eval $w vertex $p1 $z0
       if {$hastex} { $w material -texcoords 1.0 1.0 }
       eval $w vertex $p1 $z1
       if {$hastex} { $w material -texcoords 0.0 1.0 }
       eval $w vertex $p0 $z1

       set p0 $p1
     }

     $w end

     # End of compiled list
     $w lend

     return $listid
   }

   proc cube {w P0 D0 {texid ""}} {
     foreach {x0 y0 z0} $P0 {break}
     foreach {dx dy dz} $D0 {break}

     set x1 [expr {$x0+$dx}]
     set y1 [expr {$y0+$dy}]
     set z1 [expr {$z0+$dz}]

     set lv {}
     lappend lv [list $x0 $y0]
     lappend lv [list $x1 $y0]
     lappend lv [list $x1 $y1]
     lappend lv [list $x0 $y1]

     return [DrawSolid $w $lv $z0 $z1 $texid]
   }

   proc sceneRedrawCB {w clist} {
     variable plot3d

     foreach l $clist {
       $w lcall $l
     }
   }

   proc prepare {w} {
     $w navigate -mode camera

     $w enable cull_face
     $w enable lighting
     $w enable light0
     $w enable blend
     $w enable texture_2d

     # List of objects to render
     set litems [list]

     # Add cube
     lappend litems [cube $w {-0.5 -0.5 -0.5} {1.0 1.0 1.0}]

     # Callback to redraw/render scene
     set cmd [list sceneRedrawCB $w [list $litems]]
     $w configure -redraw $cmd
   }

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

     prepare $w

     tkwait window $w
     return
   }

   main
   exit