Marco Maggi Interesting. Will this always work? I mean: hidden lines will be hidden correctly for all the functions?AM It relies on the so-called "painter's algorithm" - draw the objects in the back first and work your way forwards. This is somewhat hidden in the proc drawFunction (hence the use of the vectors for calculating the corners of the rectangles) and the range of the viewpoint coordinates. Part of the work to make it more general is to decide what the two vectors should be ... But apart from that: yes, the algorithm is robust (and cheap)
The code below contains several examples of functions that can be viewed.
# view3d.tcl --
# Simple 3D viewer for functions of two independent variables
#
package require Tk
# project2d --
# Project points in 3D space onto a 2D canvas
# Arguments:
# xyzcrd List of coordinate triplets
# Result:
# List of xy-coordinates on the canvas
# Note:
# Requires previous definition of viewpoint
#
proc project2d {xyzcrd} {
variable project_params
foreach {x1 y1 z1 x2 y2 z2} $project_params {break}
foreach {x y z} $xyzcrd {
set xc [expr {220.0+$x*$x1+$y*$y1+$z*$z1}]
set yc [expr {320.0-($x*$x2+$y*$y2+$z*$z2)}]
lappend result $xc $yc
}
return $result
}
# setViewpoint --
# Define the viewpoint
# Arguments:
# xv X-coordinate of viewpoint
# yv Y-coordinate of viewpoint
# zv Z-coordinate of viewpoint
# Result:
# None
# Side effect:
# Variable project_params filled
#
proc setViewpoint {xv yv zv} {
variable project_params
set x1 $yv
set y1 [expr {-$xv}]
set z1 0.0
set x2 [expr {$xv*$zv}]
set y2 [expr {$yv*$zv}]
set z2 [expr {$xv*$xv+$yv*$yv}]
set r [expr {sqrt($x1*$x1+$y1*$y1+$z1*$z1)/200.0}]
set x1 [expr {$x1/$r}]
set y1 [expr {$y1/$r}]
set z1 [expr {$z1/$r}]
set r [expr {sqrt($x2*$x2+$y2*$y2+$z2*$z2)/200.0}]
set x2 [expr {$x2/$r}]
set y2 [expr {$y2/$r}]
set z2 [expr {$z2/$r}]
set project_params [list $x1 $y1 $z1 $x2 $y2 $z2]
}
# drawFunction --
# Draw the function using a range of -1,1 for both x and y
# Arguments:
# func Expression taking x and y as arguments
# Result:
# None
# Note:
# Assumes a viewpoint from the right angle (i.e. xv < 0)
#
proc drawFunction {func} {
set nostps 20
set x10 -1.0
set y10 0.0
set dx1 [expr {2.0/$nostps}]
set dy1 0.0
set x20 0.0
set y20 -1.0
set dx2 0.0
set dy2 [expr {2.0/$nostps}]
for {set j 0} {$j < $nostps} {incr j} {
for {set i 0} {$i < $nostps} {incr i} {
set x1 [expr {$x10+$dx1*$i+$x20+$dx2*$j}]
set y1 [expr {$y10+$dy1*$i+$y20+$dy2*$j}]
set x2 [expr {$x1+$dx1}]
set y2 [expr {$y1+$dy1}]
set x3 [expr {$x2+$dx2}]
set y3 [expr {$y2+$dy2}]
set x4 [expr {$x3-$dx1}]
set y4 [expr {$y3-$dy1}]
set x $x1; set y $y1; set z1 [expr $func]
set x $x2; set y $y2; set z2 [expr $func]
set x $x3; set y $y3; set z3 [expr $func]
set x $x4; set y $y4; set z4 [expr $func]
set crds [project2d [list $x1 $y1 $z1 \
$x2 $y2 $z2 \
$x3 $y3 $z3 \
$x4 $y4 $z4 ] ]
.c create polygon $crds -fill white -outline black
}
}
}
# main --
# Main code:
# - Create the canvas
# - Set a viewpoint
# - Draw some function
#
canvas .c -background white -width 500 -height 500
pack .c -fill both
set count 0
proc draw {} {
global count
set zp [expr {3.0+2.0*sin(0.02*$count)}]
incr count
setViewpoint -3.0 -2.0 $zp
.c delete all
#drawFunction {(0.7-($x*$x+$y*$y))*(0.7-($x*$x+$y*$y))}
#drawFunction {$x*(0.5-$x)*(0.5-($y*$y))}
drawFunction {cos(3.0*$x)*cos(3.0*$y)}
after 10 draw
}
after 0 drawMarco Maggi I hope that AM won't mind if I steal all the fun with the script below... =) I've added some bits. I've removed the animation because my old computer was making a nuisance of itself.AM is slightly jealous :)There's still work to do: the graph is not centered in the canvas, this is because I was not able to do reverse engineering on the code in [setViewpoint]: AM what are you doing here? I thought that in the general case we have to use homogeneous coordinates and consider similarities between triangles...AM Actually in [setViewpoint] I am doing much the same as you are doing in the procs to set up the transformation matrices, only a bit more hidden and I use the distance instead of three independent scaling factors ... I find that to be a more intuitive concept - just increase the distance to get an overview (instead of changing three numbers at the same time). Perhaps use the angles and the distance to set the viewpoint?Also the zoom function is disabled: how to zoom a canvas?I think that it would be useful to draw also walls (portions of planes) to delimit the interested ranges of coordinates and maybe add some text tag.AM Yes, that would be a welcome additionMaybe someone can suggest a procedure to compute a colored gradient to draw the graph levels.Suggestions about speed optimisation are welcome.AM I noticed that you use arrays, rather than lists - access to elements in a list is faster. Also, combining the two transformations into one single step might help.I wonder what would be required to fly through the dunes of a function...
# plot3d.tcl --
package require Tk
proc log { string } {
#puts stderr $string
}
#PAGE
# main --
#
# Main procedure. Initialises the data structures and draw
# the initial plot.
#
# Arguments:
#
# argc - the number of arguments in argv
# argv - the command line arguments
#
# Results:
#
# Returns the empty string.
#
# Error codes:
#
# None.
#
# Side effects:
#
# None.
#
proc main { argc argv } {
global forever display data config gui_state
# xmin - the "left" bound of the x coordinate
# xmax - the "right" bound of the x coordinate
# ymin - the "left" bound of the y coordinate
# ymax - the "right" bound of the y coordinate
# xsteps - the number of lines to draw for the x coord
# ysteps - the number of lines to draw for the y coord
array set data {
XVALUES {} YVALUES {}
}
array set display {
PROJECT_MATRIX {} NORMALISE_MATRIX {}
}
array set config {
LONGITUDE 30 LATITUDE 45
XNORM 1.0 YNORM 1.0 ZNORM 1.0
XMIN -1.0 XMAX 1.0
YMIN -1.0 YMAX 1.0
XSTEPS 20 YSTEPS 20
COLOR gray
FUNCTION {cos(3.0*$x)*cos(3.0*$y)}
}
array set gui_state [array get config]
gui
wm deiconify .
tkwait visibility .
update idletasks
set config(CANVAS) $gui_state(CANVAS)
compute_projection_matrix config display
sample config data
compute_normalisation_matrix config display
plot config display data
vwait forever
exit 0
}
#PAGE
# gui --
#
# Builds the GUI. The state of the values is stored in the
# global array "gui_state": its members are the same as the
# ones in the global array "config".
#
# Arguments:
#
# None.
#
# Results:
#
# Returns the empty string.
#
# Error codes:
#
# None.
#
# Side effects:
#
# None.
#
proc gui {} {
global gui_state
wm withdraw .
wm title . "Plot 3D"
wm geometry . +30+30
option add *borderWidth 1
option add *canvas.background white
option add *canvas.width 200m
option add *canvas.height 150m
option add *canvas.borderWidth 2
option add *canvas.relief sunken
option add *exit.text "Exit"
option add *draw.text "Draw"
option add *Spinbox.from -10.0
option add *Spinbox.to 10.0
option add *Spinbox.increment 0.1
option add *Spinbox.width 6
option add *Spinbox.background white
option add *Spinbox.justify right
option add *color.justify left
option add *Labelframe.relief groove
option add *Labelframe.borderWidth 2
option add *viewpoint.text "Viewpoint"
option add *xrange.text "X Range"
option add *yrange.text "Y Range"
option add *steps.text "Steps"
option add *display.text "Display"
option add *funclab.text "Expression:"
option add *lonlab.text "Long:"
option add *latlab.text "Lat:"
option add *xlab.text "X:"
option add *ylab.text "Y:"
option add *minlab.text "Min:"
option add *maxlab.text "Max:"
option add *xnormlab.text "X scale:"
option add *ynormlab.text "Y scale:"
option add *znormlab.text "Z scale:"
option add *collab.text "Color:"
option add *sclab.text "Zoom:"
option add *Label.anchor w
option add *Label.justify left
option add *Entry.background white
option add *Entry.relief sunken
option add *Entry.borderWidth 1
# Left and right frames.
frame [set l .left]
frame [set r .right]
grid $l $r
grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1
# Canvas.
set c $l.canvas
canvas $c
grid $c -sticky news -padx 5 -pady 5
set ::gui_state(CANVAS) $c
# Function entry.
set f $l.func
frame $f
label $f.funclab
entry $f.entry -textvariable ::gui_state(FUNCTION)
grid $f.funclab -row 0 -column 0
grid $f.entry -row 0 -column 1 -sticky news
grid columnconfigure $f 0 -weight 0
grid columnconfigure $f 1 -weight 1
grid $f -sticky news -padx 5
unset f
# View point.
set f $r.viewpoint
labelframe $f
label $f.lonlab
label $f.latlab
spinbox $f.longitude -textvariable ::gui_state(LONGITUDE) \
-from 0 -to 359 -increment 1
spinbox $f.latitude -textvariable ::gui_state(LATITUDE) \
-from 0 -to 359 -increment 1
grid $f.lonlab $f.longitude -sticky news
grid $f.latlab $f.latitude -sticky news
grid $f -row 0 -column 0 -sticky news -padx 5
unset f
# X range.
set f $r.xrange
labelframe $f
label $f.minlab; label $f.maxlab
spinbox $f.xmin -textvariable ::gui_state(XMIN)
spinbox $f.xmax -textvariable ::gui_state(XMAX)
grid $f.minlab $f.xmin -sticky news
grid $f.maxlab $f.xmax -sticky news
grid $f -row 1 -column 0 -sticky news -padx 5
unset f
# Y range.
set f $r.yrange
labelframe $f
label $f.minlab; label $f.maxlab
spinbox $f.ymin -textvariable ::gui_state(YMIN)
spinbox $f.ymax -textvariable ::gui_state(YMAX)
grid $f.minlab $f.ymin -sticky news
grid $f.maxlab $f.ymax -sticky news
grid $f -row 2 -column 0 -sticky news -padx 5
unset f
# Steps.
set f $r.steps
labelframe $f
label $f.xlab
label $f.ylab
spinbox $f.xsteps -from 10 -to 100 -increment 1 \
-textvariable ::gui_state(XSTEPS)
spinbox $f.ysteps -from 10 -to 100 -increment 1 \
-textvariable ::gui_state(YSTEPS)
grid $f.xlab $f.xsteps -sticky news
grid $f.ylab $f.ysteps -sticky news
grid $f -row 3 -column 0 -sticky news -padx 5
unset f
# Display.
set f $r.display
labelframe $f
label $f.sclab
label $f.xnormlab
label $f.ynormlab
label $f.znormlab
label $f.collab
spinbox $f.scale -from -100 -to 100 -increment 1 \
-textvariable ::gui_state(SCALE) -state disabled
spinbox $f.xnorm -textvariable ::gui_state(XNORM)
spinbox $f.ynorm -textvariable ::gui_state(YNORM)
spinbox $f.znorm -textvariable ::gui_state(ZNORM)
spinbox $f.color -textvariable ::gui_state(COLOR) \
-values { gray white green }
grid $f.sclab $f.scale -sticky news
grid $f.xnormlab $f.xnorm -sticky news
grid $f.ynormlab $f.ynorm -sticky news
grid $f.znormlab $f.znorm -sticky news
grid $f.collab $f.color -sticky news
grid $f -row 4 -column 0 -sticky news -padx 5
unset f
# Button bar.
set f $r.bbar
frame $f
button $f.exit -command { quit }
button $f.draw -command { redraw }
bind $f.exit <Return> "$f.exit invoke"
bind $f.draw <Return> "$f.draw invoke"
focus $f.exit
grid $f.exit $f.draw
grid $f -row 5 -column 0 -sticky news -padx 5 -pady 5
unset f
return
}
#PAGE
# redraw --
#
# Redraws the plot. This procedure is bound to the "Draw"
# button widget.
#
# Arguments:
#
# None.
#
# Results:
#
# Checks if the plotting needs a refresh in both the samples
# and the view or only in the view; recomputes what's needed
# and updates the plot.
#
# Returns the empty string.
#
# Error codes:
#
# None.
#
# Side effects:
#
# None.
#
proc redraw {} {
upvar ::config config ::gui_state gui_state \
::data data ::display display
set update_view 0
set update_samples 0
foreach { min max } { XMIN XMAX YMIN YMAX } {
if { $gui_state($min) > $gui_state($max) } {
log "reversing $min,$max"
set a $gui_state($min)
set gui_state($min) $gui_state($max)
set gui_state($max) $a
}
}
foreach k { FUNCTION XSTEPS YSTEPS XMIN XMAX YMIN YMAX } {
if { $gui_state($k) != $config($k) } {
set update_samples 1
set update_view 1
break
}
}
if { ! $update_samples } {
foreach k { LONGITUDE LATITUDE XNORM YNORM ZNORM } {
if { $gui_state($k) != $config($k) } {
set update_view 1
break
}
}
}
array set config [array get gui_state]
if { $update_view } {
compute_projection_matrix config display
compute_normalisation_matrix config display
}
if { $update_samples } {
sample config data
compute_normalisation_matrix config display
}
plot config display data
return
}
#PAGE
# sample --
#
# Computes function's samples and stores values in an uplevel
# array.
#
# Arguments:
#
# configvar - the name of an uplevel variable holding
# current configuration from the GUI
# datavar - output variable: the name of an empty
# array that will hold the coordinates
#
# Results:
#
# Fills the "datavar" array with points coordinates.
#
# The keys are of the format "%d:%d": the first "%d" is the
# x coordinate index of a point and its range is [0...$xsteps-1];
# the second "%d" is the y coordinate index of a point and its
# range is [0...$ysteps-1].
#
# The values are coordinates triplets in a list: x, y, z.
#
# Returns the empty string.
#
# Error codes:
#
# None.
#
# Side effects:
#
# None.
#
proc sample { configvar datavar } {
upvar $configvar config $datavar data
log sampling
set dx [expr {($config(XMAX)-$config(XMIN))/$config(XSTEPS)}]
set dy [expr {($config(YMAX)-$config(YMIN))/$config(YSTEPS)}]
set data(XVALUES) [list [set x $config(XMIN)]]
for {set i 0} {$i < $config(XSTEPS)} {incr i} {
lappend data(XVALUES) [set x [expr {$x+$dx}]]
}
set data(YVALUES) [list [set y $config(YMIN)]]
for {set i 0} {$i < $config(YSTEPS)} {incr i} {
lappend data(YVALUES) [set y [expr {$y+$dy}]]
}
set zlst [list]
for {set i 0} {$i < $config(XSTEPS)} {incr i} {
for {set j 0} {$j < $config(YSTEPS)} {incr j} {
set data($i:$j) [list \
[set x [lindex $data(XVALUES) $i]] \
[set y [lindex $data(YVALUES) $j]] \
[set z [::function $config(FUNCTION) $x $y]]]
lappend zlst $z
}
}
set zlst [lsort -increasing -real $zlst]
set config(ZMIN) [lindex $zlst 0]
set config(ZMAX) [lindex $zlst end]
return
}
#PAGE
# compute_projection_matrix --
#
# Defines the point of view from which we see the world.
# The direction of view is always from the point of view
# to the center of the plot, computed as mean value of
# the x and y ranges and normalised to (-1,1) intervals.
#
# Arguments:
#
# configvar - the name of an uplevel variable holding
# current configuration from the GUI
# displayvar - the name of an uplevel variable holding
# current configuration of the display
#
# Results:
#
# Returns the empty string.
#
# Error codes:
#
# None.
#
# Side effects:
#
# None.
#
proc compute_projection_matrix { configvar displayvar } {
upvar $configvar config $displayvar display
log "update viewpoint"
set lon [expr {$config(LONGITUDE)/360.0*6.28318530718}]
set lat [expr {$config(LATITUDE)/360.0*6.28318530718}]
set xv [expr {cos($lon)*cos($lat)}]
set yv [expr {sin($lon)*cos($lat)}]
set zv [expr {sin($lat)}]
set xv [expr {-$xv}]
set yv [expr {-$yv}]
# - - - -
# | x1 y1 z1 | | yv -xv 0.0 |
# | |=| |
# | x2 y2 z2 | | (xv*zv) (yv*yv) (xv*xv+yv*yv)|
# - - - -
set x1 $yv
set y1 [expr {-$xv}]
set z1 0.0
set x2 [expr {$xv*$zv}]
set y2 [expr {$yv*$zv}]
set z2 [expr {$xv*$xv+$yv*$yv}]
# Here the rows are normalised to become unit vectors.
set r [expr {sqrt($x1*$x1+$y1*$y1+$z1*$z1)}]
set x1 [expr {$x1/$r}]
set y1 [expr {$y1/$r}]
set z1 [expr {$z1/$r}]
set r [expr {sqrt($x2*$x2+$y2*$y2+$z2*$z2)}]
set x2 [expr {$x2/$r}]
set y2 [expr {$y2/$r}]
set z2 [expr {$z2/$r}]
set display(PROJECT_MATRIX) [list $x1 $y1 $z1 $x2 $y2 $z2]
}
#PAGE
# compute_normalisation_matrix --
#
# The normalisation matrix maps coordinates in the (min, max)
# ranges into coordinates in the (-1.0, +1.0) range.
#
# Arguments:
#
# configvar - the name of an uplevel variable holding
# current configuration from the GUI
# displayvar - the name of an uplevel variable holding
# current configuration of the display
#
# Results:
#
# Returns the empty string.
#
# Error codes:
#
# None.
#
# Side effects:
#
# None.
#
proc compute_normalisation_matrix { configvar displayvar } {
upvar $configvar config $displayvar display
log "update normalisation"
set NX [expr {$config(XNORM)*2.0}]
set NY [expr {$config(YNORM)*2.0}]
set NZ [expr {$config(ZNORM)*2.0}]
set x0 [expr {($config(XMAX)+$config(XMIN))/2.0}]
set y0 [expr {($config(YMAX)+$config(YMIN))/2.0}]
set z0 [expr {($config(ZMAX)+$config(ZMIN))/2.0}]
set x11 [expr {180.0*$NX/($config(XMAX)-$config(XMIN))}]
set y22 [expr {180.0*$NY/($config(YMAX)-$config(YMIN))}]
set z33 [expr {180.0*$NZ/($config(ZMAX)-$config(ZMIN))}]
set display(NORMALISE_MATRIX) [list $x11 $y22 $z33 $x0 $y0 $z0]
return
}
#PAGE
# project2d --
#
# Projects points in 3D space onto a 2D canvas.
#
# Arguments:
#
# displayvar - the name of the uplevel variable holding
# the display data
# xyzcrd - List of coordinate triplets
#
# Results:
#
# List of xy-coordinates on the canvas
#
# Error codes:
#
# None.
#
# Notes:
#
# Requires previous definition of viewpoint.
#
proc project2d { displayvar xyzcrd } {
upvar $displayvar display
foreach {x1 y1 z1 x2 y2 z2} $display(PROJECT_MATRIX) {}
# - - - - - - - -
# | xc | | x1 y1 z1 || x | | x0 |
# | | = | || |+| |
# | yc | | x2 y2 z2 || y | | y0 |
# - - - - | | - -
# | z |
# - -
# x0 and y0 should be half the size of the canvas to center
# the image (more or less)
set xlst [list]
set ylst [list]
foreach {x y z} $xyzcrd {
set xc [expr {(550.0/2)+($x*$x1+$y*$y1+$z*$z1)}]
set yc [expr {(400.0/2)-($x*$x2+$y*$y2+$z*$z2)}]
lappend result $xc $yc
lappend xlst $xc
lappend ylst $yc
}
set display(XMIN2D) [lindex $xlst 0]
set display(XMAX2D) [lindex $xlst end]
set display(YMIN2D) [lindex $xlst 0]
set display(YMAX2D) [lindex $xlst end]
return $result
}
#PAGE
# normalise3d --
#
# Normalises a triplet of coordinates using the normalisation
# matrix. This maps a coordinate triplet from the (min, max)
# ranges into the (norm_min, norm_max) ranges.
#
# Arguments:
#
# displayvar - the name of the uplevel variable holding
# the display data
# xyzcrd - list of coordinate triplets
#
# Results:
#
# Returns the list of normalised coordinates.
#
# Error codes:
#
# None.
#
# Side effects:
#
# None.
#
proc normalise3d { displayvar xyzcrd } {
upvar $displayvar display
foreach { x11 y22 z33 x0 y0 z0 } $display(NORMALISE_MATRIX) {}
# - - - - - - - -
# | x | | x11 || x | | x0 |
# | | | || | | |
# | y |=| y22 || y |-| y0 |
# | | | || | | |
# | z | | z33 || z | | z0 |
# - - - - - - - -
set result [list]
foreach {x y z} $xyzcrd {
set x [expr {$x*$x11-$x0}]
set y [expr {$y*$y22-$y0}]
set z [expr {$z*$z33-$z0}]
lappend result $x $y $z
}
return $result
}
#PAGE
# plot --
#
# Draws the function the selected ranges and steps.
#
# Arguments:
#
# configvar - the name of an uplevel variable holding
# current configuration from the GUI
# displayvar - the name of an uplevel variable holding
# current configuration of the display
# datavar - the name of the uplevel array holding the
# function samples as described in [sample]
#
# Results:
#
# Returns the empty string.
#
# Error codes:
#
# None.
#
# Side effects:
#
# Assumes a viewpoint from the right angle (i.e. xv < 0)
#
proc plot { configvar displayvar datavar } {
upvar $configvar config $displayvar display $datavar data
log plotting
set xsteps $config(XSTEPS)
set ysteps $config(YSTEPS)
set canvas $config(CANVAS)
$canvas delete all
switch $config(COLOR) {
white - green {
set color $config(COLOR)
set grayscale 0
}
gray {
set grayscale 1
}
}
incr xsteps -1
incr ysteps -1
for {set i 0} {$i < $xsteps} {incr i} {
for {set j 0} {$j < $ysteps} {incr j} {
# x1,y1 x1,y2
# o----------o--------> Y
# | |
# | |
# | |
# | |
# x2,y1 o----------o
# | x2,y2
# |
# v
# X
#
# [<canvas> create polygon] wants a polygon =), so the
# sequence must be: (x1,y1), (x1,y2), (x2,y2), (x2,y1)
set i1 [expr {$i+1}]
set j1 [expr {$j+1}]
foreach {x1 y1 z1} $data($i:$j) \
{x2 y2 z2} $data($i:$j1) \
{x3 y3 z3} $data($i1:$j1) \
{x4 y4 z4} $data($i1:$j) \
{}
if { $grayscale } {
# Compute the average of the four z coordinates; compute
# its "position" in the z (min, max) range and map this
# into the (50, 200) gray level.
#
# We limit the gray range to (100, 230) because outside
# it gets too dark and too bright.
set gray [expr {int(floor(((($z1+$z2+$z3+$z4)/4)-$config(ZMIN))/($config(ZMAX)-$config(ZMIN))*130+100))}]
set color [format "#%x%x%x" $gray $gray $gray]
}
$canvas create polygon [project2d display \
[normalise3d display [list \
$x1 $y1 $z1 \
$x2 $y2 $z2 \
$x3 $y3 $z3 \
$x4 $y4 $z4 \
]]] -fill $color -outline black
}
}
return
}
#PAGE
# function --
#
# The function to be drawn.
#
# Arguments:
#
# x - the x coordinate
# y - the y coordinate
#
# Results:
#
# Returns the empty string.
#
# Error codes:
#
# None.
#
# Side effects:
#
# None.
#
proc function { func x y } {
eval expr $func
}
#PAGE
# quit --
#
# Exits the script.
#
# Arguments:
#
# None.
#
# Results:
#
# Returns the empty string.
#
# Error codes:
#
# None.
#
# Side effects:
#
# None.
#
proc quit {} {
set ::forever 1
}
#PAGE
## ------------------------------------------------------------
## Main script.
## ------------------------------------------------------------
main $argc $argv
### end of file
# Local Variables:
# mode: tcl
# page-delimiter: "^#PAGE"
# End: