Version 33 of TclSpringies : A simple mass and spring simulator

Updated 2004-12-17 23:22:54

if 0 {

MBS After visiting the Runge-Kutta page recently, I decided to re-visit something that I was playing with about a year ago...

I got the idea of trying to create a simple mass and spring simulation based on Xspringies [L1 ] after finding a Java based version [L2 ].

I wasn't interested in all the 'bells and whistles' that were included in the Xspringies. I wanted to keep it 'simple'.

The following is what I ended up with. Comments and code fixes are very much welcome.


escargo 6 Dec 2004 -- On Windows XP Pro, clicking the X in the title bar to close the application fails because "file_quit" is not defined (in proc init_display).

MG 7 Dec 2004 - Added a call to "catch" into the wm protocol to "fix" that. I didn't want to remove the wm protocol completely in case MBS was planning to add it in later/had left it out by mistake.

MBS 7 Dec 2004 -- I cut-n-pasted that from another app and never noticed that I was still using "file_quit".

AET 7dec04 - What a great little app to demo Tcl/Tk! Well done. The 700x700 canvas is a little large for the 800x600 monitor on the Win2000 machine I tried it on, so all the control buttons disappeared off the bottom of the screen. Alt-click doesn't work on Windows, so I couldn't move the window enough to see them. I changed the canvas to 700x500 when I pasted it into tclkit, which was fine. You may consider putting the controls on the top if you want to keep the canvas size.

MBS 7 Dec 2004 -- I have gotten so used to running at a higher resolution, that I never gave it a thought that 700x700 might be a problem. Let me think about it a little to see if I can come up with a "simple / general" type of fix. In the mean time, if anyone has a suggestion or fix, let me know.

escargo 7 Dec 2004 -- On Windows XP Pro, making the top-level window smaller hid the controls Since these controls included the Quit button, and the X on the title bar doesn't work, there was no way to kill the application. You might want to change the packing order.

SS 8 Dec 2004 -- Comments? Very very cool! That should be added to the Tk demo distribution to show what some line of Tcl can do (in the hands of the smart programmer), and how powerful the canvas widget is. And also that Tcl is *not* too slow even for realtime simulation sometimes.

MBS 8 Dec 2004 -- I moved the controls to be above the canvas and I also changed the "file_quit" to "exit". I also just realized that I need to fix it so that resizing the window/canvas is handled correctly.

AM (8 december 2004) Wonderful script! I will have to study it in some detail, but the result is fascinating :)


MBS 16 Dec 2004

I added a couple items to the display :

  • a entry to make it easier to change the default Time Step.
  • an option menu for selecting / displaying the built-in models.

I also added a simple collision detection mechanism so that nodes now bounce off the canvas boundaries (refer to the routine apply_forces).


}

if 0 {

Initialize global values...

I don't remember why I called it 'State', but State is a global array that holds almost everything.

MBS 10 Dec 2004 -- I added some code to help with "resizing" the window/canvas. (look below for "new-12-10-2004")

}

 package require Tk

 global State

 set State(t)    0.0           ;# current time
 set State(dt)   0.1           ;# time step
 set State(MaxTime) 1000.      ;# Max time value

 # After each time step, the maximum distance that any node travels
 # is calculated.  If this distance, "dmax", is less that "tol", then
 # stop the simulation.

 set State(tol)  0.01

 set State(gravity) -9.8
 set State(curNode) none

 set State(model,Current) " " 
 set State(models)  {}

 set ::menu_selection ""

if 0 {

Start of : new-12-10-2004

In my original implementation, I had "hardwired" the dimensions of the canvas to be 700x700. Those dimensions were to large for some, so in an effort to make the code "more robust", the following should define the width/height to be a square equal to 75% of the smaller of the screen width / height.

}

 set State(screenWidth)  [winfo screenwidth  .]
 set State(screenHeight) [winfo screenheight .]

 if {$State(screenWidth) < $State(screenHeight)} {
    set State(canvasWidth)   [expr {$State(screenWidth)  * 0.75}]
    set State(canvasHeight)  $State(canvasWidth)
 } else {
    set State(canvasWidth)   [expr {$State(screenHeight)  * 0.75}]
    set State(canvasHeight)  $State(canvasWidth)
 }

if 0 {

Since the original version assumed a 700x700 canvas and node coordinates and the spring "rest" lengths within "init_geom" are based on these dimensions - let's define a "scale factor" to reposition the coordinates and springs lengths based on the current canvas dimensions.

Note : The routine "reset" (towards the bottom of the code) has similar code and most these comments apply there as well.

So, if you need to resize the overall window to fit your screen try the following :

  • resize the window
  • then press "reset"

I realize that the above method for resizing may not be the best way to handle it, but for the present time it is a "simple and cheap" fix. }

 set cx 700   
 set cy 700

 set State(canv,scale)  [expr {1.0 * $State(canvasWidth)  / $cx}]

if 0 {

End of : new-12-10-2004

}

