Playing with Spirals in 3D
KWJ Graphics at last!
This is a direct spinoff of work done by Marco Maggi in Playing with Planes in 3D.
I was fascinated when I first saw "Playing with Planes in 3D", and very much wanted to see something populating this wonderful rotating 3D space. Years ago, I constructed something related to Cornu's Spiral using the PHIGS Graphics System. With PHIGS, I could manipulate a space curve in such a way as to give the illusion of movement in three dimensions.
My Math is somewhat rusty, and I'm not sure I can correctly explain the mathematical basis for my curve. A good reference for Cornu's Spiral can be found at:
[1] http://mathworld.wolfram.com/CornuSpiral.html .
Cornu's Spiral is essentially a curve in the Complex Plane, based on two functions which are Fresnel Integrals. See
[2] http://mathworld.wolfram.com/FresnelIntegrals.html .
The Fresnel Integrals are implicit functions of a third variable, t. I chose to work with alternate forms for the Fresnel Integrals (Equations 12 and 13 in reference 2 above), which show how to calculate X and Y coordinates in terms of t, which I think of as Z. With some integration and messing around in a tcl script, I came up with a spiral data set which looks quite nice when plotted in 3d space.
I mangled Marco's 3D Planes script by making it executable, added the spiral data set, and created some procs to plot the data. My additions are quite crude, and would benefit greatly if Marco might be persuaded to create a proper curve plotting proc that would fit more esthetically into his system.
This script was developed on an iMac, running Panther OS X, with Daniel Steffen's TclTkAquaBI8.4.5 installed. I'm not sure how it might behave on other systems, your results may vary. The original data set has been truncated somewhat for reasons of space, thus the non smooth behaviour.
Please Note: This script makes use of the "hoco.tcl" package, which you can find at
hoco an homogeneous coordinates package
here on the TCL'ers Wiki. You must place the "hoco.tcl" file in the same directory as this file.
Without further ado, here is the modified planes3d script:
#!/bin/sh
# \
exec wish "$0" ${1+"$@"}
#
# Above 4 lines were added (KWJ).
#
# Playing with planes in 3D https://wiki.tcl-lang.org/12984
# Marco Maggi
#
# planes3d.tcl --
#
# Part of: Useless Widgets Package
# Contents: shows how to move orthogonal planes
# Date: Tue Nov 16, 2004
#
# Abstract
#
# The purpose of this script is to test the perspective
# projection.
#
# This script makes use of the "hoco.tcl" package, which
# you can find on the TCL'ers Wiki also. You have to place the
# "hoco.tcl" file in the same directory of this file.
#
# Copyright (c) 2004 Marco Maggi
#
# The author hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose,
# provided that existing copyright notices are retained in all copies
# and that this notice is included verbatim in any distributions. No
# written agreement, license, or royalty fee is required for any of the
# authorized uses. Modifications to this software may be copyrighted by
# their authors and need not follow the licensing terms described here,
# provided that the new terms are clearly indicated on the first page of
# each file where they apply.
#
# IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHOR HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHOR AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
# NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS,
# AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE
# MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
#page
## ------------------------------------------------------------
## Setup.
## ------------------------------------------------------------
package require Tcl 8.4
package require Tk 8.4
set pathname [file dirname $argv]
source [file join $pathname hoco.tcl]
#page
## ------------------------------------------------------------
## Some Data.
## ------------------------------------------------------------
set spiralData {
{ -131.819 -111.620 -112.500 1.00 }
{ -121.915 -97.439 -110.000 1.00 }
{ -104.649 -96.037 -107.500 1.00 }
{ -92.305 -108.227 -105.000 1.00 }
{ -93.148 -125.580 -102.500 1.00 }
{ -106.431 -136.815 -100.000 1.00 }
{ -124.226 -134.946 -97.500 1.00 }
{ -135.578 -121.083 -95.000 1.00 }
{ -134.254 -103.192 -92.500 1.00 }
{ -121.197 -90.858 -90.000 1.00 }
{ -103.225 -90.193 -87.500 1.00 }
{ -89.035 -101.276 -85.000 1.00 }
{ -84.965 -118.836 -82.500 1.00 }
{ -92.525 -135.222 -80.000 1.00 }
{ -108.391 -143.860 -77.500 1.00 }
{ -126.341 -141.669 -75.000 1.00 }
{ -139.933 -129.713 -72.500 1.00 }
{ -144.755 -112.246 -70.000 1.00 }
{ -139.557 -94.870 -67.500 1.00 }
{ -126.153 -82.628 -65.000 1.00 }
{ -108.423 -78.661 -62.500 1.00 }
{ -90.946 -83.683 -60.000 1.00 }
{ -77.753 -96.219 -57.500 1.00 }
{ -71.492 -113.322 -55.000 1.00 }
{ -73.113 -131.476 -52.500 1.00 }
{ -82.002 -147.402 -50.000 1.00 }
{ -96.401 -158.617 -47.500 1.00 }
{ -113.944 -163.695 -45.000 1.00 }
{ -132.162 -162.266 -42.500 1.00 }
{ -148.870 -154.839 -40.000 1.00 }
{ -162.400 -142.528 -37.500 1.00 }
{ -171.693 -126.759 -35.000 1.00 }
{ -176.269 -109.028 -32.500 1.00 }
{ -176.132 -90.709 -30.000 1.00 }
{ -171.643 -72.941 -27.500 1.00 }
{ -163.381 -56.574 -25.000 1.00 }
{ -152.182 -42.360 -22.500 1.00 }
{ -138.431 -30.217 -20.000 1.00 }
{ -122.916 -20.418 -17.500 1.00 }
{ -106.182 -12.878 -15.000 1.00 }
{ -88.898 -7.454 -12.500 1.00 }
{ -71.395 -3.831 -10.000 1.00 }
{ -53.656 -1.622 -7.500 1.00 }
{ -35.814 -0.483 -5.000 1.00 }
{ -17.940 -0.061 -2.500 1.00 }
{ 0.000 0.000 0.000 1.00 }
{ 17.940 0.058 2.500 1.00 }
{ 35.814 0.471 5.000 1.00 }
{ 53.657 1.595 7.500 1.00 }
{ 71.399 3.784 10.000 1.00 }
{ 88.908 7.380 12.500 1.00 }
{ 106.428 12.864 15.000 1.00 }
{ 123.162 20.404 17.500 1.00 }
{ 138.676 30.203 20.000 1.00 }
{ 152.428 42.345 22.500 1.00 }
{ 163.780 56.749 25.000 1.00 }
{ 172.042 73.116 27.500 1.00 }
{ 176.531 90.884 30.000 1.00 }
{ 176.668 109.203 32.500 1.00 }
{ 172.092 126.934 35.000 1.00 }
{ 162.800 142.703 37.500 1.00 }
{ 149.269 155.014 40.000 1.00 }
{ 132.561 162.441 42.500 1.00 }
{ 114.343 163.870 45.000 1.00 }
{ 96.800 158.792 47.500 1.00 }
{ 82.401 147.577 50.000 1.00 }
{ 73.512 131.651 52.500 1.00 }
{ 71.891 113.497 55.000 1.00 }
{ 78.153 96.394 57.500 1.00 }
{ 91.345 83.858 60.000 1.00 }
{ 108.822 78.836 62.500 1.00 }
{ 126.553 82.803 65.000 1.00 }
{ 139.956 95.045 67.500 1.00 }
{ 145.154 112.421 70.000 1.00 }
{ 140.332 129.888 72.500 1.00 }
{ 126.741 141.844 75.000 1.00 }
{ 108.790 144.035 77.500 1.00 }
{ 92.924 135.397 80.000 1.00 }
{ 85.364 119.011 82.500 1.00 }
{ 89.434 101.451 85.000 1.00 }
{ 103.624 90.368 87.500 1.00 }
{ 121.596 91.033 90.000 1.00 }
{ 134.653 103.367 92.500 1.00 }
{ 135.977 121.258 95.000 1.00 }
{ 124.625 135.121 97.500 1.00 }
{ 106.830 136.990 100.000 1.00 }
{ 93.397 125.934 102.500 1.00 }
{ 92.314 108.595 105.000 1.00 }
{ 104.484 96.231 107.500 1.00 }
{ 121.769 97.383 110.000 1.00 }
}
#page
## ------------------------------------------------------------
## TK options.
## ------------------------------------------------------------
option add *topgeometry +20+40
# Above was +20+20 -- Changed for the Mac
option add *borderWidth 1
option add *Labelframe.borderWidth 2
option add *command_buttons.exit.text "Exit"
foreach { option value } {
background \#f8f8f8 width 600 height 600 relief sunken borderwidth 2
x_axis_color red y_axis_color blue z_axis_color green
} { option add *Drawing.Canvas.$option $value }
proc widget_option_scale_from_to { master from to } {
option add *${master}.to $to
option add *${master}.from $from
}
proc widget_option_scale_rotation { args } {
foreach w $args { widget_option_scale_from_to $w 180.0 -180.0 }
}
proc widget_option_scale_translation { args } {
foreach w $args { widget_option_scale_from_to $w 300.0 -300.0 }
}
#page
## ------------------------------------------------------------
## Widget procedures.
## ------------------------------------------------------------
proc widget_grid_frames { args } { foreach w $args { grid $w -sticky news } }
proc widget_configure_toplevel {} {
wm geometry . [option get . topgeometry {}]
wm title . [option get . toptitle {}]
foreach event { <Return> <Escape> } { bind . $event main_exit }
}
proc widget_build_canvas { master } {
global widget_canvas
set f [frame $master.drawing -class Drawing]
grid [set widget_canvas [canvas $f.canvas]] -sticky news
return $f
}
proc widget_build_command_buttons { master } {
set f [frame $master.command_buttons]
grid [button [set b $f.exit] -command main_exit]
focus $b
return $f
}
proc widget_build_scale_frame { master coord_spec } {
set f [labelframe $master.$coord_spec -class [string totitle $coord_spec]]
set column_index 0
foreach name [uwp_hoco_instance_get_dynamic_parameter_names $coord_spec] {
label [set label_widget $f.lab_$name] -text [string totitle $name]
scale [set scale_widget $f.$name]
$scale_widget set \
[uwp_hoco_instance_get_parameter_value $coord_spec $name]
$scale_widget configure -command \
[list widget_update_parameter_from_scale $coord_spec $name]
grid $label_widget -column $column_index -row 0 -sticky news
grid $scale_widget -column $column_index -row 1 -sticky news
incr column_index
}
return $f
}
proc widget_update_parameter_from_scale { coord_spec param_name param_value } {
uwp_hoco_instance_update_parameter $coord_spec $param_name $param_value
after 0 widget_put_drawing_on_canvas
# Next two lines are New (KWJ)
draw_Spiral
draw_referenceAxes
}
proc widget_canvas_draw { command coords {main_tag {}} {tags {}} } {
global widget_canvas
if { [string length $main_tag] } { $widget_canvas delete $main_tag }
$widget_canvas create $command $coords -tags [lappend tags $main_tag]
}
proc widget_canvas_query_option { option } {
global widget_canvas
option get $widget_canvas $option {}
}
proc widget_canvas_tag_config { tag args } {
global widget_canvas
eval { $widget_canvas itemconfigure $tag } $args
}
#page
#------------ Begin some Additions (KWJ) ---------------------
proc draw_3D_line { coords {main_tag {}} {tags {}} } {
global widget_canvas
set command "line"
if { [string length $main_tag] } { $widget_canvas delete $main_tag }
$widget_canvas create $command $coords \
-width 2 -fill blue -tags [lappend tags $main_tag]
}
proc draw_an_axis { coords color {main_tag {}} {tags {}} } {
# Draw a short 3D line segment.
global widget_canvas
set command "line"
if { [string length $main_tag] } { $widget_canvas delete $main_tag }
$widget_canvas create $command $coords \
-width 2 -fill $color -arrow last -tags [lappend tags $main_tag]
}
proc draw_referenceAxes {} {
# Draw some colored arrows for the grid planes.
# This proc is a very naive hack.
set tags "xAxis"
set main_tag xAxis_1
set plane_tag ${main_tag}
set beg [list -250.0 0.0 0.0 1.0]
set end [list 250.0 0.0 0.0 1.0]
set vector " $beg $end "
draw_an_axis \
[uwp_math_transformation \
[uwp_hoco_instance_get_transform \
{moving world perspective canvas}] $vector] "\#f90101" \
${plane_tag} [concat [list $main_tag] $tags]
set tags "yAxis"
set main_tag yAxis_1
set plane_tag ${main_tag}
set beg [list 0.0 -250.0 0.0 1.0]
set end [list 0.0 250.0 0.0 1.0]
set vector " $beg $end "
draw_an_axis \
[uwp_math_transformation \
[uwp_hoco_instance_get_transform \
{moving world perspective canvas}] $vector] "\#0101f9" \
${plane_tag} [concat [list $main_tag] $tags]
set tags "zAxis"
set main_tag zAxis_1
set plane_tag ${main_tag}
set beg [list 0.0 0.0 -250.0 1.0]
set end [list 0.0 0.0 250.0 1.0]
set vector " $beg $end "
draw_an_axis \
[uwp_math_transformation \
[uwp_hoco_instance_get_transform \
{moving world perspective canvas}] $vector] "\#01f901" \
${plane_tag} [concat [list $main_tag] $tags]
}
proc draw_Spiral {} {
global spiralData
set tags "cornu"
set main_tag cornu_1
set plane_tag ${main_tag}
set indx 0
set beg [lindex $spiralData 0]
set plot_spiralData [lrange $spiralData 1 end]
foreach v $plot_spiralData {
set end $v
set vector " $beg $end "
draw_3D_line \
[uwp_math_transformation \
[uwp_hoco_instance_get_transform \
{moving world perspective canvas}] $vector] \
${plane_tag}_$indx [concat [list $main_tag] $tags]
set beg $end
incr indx
}
}
#------------ End Additions ---------------------
## ------------------------------------------------------------
## Main procedures.
## ------------------------------------------------------------
proc main {} {
global exit_trigger spiralData
uwp_hoco_instance_declare moving -type homogeneous \
-dynamic [uwp_hoco_transform_get_parameter_names homogeneous]
uwp_hoco_instance_declare perspective -type perspective \
-dynamic [uwp_hoco_transform_get_parameter_names perspective]
option add *perspective.Scale.from 0.1
option add *perspective.Scale.to 100
option add *perspective.Scale.resolution 0.1
widget_build_all
uwp_wireframe_draw_reference_frame Canvas_Frame \
{canvas} {yes {200 0 0 1 0 200 0 1 0 0 0 1 0 0 0 1}}
interp alias {} draw_world_frame {} \
uwp_wireframe_draw_reference_frame World_Frame \
{ world canvas } {yes {50 0 0 0 0 50 0 0 0 0 50 0 0 0 0 1}}
widget_put_drawing_on_canvas
# Added next two lines (KWJ)
draw_Spiral
draw_referenceAxes
interp alias {} main_exit {} uplevel \#0 {set exit_trigger 1}
vwait exit_trigger
exit
}
proc widget_put_drawing_on_canvas {} {
draw_world_frame
draw_planes
widget_canvas_configure_tags
}
#page
## ------------------------------------------------------------
## Work space proof widgets.
## ------------------------------------------------------------
proc widget_build_all {} {
widget_setup_options
widget_configure_toplevel
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1
grid [widget_build_canvas .] [frame [set right_frame .right]] -sticky news
widget_grid_frames \
[widget_build_command_buttons $right_frame] \
[widget_build_color_explanation $right_frame] \
[widget_build_scale_frame $right_frame perspective] \
[widget_build_scale_frame $right_frame world] \
[widget_build_scale_frame $right_frame moving]
}
proc widget_canvas_configure_tags {} {
foreach axis {x y z} {
widget_canvas_tag_config reference_frame_${axis}axis \
-fill [widget_canvas_query_option ${axis}_axis_color] }
foreach arglist {
{reference_frame -arrow last} {Canvas_Frame -fill "\#d0d0d0"}
} { eval widget_canvas_tag_config $arglist }
}
proc widget_build_color_explanation { master } {
set f [labelframe $master.explain_colors -class Explain_colors]
set column_index 0
foreach axis { x y z } {
grid [label $f.${axis}axis] -row 1 -column [incr column_index]
}
return $f
}
proc widget_setup_options {} {
option add *toptitle "Moving planes"
widget_option_scale_rotation \
moving.theta moving.phi moving.psi \
world.theta world.phi world.psi
widget_option_scale_translation moving.x moving.y moving.z
widget_option_scale_from_to perspective.d 100 10000
foreach {name text} { World "World Frame" Moving "Moving"
Perspective "Perspective" } {
option add *$name.text $text
option add *$name.borderWidth 2
}
foreach { ax color } { x red y blue z green } {
set axis [format "%saxis" $ax]
option add *Explain_colors.$axis.text \
[format "%saxis" [string toupper $ax]]
option add *Explain_colors.$axis.foreground $color
}
}
#page
## ------------------------------------------------------------
## Graphical elements.
## ------------------------------------------------------------
interp alias {} draw_planes {} uwp_wireframe_draw_workspace \
Planes { moving world perspective canvas }
#page
## ------------------------------------------------------------
## Let's go.
## ------------------------------------------------------------
main
##### end of file
# Local Variables:
# mode: tcl
# End:
Although my mathematics might be somewhat suspect, it's possible see a close similarity between this data set and Cornu's spiral (first figure in reference [1]) by moving the sliders so that:
World Theta = 90, World Phi = 180 and World Psi = 0
Similarly, the plot for C(x) seen in reference [2] above can be obtained by moving the sliders so that:
World Theta = 0, World Phi = 90 and World Psi = -90
S(x) can be obtained with:
World Theta = 0, World Phi = 90 and World Psi = 0
A nice feature of Marco's interface, is that by clicking in the gray gutter above or below any slider, the associated variable change by one unit. I want to thank him for providing us with yet another reason to say -- Ain't tcling FUN?
Enjoy!