orhttp://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
exitCategory 3D Graphics