if 0 {

Initialize the geometry to be displayed.

node_def is a list of nodes containing the following for each node:

  • node name
  • X coordinate
  • Y coordinate
  • node mass
  • free/fixed (whether that node is free to move or fixed)
  • spring list (the list of springs attached to this node)

spring_def is the list of springs containing the following info for each spring:

  • spring name
  • spring constant : k
  • spring damping constant : kd
  • rest length for this spring
  • node list (the list of nodes attached to this spring)

init_geom has multiple definitions for node_def and spring_def. Each one is just a different test. Select the one you wish to try. The current setting for node_def and spring_def is sort of a simple suspension bridge type of configuration.

I probably should have added some code so that the user could load node_def and spring_def from a file, but I never got around to doing it...

Oh well.

DKF: I've converted this bit into embedded scripts that are then evalled; as a style it's a bit clearer, particularly as it lets you switch between models more easily and it lets you put in comments as you go.

MBS 16 Dec 2004 -- The spring list for each node was redunant information since it can be generated from the spring node list information. So, I added some code here to build up the spring list for each node from the spring node list information.

I left in the spring list argument for most of the node definitions below since being able to see that field can sometimes be useful when manually creating a new model definition.

}

 proc init_geom {{model bridge}} {
     global State

     set State(model,Current) $model

 ########################################################################

     lappend State(models) "test1"

     set definition(test1) {
         node n1 250.  350.  50. fixed { s1    }
         node n2 300.  350.  50. free  { s1 s2 }
         node n3 250.  300.  50. free  { s2    }
         spring s1 10.0 50.0  50. {n1 n2}
         spring s2 10.0 50.0  50. {n2 n3}
     }

 ########################################################################

     lappend State(models) "test2"

     set definition(test2) {
         node n1  100 350  50. fixed { s1  s5      }
         node n2  150 350  50. free  { s1  s2  s6  }
         node n3  200 350  50. free  { s2  s3  s7  }
         node n4  250 350  50. free  { s3  s4  s8  }
         node n5  300 350  50. fixed { s4  s9      }
         node n6  100 300  50. fixed { s5  s10     }
         node n7  150 300  50. free  { s6  s10 s11 }
         node n8  200 300  50. free  { s7  s11 s12 }
         node n9  250 300  50. free  { s8  s12 s13 }
         node n10 300 300  50. fixed { s9  s13     }

         spring s1  50.0  45.0  50. {n1 n2 }
         spring s2  50.0  45.0  50. {n2 n3 }
         spring s3  50.0  45.0  50. {n3 n4 }
         spring s4  50.0  45.0  50. {n4 n5 }
         spring s5  50.0  45.0  50. {n1 n6 }
         spring s6  50.0  45.0  50. {n2 n7 }
         spring s7  50.0  45.0  50. {n3 n8 }
         spring s8  50.0  45.0  50. {n4 n9 }
         spring s9  50.0  45.0  50. {n5 n10}
         spring s10 50.0  45.0  50. {n6 n7 }
         spring s11 50.0  45.0  50. {n7 n8 }
         spring s12 50.0  45.0  50. {n8 n9 }
         spring s13 50.0  45.0  50. {n9 n10}
     }

 ########################################################################

     lappend State(models) "test3"

     set definition(test3) {
         node n1  50 350 100. fixed {      s1 }
         node n2 100 350  50. free  { s1   s2 }
         node n3 150 350 100. free  { s2   s3 }
         node n4 200 350  50. free  { s3   s4 }
         node n5 250 350  60. free  { s4   s5 }
         node n6 350 350  70. free  { s5   s6 }
         node n7 450 350 100. fixed { s6      }

         spring s1  30.0  25.0  25. {n1 n2}
         spring s2  40.0  35.0  25. {n2 n3}
         spring s3  50.0  45.0  25. {n3 n4}
         spring s4  50.0  45.0  25. {n4 n5}
         spring s5  40.0  35.0  25. {n5 n6}
         spring s6  30.0  25.0  25. {n6 n7}
     }

 ########################################################################

     lappend State(models) "test4"

     set definition(test4) {
         node n1  100 350  50. fixed { s1  s5  s14         }
         node n2  150 350  50. free  { s1  s2  s6  s15 s16 }
         node n3  200 350  50. free  { s2  s3  s7  s17 s18 }
         node n4  250 350  50. free  { s3  s4  s8  s19 s20 }
         node n5  300 350  50. fixed { s4  s9  s21         }
         node n6  100 300  50. fixed { s5  s10 s15         }
         node n7  150 300  50. free  { s6  s10 s11 s14 s17 }
         node n8  200 300  50. free  { s7  s11 s12 s16 s19 }
         node n9  250 300  50. free  { s8  s12 s13 s18 s21 }
         node n10 300 300  50. fixed { s9  s13 s20         }

         spring s1  90.0  45.0  50. {n1 n2 }
         spring s2  90.0  45.0  50. {n2 n3 }
         spring s3  90.0  45.0  50. {n3 n4 }
         spring s4  90.0  45.0  50. {n4 n5 }
         spring s5  90.0  45.0  50. {n1 n6 }
         spring s6  90.0  45.0  50. {n2 n7 }
         spring s7  90.0  45.0  50. {n3 n8 }
         spring s8  90.0  45.0  50. {n4 n9 }
         spring s9  90.0  45.0  50. {n5 n10}
         spring s10 90.0  45.0  50. {n6 n7 }
         spring s11 90.0  45.0  50. {n7 n8 }
         spring s12 90.0  45.0  50. {n8 n9 }
         spring s13 90.0  45.0  50. {n9 n10}
         spring s14 90.0  45.0  50. {n1 n7 }
         spring s15 90.0  45.0  50. {n2 n6 }
         spring s16 90.0  45.0  50. {n2 n8 }
         spring s17 90.0  45.0  50. {n3 n7 }
         spring s18 90.0  45.0  50. {n3 n9 }
         spring s19 90.0  45.0  50. {n4 n8 }
         spring s20 90.0  45.0  50. {n4 n10}
         spring s21 90.0  45.0  50. {n5 n9 }
     }
 ########################################################################

     lappend State(models) "simple_ball"

     set definition(simple_ball) {
         node n1  250 300  50. free  { s1  s9  s17 s19 }
         node n2  300 300  50. free  { s1  s10 s18 s20 }
         node n3  200 350  50. free  { s2  s11 s17 s22 }
         node n4  250 350  50. free  { s2  s3  s9  s12 s18 s21 s31 }
         node n5  300 350  50. free  { s3  s4  s10 s13 s19 s26 s32 }
         node n6  350 350  50. free  { s4  s14 s20 s25 }
         node n7  200 400  50. free  { s5  s11 s21 s27 }
         node n8  250 400  50. free  { s5  s6  s12 s15 s22 s29 s33 }
         node n9  300 400  50. free  { s6  s7  s13 s16 s25 s28 s34 }
         node n10 350 400  50. free  { s7  s14 s26 s30 }
         node n11 250 450  50. free  { s8  s15 s27 s28 }
         node n12 300 450  50. free  { s8  s16 s29 s30 }

         node n13 300 500  50. fixed { s35 }
         node n14 275 375  50. free  { s35 s31 s32 s33 s34 }

         spring s1  1000.0  45.0  50. {n1  n2 }
         spring s2  1000.0  45.0  50. {n3  n4 }
         spring s3  1500.0  45.0  50. {n4  n5 }
         spring s4  1000.0  45.0  50. {n5  n6 }
         spring s5  1000.0  45.0  50. {n7  n8 }
         spring s6  1500.0  45.0  50. {n8  n9 }
         spring s7  1000.0  45.0  50. {n9  n10}
         spring s8  1000.0  45.0  50. {n11 n12}
         spring s9  1000.0  45.0  50. {n1  n4 }
         spring s10 1000.0  45.0  50. {n2  n5 }
         spring s11 1000.0  45.0  50. {n3  n7 }
         spring s12 1500.0  45.0  50. {n4  n8 }
         spring s13 1500.0  45.0  50. {n5  n9 }
         spring s14 1000.0  45.0  50. {n6  n10}
         spring s15 1000.0  45.0  50. {n8  n11}
         spring s16 1000.0  45.0  50. {n9  n12}
         spring s17 1000.0  45.0  50. {n1  n3 }
         spring s18 1000.0  45.0  50. {n2  n4 }
         spring s19 1000.0  45.0  50. {n1  n5 }
         spring s20 1000.0  45.0  50. {n2  n6 }
         spring s21 1000.0  45.0  50. {n4  n7 }
         spring s22 1000.0  45.0  50. {n3  n8 }

         spring s25 1000.0  45.0  50. {n6  n9 }
         spring s26 1000.0  45.0  50. {n5  n10}
         spring s27 1000.0  45.0  50. {n7  n11}
         spring s28 1000.0  45.0  50. {n9  n11}
         spring s29 1000.0  45.0  50. {n8  n12}
         spring s30 1000.0  45.0  50. {n10 n12}

         spring s31 2500.0  45.0  50. {n14 n4 }
         spring s32 2500.0  45.0  50. {n14 n5 }
         spring s33 2500.0  45.0  50. {n14 n8 }
         spring s34 2500.0  45.0  50. {n14 n9 }

         spring s35  50.0  45.0 150. {n13 n14}

     }

 ########################  ball1  ######################################

     lappend State(models) "ball1"

     set definition(ball1) {
         node n1  350 300  10. free  { s1  s16 s33 s49 s80 s81}
         node n2  346 319  10. free  { s1  s2  s34 s50 s65 s82}
         node n3  335 335  10. free  { s2  s3  s35 s51 s66 s83}
         node n4  319 346  10. free  { s3  s4  s36 s52 s67 s84}
         node n5  300 350  10. free  { s4  s5  s37 s53 s68 s85}
         node n6  281 346  10. free  { s5  s6  s38 s54 s69 s86}
         node n7  265 335  10. free  { s6  s7  s39 s55 s70 s87}
         node n8  254 319  10. free  { s7  s8  s40 s56 s71 s88}
         node n9  250 300  10. free  { s8  s9  s41 s57 s72 s89}
         node n10 254 281  10. free  { s9  s10 s42 s58 s73 s90}
         node n11 265 265  10. free  { s10 s11 s43 s59 s74 s91}
         node n12 281 254  10. free  { s11 s12 s44 s60 s75 s92}
         node n13 300 250  10. free  { s12 s13 s45 s61 s76 s93}
         node n14 319 254  10. free  { s13 s14 s46 s62 s77 s94}
         node n15 335 265  10. free  { s14 s15 s47 s63 s78 s95}
         node n16 346 281  10. free  { s15 s16 s48 s64 s79 s96}

         node n17 200 400  10. fixed { s15 s16 s48 s64 s79 s96}
         node n18 450 350  10. fixed { s15 s16 s48 s64 s79 s96}

         node n33 300 300  50. free  {s81 s82 s83 s84 s85 s86 s87 s88 s89 s90 s91 s92 s93 s94 s95 s96 s97}


         spring s1  500.0   15.0  20. {n1  n2 }
         spring s2  500.0   15.0  20. {n2  n3 }
         spring s3  500.0   15.0  20. {n3  n4 }
         spring s4  500.0   15.0  20. {n4  n5 }
         spring s5  500.0   15.0  20. {n5  n6 }
         spring s6  500.0   15.0  20. {n6  n7 }
         spring s7  500.0   15.0  20. {n7  n8 }
         spring s8  500.0   15.0  20. {n8  n9 }
         spring s9  500.0   15.0  20. {n9  n10}
         spring s10 500.0   15.0  20. {n10 n11}
         spring s11 500.0   15.0  20. {n11 n12}
         spring s12 500.0   15.0  20. {n12 n13}
         spring s13 500.0   15.0  20. {n13 n14}
         spring s14 500.0   15.0  20. {n14 n15}
         spring s15 500.0   15.0  20. {n15 n16}
         spring s16 500.0   15.0  20. {n16 n1 }

         spring s17  30.0    5.0 175 {n17 n9}
         spring s18  30.0    5.0 275 {n18 n1}

         spring s81 100.0   15.0 50. {n33 n1 }
         spring s82 100.0   15.0 50. {n33 n2 }
         spring s83 100.0   15.0 50. {n33 n3 }
         spring s84 100.0   15.0 50. {n33 n4 }
         spring s85 100.0   15.0 50. {n33 n5 }
         spring s86 100.0   15.0 50. {n33 n6 }
         spring s87 100.0   15.0 50. {n33 n7 }
         spring s88 100.0   15.0 50. {n33 n8 }
         spring s89 100.0   15.0 50. {n33 n9 }
         spring s90 100.0   15.0 50. {n33 n10}
         spring s91 100.0   15.0 50. {n33 n11}
         spring s92 100.0   15.0 50. {n33 n12}
         spring s93 100.0   15.0 50. {n33 n13}
         spring s94 100.0   15.0 50. {n33 n14}
         spring s95 100.0   15.0 50. {n33 n15}
         spring s96 100.0   15.0 50. {n33 n16}


     }

 ########################################################################

     lappend State(models) "better_ball"

     set definition(better_ball) {

         # sixteen inner nodes
         node n1  350 300  20. free  { not used }
         node n2  346 319  20. free  { not used }
         node n3  335 335  20. free  { not used }
         node n4  319 346  20. free  { not used }
         node n5  300 350  20. free  { not used }
         node n6  281 346  20. free  { not used }
         node n7  265 335  20. free  { not used }
         node n8  254 319  20. free  { not used }
         node n9  250 300  20. free  { not used }
         node n10 254 281  20. free  { not used }
         node n11 265 265  20. free  { not used }
         node n12 281 254  20. free  { not used }
         node n13 300 250  20. free  { not used }
         node n14 319 254  20. free  { not used }
         node n15 335 265  20. free  { not used }
         node n16 346 281  20. free  { not used }

         # sixteen outer nodes
         node n17 360 300  20. free  { not used }
         node n18 355 323  20. free  { not used }
         node n19 342 342  20. free  { not used }
         node n20 323 355  20. free  { not used }
         node n21 300 360  20. free  { not used }
         node n22 277 355  20. free  { not used }
         node n23 258 342  20. free  { not used }
         node n24 245 323  20. free  { not used }
         node n25 240 300  20. free  { not used }
         node n26 245 277  20. free  { not used }
         node n27 258 258  20. free  { not used }
         node n28 277 245  20. free  { not used }
         node n29 300 240  20. free  { not used }
         node n30 323 245  20. free  { not used }
         node n31 342 258  20. free  { not used }
         node n32 355 277  20. free  { not used }

         # this node is connected to the above 32 nodes 
         # via "spokes" -- it is the center of the ball
         node n33 300 300 100. free  { not used }

         # the ball is hung from this node
         node n34 450 450  20. fixed { not used }

         # springs around the inner diameter of the ball
         spring s1  500.0  15.0  20. {n1  n2 }
         spring s2  500.0  15.0  20. {n2  n3 }
         spring s3  500.0  15.0  20. {n3  n4 }
         spring s4  500.0  15.0  20. {n4  n5 }
         spring s5  500.0  15.0  20. {n5  n6 }
         spring s6  500.0  15.0  20. {n6  n7 }
         spring s7  500.0  15.0  20. {n7  n8 }
         spring s8  500.0  15.0  20. {n8  n9 }
         spring s9  500.0  15.0  20. {n9  n10}
         spring s10 500.0  15.0  20. {n10 n11}
         spring s11 500.0  15.0  20. {n11 n12}
         spring s12 500.0  15.0  20. {n12 n13}
         spring s13 500.0  15.0  20. {n13 n14}
         spring s14 500.0  15.0  20. {n14 n15}
         spring s15 500.0  15.0  20. {n15 n16}
         spring s16 500.0  15.0  20. {n16 n1 }

         # springs around the outer diameter of the ball
         spring s17 500.0  15.0  24. {n17 n18}
         spring s18 500.0  15.0  24. {n18 n19}
         spring s19 500.0  15.0  24. {n19 n20}
         spring s20 500.0  15.0  24. {n20 n21}
         spring s21 500.0  15.0  24. {n21 n22}
         spring s22 500.0  15.0  24. {n22 n23}
         spring s23 500.0  15.0  24. {n23 n24}
         spring s24 500.0  15.0  24. {n24 n25}
         spring s25 500.0  15.0  24. {n25 n26}
         spring s26 500.0  15.0  24. {n26 n27}
         spring s27 500.0  15.0  24. {n27 n28}
         spring s28 500.0  15.0  24. {n28 n29}
         spring s29 500.0  15.0  24. {n29 n30}
         spring s30 500.0  15.0  24. {n30 n31}
         spring s31 500.0  15.0  24. {n31 n32}
         spring s32 500.0  15.0  24. {n32 n17}

         # support springs (radial supports)
         spring s33 400.0  15.0  10. {n1  n17}
         spring s34 400.0  15.0  10. {n2  n18}
         spring s35 400.0  15.0  10. {n3  n19}
         spring s36 400.0  15.0  10. {n4  n20}
         spring s37 400.0  15.0  10. {n5  n21}
         spring s38 400.0  15.0  10. {n6  n22}
         spring s39 400.0  15.0  10. {n7  n23}
         spring s40 400.0  15.0  10. {n8  n24}
         spring s41 400.0  15.0  10. {n9  n25}
         spring s42 400.0  15.0  10. {n10 n26}
         spring s43 400.0  15.0  10. {n11 n27}
         spring s44 400.0  15.0  10. {n12 n28}
         spring s45 400.0  15.0  10. {n13 n29}
         spring s46 400.0  15.0  10. {n14 n30}
         spring s47 400.0  15.0  10. {n15 n31}
         spring s48 400.0  15.0  10. {n16 n32}

         # support springs (cross supports)
         spring s49 100.0  15.0  10. {n1  n19}
         spring s50 100.0  15.0  10. {n2  n20}
         spring s51 100.0  15.0  10. {n3  n21}
         spring s52 100.0  15.0  10. {n4  n22}
         spring s53 100.0  15.0  10. {n5  n23}
         spring s54 100.0  15.0  10. {n6  n24}
         spring s55 100.0  15.0  10. {n7  n25}
         spring s56 100.0  15.0  10. {n8  n26}
         spring s57 100.0  15.0  10. {n9  n27}
         spring s58 100.0  15.0  10. {n10 n28}
         spring s59 100.0  15.0  10. {n11 n29}
         spring s60 100.0  15.0  10. {n12 n30}
         spring s61 100.0  15.0  10. {n13 n31}
         spring s62 100.0  15.0  10. {n14 n32}
         spring s63 100.0  15.0  10. {n15 n17}
         spring s64 100.0  15.0  10. {n16 n18}
         spring s65 100.0  15.0  10. {n17 n3 }
         spring s66 100.0  15.0  10. {n18 n4 }
         spring s67 100.0  15.0  10. {n19 n5 }
         spring s68 100.0  15.0  10. {n20 n6 }
         spring s69 100.0  15.0  10. {n21 n7 }
         spring s70 100.0  15.0  10. {n22 n8 }
         spring s71 100.0  15.0  10. {n23 n9 }
         spring s72 100.0  15.0  10. {n24 n10}
         spring s73 100.0  15.0  10. {n25 n11}
         spring s74 100.0  15.0  10. {n26 n12}
         spring s75 100.0  15.0  10. {n27 n13}
         spring s76 100.0  15.0  10. {n28 n14}
         spring s77 100.0  15.0  10. {n29 n15}
         spring s78 100.0  15.0  10. {n30 n16}
         spring s79 100.0  15.0  10. {n31 n1 }
         spring s80 100.0  15.0  10. {n32 n2 }

         # "spokes" to the inner diameter nodes
         spring s81 500.0  15.0 50. {n33 n1 }
         spring s82 500.0  15.0 50. {n33 n2 }
         spring s83 500.0  15.0 50. {n33 n3 }
         spring s84 500.0  15.0 50. {n33 n4 }
         spring s85 500.0  15.0 50. {n33 n5 }
         spring s86 500.0  15.0 50. {n33 n6 }
         spring s87 500.0  15.0 50. {n33 n7 }
         spring s88 500.0  15.0 50. {n33 n8 }
         spring s89 500.0  15.0 50. {n33 n9 }
         spring s90 500.0  15.0 50. {n33 n10}
         spring s91 500.0  15.0 50. {n33 n11}
         spring s92 500.0  15.0 50. {n33 n12}
         spring s93 500.0  15.0 50. {n33 n13}
         spring s94 500.0  15.0 50. {n33 n14}
         spring s95 500.0  15.0 50. {n33 n15}
         spring s96 500.0  15.0 50. {n33 n16}

         # the ball is hung from this spring
         spring s97  50.0  15.0 250. {n33 n34}

         # "spokes" to the outer diameter nodes
         spring s98  500.0  15.0 60. {n33 n17}
         spring s99  500.0  15.0 60. {n33 n18}
         spring s100 500.0  15.0 60. {n33 n19}
         spring s101 500.0  15.0 60. {n33 n20}
         spring s102 500.0  15.0 60. {n33 n21}
         spring s103 500.0  15.0 60. {n33 n22}
         spring s104 500.0  15.0 60. {n33 n23}
         spring s105 500.0  15.0 60. {n33 n24}
         spring s106 500.0  15.0 60. {n33 n25}
         spring s107 500.0  15.0 60. {n33 n26}
         spring s108 500.0  15.0 60. {n33 n27}
         spring s109 500.0  15.0 60. {n33 n28}
         spring s110 500.0  15.0 60. {n33 n29}
         spring s111 500.0  15.0 60. {n33 n30}
         spring s112 500.0  15.0 60. {n33 n31}
         spring s113 500.0  15.0 60. {n33 n32}


      }

 ########################  bridge  ######################################

     lappend State(models) "bridge"

     set definition(bridge) {
         # Upper nodes
         node n1   25 300  20. fixed {     s1  s49 }
         node n2   50 300  20. free  { s1  s2  s50 }
         node n3   75 300  20. free  { s2  s3  s51 }
         node n4  100 300  20. free  { s3  s4  s52 }
         node n5  125 300  20. free  { s4  s5  s53 }
         node n6  150 325  20. free  { s5  s6  s54 }
         node n7  175 350  20. free  { s6  s7  s55 }
         node n8  200 375  20. free  { s7  s8  s56 }
         node n9  225 400  20. fixed { s8  s9  s57 }
         node n10 250 380  20. free  { s9  s10 s58 }
         node n11 275 370  20. free  { s10 s11 s59 }
         node n12 300 360  20. free  { s11 s12 s60 }
         node n13 325 350  20. free  { s12 s13 s61 }
         node n14 350 360  20. free  { s13 s14 s62 }
         node n15 375 370  20. free  { s14 s15 s63 }
         node n16 400 380  20. free  { s15 s16 s64 }
         node n17 425 400  20. fixed { s16 s17 s65 }
         node n18 450 375  20. free  { s17 s18 s66 }
         node n19 475 350  20. free  { s18 s19 s67 }
         node n20 500 325  20. free  { s19 s20 s68 }
         node n21 525 300  20. free  { s20 s21 s69 }
         node n22 550 300  20. free  { s21 s22 s70 }
         node n23 575 300  20. free  { s22 s23 s71 }
         node n24 600 300  20. free  { s23 s24 s72 }
         node n25 625 300  20. fixed { s24     s73 }

         # Lower nodes
         node n26  25 200  20. fixed {     s25 s49 }
         node n27  50 200  20. free  { s25 s26 s50 }
         node n28  75 200  20. free  { s26 s27 s51 }
         node n29 100 200  20. free  { s27 s28 s52 }
         node n30 125 200  20. free  { s28 s29 s53 }
         node n31 150 200  20. free  { s29 s30 s54 }
         node n32 175 200  20. free  { s30 s31 s55 }
         node n33 200 200  20. free  { s31 s32 s56 }
         node n34 225 200  20. free  { s32 s33 s57 }
         node n35 250 200  20. free  { s33 s34 s58 }
         node n36 275 200  20. free  { s34 s35 s59 }
         node n37 300 200  20. free  { s35 s36 s60 }
         node n38 325 200  20. free  { s36 s37 s61 }
         node n39 350 200  20. free  { s37 s38 s62 }
         node n40 375 200  20. free  { s38 s39 s63 }
         node n41 400 200  20. free  { s39 s40 s64 }
         node n42 425 200  20. free  { s40 s41 s65 }
         node n43 450 200  20. free  { s41 s42 s66 }
         node n44 475 200  20. free  { s42 s43 s67 }
         node n45 500 200  20. free  { s43 s44 s68 }
         node n46 525 200  20. free  { s44 s45 s69 }
         node n47 550 200  20. free  { s45 s46 s70 }
         node n48 575 200  20. free  { s46 s47 s71 }
         node n49 600 200  20. free  { s47 s48 s72 }
         node n50 625 200  20. fixed { s48     s73 }

         # Main upper cable
         spring s1  90.0  45.0  10. {n1   n2 }
         spring s2  90.0  45.0  10. {n2   n3 }
         spring s3  90.0  45.0  10. {n3   n4 }
         spring s4  90.0  45.0  10. {n4   n5 }
         spring s5  90.0  45.0  10. {n5   n6 }
         spring s6  90.0  45.0  10. {n6   n7 }
         spring s7  90.0  45.0  10. {n7   n8 }
         spring s8  90.0  45.0  10. {n8   n9 }
         spring s9  90.0  45.0  10. {n9   n10}
         spring s10 90.0  45.0  10. {n10  n11}
         spring s11 90.0  45.0  10. {n11  n12}
         spring s12 90.0  45.0  10. {n12  n13}
         spring s13 90.0  45.0  10. {n13  n14}
         spring s14 90.0  45.0  10. {n14  n15}
         spring s15 90.0  45.0  10. {n15  n16}
         spring s16 90.0  45.0  10. {n16  n17}
         spring s17 90.0  45.0  10. {n17  n18}
         spring s18 90.0  45.0  10. {n18  n19}
         spring s19 90.0  45.0  10. {n19  n20}
         spring s20 90.0  45.0  10. {n20  n21}
         spring s21 90.0  45.0  10. {n21  n22}
         spring s22 90.0  45.0  10. {n22  n23}
         spring s23 90.0  45.0  10. {n23  n24}
         spring s24 90.0  45.0  10. {n24  n25}

         # Suspension cables
         spring s25 90.0  45.0  10. {n26  n27}
         spring s26 90.0  45.0  10. {n27  n28}
         spring s27 90.0  45.0  10. {n28  n29}
         spring s28 90.0  45.0  10. {n29  n30}
         spring s29 90.0  45.0  10. {n30  n31}
         spring s30 90.0  45.0  10. {n31  n32}
         spring s31 90.0  45.0  10. {n32  n33}
         spring s32 90.0  45.0  10. {n33  n34}
         spring s33 90.0  45.0  10. {n34  n35}
         spring s34 90.0  45.0  10. {n35  n36}
         spring s35 90.0  45.0  10. {n36  n37}
         spring s36 90.0  45.0  10. {n37  n38}
         spring s37 90.0  45.0  10. {n38  n39}
         spring s38 90.0  45.0  10. {n39  n40}
         spring s39 90.0  45.0  10. {n40  n41}
         spring s40 90.0  45.0  10. {n41  n42}
         spring s41 90.0  45.0  10. {n42  n43}
         spring s42 90.0  45.0  10. {n43  n44}
         spring s43 90.0  45.0  10. {n44  n45}
         spring s44 90.0  45.0  10. {n45  n46}
         spring s45 90.0  45.0  10. {n46  n47}
         spring s46 90.0  45.0  10. {n47  n48}
         spring s47 90.0  45.0  10. {n48  n49}
         spring s48 90.0  45.0  10. {n49  n50}

         # Deck
         spring s49 90.0  45.0 100. {n1   n26}
         spring s50 90.0  45.0  86. {n2   n27}
         spring s51 90.0  45.0  84. {n3   n28}
         spring s52 90.0  45.0  85. {n4   n29}
         spring s53 90.0  45.0 102. {n5   n30}
         spring s54 90.0  45.0 115. {n6   n31}
         spring s55 90.0  45.0 132. {n7   n32}
         spring s56 90.0  45.0 165. {n8   n33}
         spring s57 90.0  45.0 190. {n9   n34}
         spring s58 90.0  45.0 174. {n10  n35}
         spring s59 90.0  45.0 160. {n11  n36}
         spring s60 90.0  45.0 153. {n12  n37}
         spring s61 90.0  45.0 145. {n13  n38}
         spring s62 90.0  45.0 153. {n14  n39}
         spring s63 90.0  45.0 160. {n15  n40}
         spring s64 90.0  45.0 174. {n16  n41}
         spring s65 90.0  45.0 190. {n17  n42}
         spring s66 90.0  45.0 165. {n18  n43}
         spring s67 90.0  45.0 132. {n19  n44}
         spring s68 90.0  45.0 115. {n20  n45}
         spring s69 90.0  45.0 102. {n21  n46}
         spring s70 90.0  45.0  85. {n22  n47}
         spring s71 90.0  45.0  84. {n23  n48}
         spring s72 90.0  45.0  86. {n24  n49}
         spring s73 90.0  45.0 100. {n25  n50}
     }

     set State(node_list)   {}
     set State(spring_list) {}

     eval $definition($model)

     foreach s $State(spring_list) {
         set n1 $State($s,n1)
         set n2 $State($s,n2)
         set State($s,x1) $State($n1,x)
         set State($s,y1) $State($n1,y)
         set State($s,x2) $State($n2,x)
         set State($s,y2) $State($n2,y)
     }

     # Clear out the "spring list" for each node
     foreach n $State(node_list) {
         set State($n,slist) {}
     }

     # And re-build the list here from the information
     # contained within each spring's "node list"
     foreach s $State(spring_list) {
         set nlist $State($s,nlist)
         foreach n $nlist {
             lappend State($n,slist) $s
         }
     }

     # puts "---------------------------------"
# puts "Regenerated spring list
"
     # foreach n $State(node_list) {
     #    puts "$n : $State($n,slist)"
     # }
     # puts "---------------------------------"

 }

 # Constructors
 proc spring {spring k damp rest nlist} {
     global State
     set State($spring,name)    $spring
     set State($spring,k)       $k
     set State($spring,kd)      $damp
 #    set State($spring,rest)    $rest
     set State($spring,rest)    [expr {$rest * $State(canv,scale)}]
     set State($spring,nlist)   $nlist
     set State($spring,x1)      0.
     set State($spring,y1)      0.
     set State($spring,x2)      0.
     set State($spring,y2)      0.
     set State($spring,dist)    0.
     set State($spring,force)   0.
     foreach {n1 n2} $nlist {
         set State($spring,n1)  $n1
         set State($spring,n2)  $n2
         break
     }
     lappend State(spring_list) $spring
 }

 proc node {node x y m type slist} {
     global State

     set State($node,name)  $node
 #    set State($node,x)     $x
 #    set State($node,y)     $y
     set State($node,x)     [expr {$x * $State(canv,scale)}]
     set State($node,y)     [expr {$y * $State(canv,scale)}]
     set State($node,rad)   [expr $m * 0.1]
     set State($node,mass)  $m
     set State($node,type)  $type
     set State($node,vx)    0.0
     set State($node,vy)    0.0
     set State($node,ax)    0.0
     set State($node,ay)    0.0
     set State($node,Fx)    0.0
     set State($node,Fy)    0.0
     set State($node,slist) $slist
     lappend State(node_list) $node
 }

