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
exit2008-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