Arjen Markus (11 september 2002) I have had this idea fro some time now: create a set of procedures that will allow me to draw mathematical shapes like a torus or even a knot, colour them in ingenious ways, in short, play with 3D space.
The script below is just a start. It is not perfect, it is not flexible, but it does give you some sense of what I want.
Notes:
# solids3d.tcl -- # # Package for displaying 3D solid bodies # (sample Workbench module) # # Notes: # This package is a quick hack to get started only # # Version information: # version 0.1: initial implementation, september 2002
package provide Solids3D 0.1
namespace eval ::Solids3D {
namespace export func deriv variable display_options
# pointOnTorus -- # Return the coordinates of a point on a torus, as given by # two parameters (angles) # # Arguments: # phi Angle with respect to x-axis # theta Angle with respect to "inner" axis of torus # # Result: # Point {x,y,z}, the coordinates of the point # proc pointOnTorus {phi theta} {
set cosphi [expr {cos($phi)}]
set sinphi [expr {sin($phi)}]
set costh4 [expr {0.25*cos($theta)}]
set sinth4 [expr {0.25*sin($theta)}]
set x [expr {$cosphi*(1.0+$costh4)}]
set y [expr {$sinphi*(1.0+$costh4)}]
set z [expr {1.0+$sinth4}]
return [list POINT $x $y $z]}
# constructTorus -- # Return a list of polygons, together forming an approximation to a # torus # # Arguments: # nophi Number of steps along main perimeter # notheta Number of steps along secondary perimeter # # Result: # List of polygons # proc constructTorus {nophi notheta} {
variable angle
set pi 3.1415926
set dphi [expr {2.0*$pi/double($nophi)}]
set dtheta [expr {2.0*$pi/double($notheta)}]
set polygons {POLYGON-LIST}
for { set iphi 0 } { $iphi < $nophi } { incr iphi } {
set phi1 [expr {$dphi*double($iphi)}]
set phi2 [expr {$dphi*double($iphi+1)}]
for { set itheta 0 } { $itheta < $notheta } { incr itheta } {
set theta1 [expr {$dtheta*double($itheta)}]
set theta2 [expr {$dtheta*double($itheta+1)}]
set point1 [pointOnTorus $phi1 $theta1]
set point2 [pointOnTorus $phi1 $theta2]
set point3 [pointOnTorus $phi2 $theta2]
set point4 [pointOnTorus $phi2 $theta1]
set red [expr {int(125*(1.0+cos($phi1)))}]
set green [expr {int(125*(1.0+sin($phi1)))}]
set blue [expr {int(125*(1.0+sin($theta1)))}]
set colour [format "#%2X%2X%2X" $red $green $blue]
set zdepth [lindex [rotateY $angle $point1] 3]
lappend polygons \
[list POLYGON $colour $zdepth $point1 $point2 $point3 $point4]
}
}
return $polygons}
# rotateY -- # Rotate around the y axis # # Arguments: # angle Angle over which to rotate # point Point to rotate # # Result: # New coordinates # proc rotateY {angle point} {
foreach {dummy x y z} $point break
set xr [expr {$x*cos($angle)-$z*sin($angle)}]
set yr $y
set zr [expr {$x*sin($angle)+$z*cos($angle)}]
return [list POINT $xr $yr $zr]}
# projectOnYZ -- # Project a point on the YZ-plane (and scale as we do this) # # Arguments: # point Point to rotate # # Result: # XY coordinates (for the screen) # proc projectOnYZ {point} {
variable scale
variable yoffset
variable zoffset
foreach {dummy x y z} $point break
set xp [expr {int($scale*($y-$yoffset))}]
set yp [expr {int($scale*($zoffset-$z))}]
return [list $xp $yp]}
# display -- # Quick and dirty implementation to display a set of polygons # # Arguments: # polygons List of 3D polygons # # Result: # None # # Side effect: # Display of polygons in the canvas # proc display {polygons} {
variable angle
#
# Sort the polygons first
# Note:
# The comparison is too simple, but for now it should work
#
set plane_polygons [lrange $polygons 1 end]
set sorted_polygons [lsort -real -index 2 $plane_polygons]
foreach polygon $sorted_polygons {
set colour [lindex $polygon 1]
set points [lrange $polygon 3 end]
set coords {}
foreach point $points {
set coords [concat $coords [projectOnYZ [rotateY $angle $point]]]
}
.cnv create polygon $coords -fill $colour -outline black
}}
# # Initialise the variables # variable angle expr {0.25*3.1415926} variable scale 100.0 variable yoffset -1.5 variable zoffset 2.0
} ;# End of namespace
# # Run the program #
canvas .cnv -width 300 -height 300 -background white pack .cnv -fill both set torus ::Solids3D::constructTorus 16 16 ::Solids3D::display $torus