if 0 {

This routine is the main solver. The main loop runs until maxTime is reached. Or until some other exit condition is reached.

At each time step the current forces due to each spring (and gravity) are calculated. A Runge-Kutta routine is then used to calculate the newly calculated positions etc. at the next time step.

}

 proc solve {func} {
     global State

     if { $State(running) == 0 } {
         return
     }

     set funcq    [uplevel 1 namespace which -command $func]

     set done 0

     while { $done == 0 } {

         set t        $State(t)
         set dmax 0.0

         update_spring_forces
         apply_spring_force_to_nodes

         foreach n $State(node_list) {

             set xvec [list $State($n,vx) $State($n,vy) $State($n,ax) $State($n,ay)]
             set xresult [rungeKuttaStep $n $State(t) $State(dt) $xvec rkfunc]
             foreach {nvx nvy xa ya} $xresult {break}

             set yvec [list $State($n,x) $State($n,y) $nvx $nvy]
             set yresult [rungeKuttaStep $n $State(t) $State(dt) $yvec rkfunc ]
             foreach {nx ny nvx nvy} $yresult {break}

             set m [apply_forces $n $nx $ny $nvx $nvy]

             if {[expr {abs($m)}] > $dmax} {
                 set dmax [expr {abs($m)}]
             }
         }

         set State(dmax) $dmax

         set State(t) [expr {$State(t) + $State(dt)}]

         update_geom

         if {$dmax < $State(tol) || $State(t) > $State(MaxTime)} {
             set done 1
         }
         if { $State(running) == 0 } {
             set done 1
         }
     }
 }

