Updated 2012-04-21 21:24:35 by RLE

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    http://wiki.tcl.tk/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!