TclSpringies : A simple mass and spring simulator
Description
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.
Screenshots
EKB Nifty! A couple of screenshots...
Grabbing and pulling on one of the nodes
Letting it go and seeing the effect
Discussion
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).
I also made a change to the routine init_geom to make it simpler to define geometries.
AMG 7 Dec 2005
Now you can middle click a node to switch its type from fixed to free and back again. Nifty. This lets you make cool spiderweb patterns out of the ball models.
- Added a binding to [init_display]
- Created [c_chtype]
Start of Code Block
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 {
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 {
new : 12-10-2004 continued
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 {
init_geom : 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 [eval]led; 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}
bind $State(canvas) <ButtonPress-2> {c_chtype %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 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
if {$State(curNode) != "none"} {
c_move_node $State(curNode) $x $y
}
}
proc c_drop {w x y} {
global State
if {$State(curNode) != "none"} {
c_move_node $State(curNode) $x $y
}
set State(curNode) "none"
}
proc c_chtype {w x y} {
global State
set node [c_closest_node $w $x $y]
if {$node != "none"} {
if {$State($node,type) == "fixed" } {
set State($node,type) free
$State(canvas) itemconfigure $State($node,id) -fill blue
} else {
set State($node,type) fixed
$State(canvas) itemconfigure $State($node,id) -fill red
}
}
}
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
}
}
}
# 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
}
# The 'main' code to start the simulation:
########################################################################
init_geom bridge
init_display
draw_geom
set State(running) 0
solve rkfuncAMG: The Wiki isn't formatting the above code correctly. Search for "Regenerated spring list" to see what I mean.
Lars H: Well, that depends on one's perspective; it could be argued that the code wasn't marked up properly, as that particular line looked like a definition list, and hence got formatted as a such. Possibly wikit was stricter, as I seem to recall there should be exactly three spaces between colon and the paragraph text. Either way, I've "fixed" it by writing backslash-space for one of the spaces. See [L3 ] or [L4 ] to see the difference.