if 0 {

Calculate the derivatives

}

 proc rkfunc {n t xvec} {

     foreach {x y vx vy} $xvec {break}
     return [list $vx $vy 0.0 0.0]
 }

if 0 {

This routine loops over each spring and calculates the force due to the displacement of each node.

}

 proc update_spring_forces { } {
     global State

     zero_node_forces

     foreach s $State(spring_list) {

         set dx     [expr { $State($s,x2) - $State($s,x1) } ]
         set dy     [expr { $State($s,y2) - $State($s,y1) } ]
         set dist   [expr { sqrt($dx * $dx + $dy * $dy) } ]

         set State($s,dist)  $dist
         set State($s,force) [expr { -$State($s,k) * ($dist - $State($s,rest))}]
     }
 }

if 0 {

Set the forces applied to each node to zero.

}

 proc zero_node_forces { } {
     global State

     foreach n $State(node_list) {
         set State($n,Fx) 0.0
         set State($n,Fy) 0.0
     }
 }

if 0 {

Calculate the forces,accelerations,velocities,etc. to be applied to each node.

}

 proc apply_spring_force_to_nodes { } {
     global State

     foreach n $State(node_list) {

         set State($n,Fy) [expr {$State(gravity) * $State($n,mass)}]

         foreach s $State($n,slist) {

             if {$n == $State($s,n1)} {
                 set n1 $State($s,n1)
                 set n2 $State($s,n2)
             } else {
                 set n1 $State($s,n2)
                 set n2 $State($s,n1)
             }

             set dx    [expr { $State($n1,x) - $State($n2,x) } ]
             set dy    [expr { $State($n1,y) - $State($n2,y) } ]
             set dvx   [expr { $State($n1,vx) - $State($n2,vx) } ]
             set dvy   [expr { $State($n1,vy) - $State($n2,vy) } ]
             set VdotL [expr { $dvx * $dx + $dvy * $dy } ]

             set dist  $State($s,dist)
             set damp  [expr { $State($s,kd) * $VdotL / $dist }]
             set force [expr { $State($s,force) - $damp } ]

             set Fx [expr { $force * $dx / $dist } ]
             set Fy [expr { $force * $dy / $dist} ]

             set State($n,Fx) [expr {$State($n,Fx) + $Fx}]
             set State($n,Fy) [expr {$State($n,Fy) + $Fy}]
         }
         set State($n,ax) [expr {$State($n,Fx) / $State($n,mass)}]
         set State($n,ay) [expr {$State($n,Fy) / $State($n,mass)}]
     }
 }

