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 :)
}
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
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 :
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:
spring_def is the list of springs containing the following info for each 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.
}
proc init_geom {{model bridge}} {
global State
########################################################################
set definition(1) {
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}
}
########################################################################
set definition(2) {
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}
}
########################################################################
set definition(3) {
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}
}
########################################################################
set definition(4) {
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 }
}
######################## 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)
}
}
# 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.
}
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
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.ltol -text "Tolerance "
entry .fr.etol -textvariable State(tol) -width 8
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.ltol -side left
pack .fr.etol -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 dy [expr -1.0 * $State($n,dy)]
# $State(canvas) move $State($n,id) $State($n,dx) $dy
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 { } {
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
init_geom
$State(canvas) delete all
draw_geom
update_geom
}if 0 {
The 'main' code to start the simulation.
}
######################################################################## init_display init_geom draw_geom set State(running) 0 solve rkfunc
if 0 {