if 0 {

I borrowed this routine from tcllib. Specifically I borrowed the math::calculus::rungeKuttaStep routine so that I could modify it slightly. In the process, I believe that I found a "typo/bug" in the tcllib routine (search MBS below for more info). The bug has been reported and will be fixed in the next release of tcllib (Note: It was in version 1.7).

}

 ################################################################
 # 
 # rungeKuttaStep --
 #    Integrate a system of ordinary differential equations of the type
 #    x' = f(x,t), where x is a vector of quantities. Integration is
 #    done over a single step according to Runge-Kutta 4th order.
 #
 # Arguments:
 #    t           Start value of independent variable (time for instance)
 #    tstep       Step size of interval
 #    xvec        Vector of dependent values at the start
 #    func        Function taking the arguments t and xvec to return
 #                the derivative of each dependent variable.
 # Return value:
 #    List of values at the end of the step
 #
 proc rungeKuttaStep { n t tstep xvec func } {

    set funcq    [uplevel 1 namespace which -command $func]

    #
    # Four steps:
    # - k1 = tstep*func(t,x0)
    # - k2 = tstep*func(t+0.5*tstep,x0+0.5*k1)
    # - k3 = tstep*func(t+0.5*tstep,x0+0.5*k2)
    # - k4 = tstep*func(t+    tstep,x0+    k3)
    # - x1 = x0 + (k1+2*k2+2*k3+k4)/6
    #
    set tstep2   [expr {$tstep/2.0}]
    set tstep6   [expr {$tstep/6.0}]

    set xk1      [$funcq $n $t $xvec]
    set xvec2    {}
    foreach x1 $xvec xv $xk1 {
       lappend xvec2 [expr {$x1+$tstep2*$xv}]
    }

    set xk2      [$funcq $n [expr {$t+$tstep2}] $xvec2]
    set xvec3    {}
    foreach x1 $xvec xv $xk2 {
       lappend xvec3 [expr {$x1+$tstep2*$xv}]
    }

    set xk3      [$funcq $n [expr {$t+$tstep2}] $xvec3]
    set xvec4    {}
    foreach x1 $xvec xv $xk3 {
       lappend xvec4 [expr {$x1+$tstep *$xv}]
    }
    #***************************************************************************
    # MBS :
    # Previously the above line had:
    #   lappend xvec4 [expr {$x1+$tstep2*$xv}]
    # The "bug" is that $tstep2 in the above line should actually be $tstep
    # From the description above
    #           # - k4 = tstep*func(t+    tstep,x0+    k3)
    # tstep is used rather than tstep*0.5 (ie tstep2)
    #***************************************************************************


    set xk4      [$funcq $n [expr {$t+$tstep}] $xvec4]
    set result   {}
    foreach x0 $xvec k1 $xk1 k2 $xk2 k3 $xk3 k4 $xk4 {
       set dx [expr {$k1+2.0*$k2+2.0*$k3+$k4}]
       lappend result [expr {$x0+$dx*$tstep6}]
    }
    return $result
 }

if 0 {

Apply the newly calculated positions and velocities of each node.

Also make sure that each node is bounced off the top/bottom/sides of the canvas.

}

 proc apply_forces {n nx ny nvx nvy} {
     global State

     set State($n,dx) 0.0
     set State($n,dy) 0.0

     if { $State($n,type) == "fixed" } {
         return 0.0
     }

     set dx [expr { $nx - $State($n,x) } ]
     set dy [expr { $ny - $State($n,y) } ]

     set State($n,dx) $dx
     set State($n,dy) $dy

     # Simple collision detection
     #
     # Get the current height and width of the canvas
     set cw  [winfo width  $State(canvas)]
     set ch  [winfo height $State(canvas)]

     # if the new node position "nx" , "ny" is off the canvas
     # adjust its position and velocity ("nvx","nvy").
     # The velocity vector is adjusted as follows :
     #
     #    - the direction component if "flipped" :  
     #         vx = -vx
     #
     #    - the magnitude of the vector is reduced : 
     #         vx = 0.5 * vx 
     #         vy = 0.5 * vy
     #      this makes it appear that the node "sticks" to
     #      the wall briefly (ie friction).  One of these days
     #      I'll probably look up the "correct" equation for
     #      applying friction, but for the present, this 
     #      appears to produced "visually correct" results.
     #

     set sticky 0.5

     if {$nx < 0.0} {
         set nx  [expr {abs($nx)}]
         set nvx [expr {-$sticky * $nvx}]
         set nvy [expr { $sticky * $nvy}]
     }

     if {$nx > $cw} {
         set nx  [expr {$cw - ($nx - $cw)}]
         set nvx [expr {-$sticky * $nvx}]
         set nvy [expr { $sticky * $nvy}]
     }

     if {$ny < 0.0} {
         set ny  [expr {abs($ny)}]
         set nvy [expr {-$sticky * $nvy}]
         set nvx [expr { $sticky * $nvx}]
     }

     if {$ny > $ch} {
         set ny  [expr {$ch - ($ny - $ch)}]
         set nvy [expr {-$sticky * $nvy}]
         set nvx [expr { $sticky * $nvx}]
     }
     # end of collision detection

     set State($n,x) $nx
     set State($n,y) $ny

     set State($n,vx) $nvx
     set State($n,vy) $nvy

     foreach s $State($n,slist) {
         if {$n == $State($s,n1)} {
             set State($s,x1)     $State($n,x)
             set State($s,y1)     $State($n,y)
         } else {
             set State($s,x2)     $State($n,x)
             set State($s,y2)     $State($n,y)
         }
     }
     return [expr {sqrt($dx*$dx + $dy*$dy)} ]
 }

if 0 {

Initialize the interface :

Hopefully this is pretty straight forward...

}

 proc init_display { } {
     global State

     # Window things
     wm title . "TclSpringies"
     wm geometry . "+0+0"
     wm protocol . WM_DELETE_WINDOW {exit}

     # Create canvas
   # set State(canvas) [canvas .c -width 700 -height 700 -background black]
     set State(canvas) [canvas .c -background black \
                            -width  $State(canvasWidth) \
                            -height $State(canvasHeight)]
   # pack $State(canvas) -fill both -expand true

     bind $State(canvas) <ButtonPress-1>   {c_select %W %x %y}
     bind $State(canvas) <B1-Motion>       {c_drag   %W %x %y}
     bind $State(canvas) <ButtonRelease-1> {c_drop   %W %x %y}

     frame .fr -bd 2 -relief raised
   # pack .fr -side bottom -fill x
     button .fr.quit  -text "Quit"  -command {exit}
     button .fr.start -text "Start" -command {set State(running) 1; solve rkfunc}
     button .fr.stop  -text "Stop"  -command {set State(running) 0}
     button .fr.reset -text "Reset" -command {reset}
     label .fr.mtlbl -text "Max Time "
     entry .fr.maxt -textvariable State(MaxTime) -width 5

     label .fr.ldt -text "Time Step "
     entry .fr.edt -textvariable State(dt) -width 8

     label .fr.ltol -text "Tolerance "
     entry .fr.etol -textvariable State(tol) -width 8

     set ::menu_selection $State(model,Current)
     set cmd "tk_optionMenu .fr.model ::menu_selection $State(models)"
     eval $cmd

     # Use a trace on the menu selection variable to 
     # execute the routine "reset" when the user makes a selection
     trace variable ::menu_selection w reset

     pack .fr.quit  -side left
     pack .fr.start -side left
     pack .fr.stop  -side left
     pack .fr.reset -side left
     pack .fr.mtlbl -side left
     pack .fr.maxt  -side left
     pack .fr.ldt   -side left
     pack .fr.edt   -side left
     pack .fr.ltol  -side left
     pack .fr.etol  -side left
     pack .fr.model -side left

     frame .f1 -bd 2 -relief raised
     label .f1.tlab -text "Time : "
     label .f1.tval -textvariable State(t) -background white -width 20

     pack .f1.tlab -side left
     pack .f1.tval -side left -fill x 

     frame .f2 -bd 2 -relief raised
     label .f2.dlab -text "dMax : "
     label .f2.dval -textvariable State(dmax) -background white -width 20

     pack .f2.dlab -side left
     pack .f2.dval -side left -fill x

     pack .fr -side top -fill x
     pack $State(canvas) -side bottom -fill both -expand true
     pack .f1 .f2 -side left -fill x -expand yes

     update
 }

if 0 {

Display the current geometry :

}

 proc draw_geom { } {
     global State

     set canvasHeight [winfo height $State(canvas)]
     set canvasWidth  [winfo width $State(canvas)]

     foreach s $State(spring_list) {
         set x1 $State($s,x1)
         set y1 [expr $canvasHeight - $State($s,y1)]
         set x2 $State($s,x2)
         set y2 [expr $canvasHeight - $State($s,y2)]
         set State($s,id) [$State(canvas) create line $x1 $y1 $x2 $y2 \
                               -fill white -tag $s]
     }

     foreach n $State(node_list) {
         set r  $State($n,rad)
         set x1 [expr                 $State($n,x) - $r]
         set y1 [expr $canvasHeight - $State($n,y) - $r]
         set x2 [expr                 $State($n,x) + $r]
         set y2 [expr $canvasHeight - $State($n,y) + $r]
         if { $State($n,type) == "fixed" } {
             set State($n,id) [$State(canvas) create oval $x1 $y1 $x2 $y2 \
                                   -outline white -fill red -tag $n ]
         } else {
             set State($n,id) [$State(canvas) create oval $x1 $y1 $x2 $y2 \
                                   -outline white -fill blue -tag $n ]
         }
     }
     update
 }

if 0 {

Update the geometry after each time step

}

 proc update_geom { } {
     global State

     set canvasHeight [winfo height $State(canvas)]
     set canvasWidth  [winfo width $State(canvas)]

     foreach s $State(spring_list) {
         set x1 $State($s,x1)
         set y1 [expr $canvasHeight - $State($s,y1)]
         set x2 $State($s,x2)
         set y2 [expr $canvasHeight - $State($s,y2)]
         $State(canvas) coords $State($s,id) $x1 $y1 $x2 $y2 
     }

     foreach n $State(node_list) {
         set r  $State($n,rad)
         set x1 [expr                 $State($n,x) - $r]
         set y1 [expr $canvasHeight - $State($n,y) - $r]
         set x2 [expr                 $State($n,x) + $r]
         set y2 [expr $canvasHeight - $State($n,y) + $r]
         $State(canvas) coords $State($n,id) $x1 $y1 $x2 $y2
     }
     update
 }

if 0 {

Some canvas related routines...

Allows the user to select / drag / drop a node using Button-One

}

 proc c_closest_node {w x y} {
     global State

     set x [$w canvasx $x]
     set y [$w canvasy $y]

     set all_list [$w find all]

     set mdist 9999999.
     set pt_num {}

     foreach item $all_list {

         set ptr  [$w itemcget $item -tags]
         set lndx [lsearch $ptr "n*"]

         if {$lndx != -1} {
             set cord [$w coords $item]
             set nx [expr ([lindex $cord 0] + [lindex $cord 2]) / 2.0]
             set ny [expr ([lindex $cord 1] + [lindex $cord 3]) / 2.0]
             set dx [expr $x - $nx]
             set dy [expr $y - $ny]
             set dst [expr sqrt($dx*$dx + $dy*$dy)]
             if {$dst < $mdist} {
                 set it    $ptr
                 set mdist $dst
             }
         }
     }
     set node [lindex $it 0]
     return $node
 }

 proc c_select {w x y} {
     global State

     set canvasHeight [winfo height $State(canvas)]
     set canvasWidth  [winfo width $State(canvas)]

     set node [c_closest_node $w $x $y]

     set State(curNode) $node
     if {$State(curNode) != "none"} {
         c_move_node $State(curNode) $x $y
     } else {
         set State(curNode) "none"
     }
 }

 proc c_drag {w x y} {
     global State

     set canvasHeight [winfo height $State(canvas)]
     set canvasWidth  [winfo width $State(canvas)]

     if {$State(curNode) != "none"} {
         c_move_node $State(curNode) $x $y
     }
 }

 proc c_drop {w x y} {
     global State

     set canvasHeight [winfo height $State(canvas)]
     set canvasWidth  [winfo width $State(canvas)]

     if {$State(curNode) != "none"} {
         c_move_node $State(curNode) $x $y
     }
     set State(curNode) "none"

 }

 proc c_move_node {n x y} {
     global State

     set canvasHeight [winfo height $State(canvas)]
     set canvasWidth  [winfo width $State(canvas)]

     set r           $State($n,rad)
     set State($n,x) $x
     set State($n,y) [expr {$canvasHeight - $y}]
     set x1 [expr                 $State($n,x) - $r]
     set y1 [expr $canvasHeight - $State($n,y) - $r]
     set x2 [expr                 $State($n,x) + $r]
     set y2 [expr $canvasHeight - $State($n,y) + $r]
     $State(canvas) coords $State($n,id) $x1 $y1 $x2 $y2 

     foreach s $State($n,slist) {
         if {$n == $State($s,n1)} {
             set scoords [$State(canvas) coords $State($s,id)]
             foreach {x1 y1 x2 y2} $scoords {break}
             set State($s,x1)     $x
             set State($s,y1)     [expr {$canvasHeight - $y}]
             $State(canvas) coords $State($s,id) $x $y $x2 $y2
         } else {
             set scoords [$State(canvas) coords $State($s,id)]
             foreach {x1 y1 x2 y2} $scoords {break}
             set State($s,x2)     $x
             set State($s,y2)     [expr {$canvasHeight - $y}]
             $State(canvas) coords $State($s,id) $x1 $y1 $x $y
         }
     }

 }

if 0 {

Reset to the initial geometry.

}

 proc reset {args} {
     global State

     set State(t) 0.0

     #new-12-10-2004 
     set cx 700   
     set cy 700
     set cw  [winfo width  $State(canvas)]
     set ch  [winfo height $State(canvas)]

     if {$cw < $ch} {
         set State(canvasWidth)   $cw
         set State(canvasHeight)  $cw
     } else {
         set State(canvasWidth)   $ch
         set State(canvasHeight)  $ch
     }
     set State(canv,scale)  [expr {1.0 * $State(canvasWidth)  / $cx}]
     #new-12-10-2004 

  #   set State(model,Current) 
  #   init_geom $State(model,Current)

     init_geom $::menu_selection

     $State(canvas) delete all
     draw_geom
     update_geom
 }

if 0 {

The 'main' code to start the simulation.

}

 ########################################################################

 init_geom bridge
 init_display
 draw_geom

 set State(running) 0

 solve rkfunc

if 0 {


[ Category Command

Category Graphics ] }