[ Avaa Bypassed ]




Upload:

Command:

hmhc3928@3.140.188.201: ~ $
# pendulum.tcl --
#
# This demonstration illustrates how Tcl/Tk can be used to construct
# simulations of physical systems.

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

package require Tk

set w .pendulum
catch {destroy $w}
toplevel $w
wm title $w "Pendulum Animation Demonstration"
wm iconname $w "pendulum"
positionWindow $w

label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration shows how Tcl/Tk can be used to carry out animations that are linked to simulations of physical systems. In the left canvas is a graphical representation of the physical system itself, a simple pendulum, and in the right canvas is a graph of the phase space of the system, which is a plot of the angle (relative to the vertical) against the angular velocity. The pendulum bob may be repositioned by clicking and dragging anywhere on the left canvas."
pack $w.msg

## See Code / Dismiss buttons
set btns [addSeeDismiss $w.buttons $w]
pack $btns -side bottom -fill x

# Create some structural widgets
pack [panedwindow $w.p] -fill both -expand 1
$w.p add [labelframe $w.p.l1 -text "Pendulum Simulation"]
$w.p add [labelframe $w.p.l2 -text "Phase Space"]

# Create the canvas containing the graphical representation of the
# simulated system.
canvas $w.c -width 320 -height 200 -background white -bd 2 -relief sunken
$w.c create text 5 5 -anchor nw -text "Click to Adjust Bob Start Position"
# Coordinates of these items don't matter; they will be set properly below
$w.c create line 0 25 320 25   -tags plate -fill grey50 -width 2
$w.c create oval 155 20 165 30 -tags pivot -fill grey50 -outline {}
$w.c create line 1 1 1 1       -tags rod   -fill black  -width 3
$w.c create oval 1 1 2 2       -tags bob   -fill yellow -outline black
pack $w.c -in $w.p.l1 -fill both -expand true

# Create the canvas containing the phase space graph; this consists of
# a line that gets gradually paler as it ages, which is an extremely
# effective visual trick.
canvas $w.k -width 320 -height 200 -background white -bd 2 -relief sunken
$w.k create line 160 200 160 0 -fill grey75 -arrow last -tags y_axis
$w.k create line 0 100 320 100 -fill grey75 -arrow last -tags x_axis
for {set i 90} {$i>=0} {incr i -10} {
    # Coordinates of these items don't matter; they will be set properly below
    $w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i
}
# FIXME: UNICODE labels
$w.k create text 0 0 -anchor ne -text "q" -font {Symbol 8} -tags label_theta
$w.k create text 0 0 -anchor ne -text "dq" -font {Symbol 8} -tags label_dtheta
pack $w.k -in $w.p.l2 -fill both -expand true

# Initialize some variables
set points {}
set Theta   45.0
set dTheta   0.0
set pi       3.1415926535897933
set length 150
set home   160

# This procedure makes the pendulum appear at the correct place on the
# canvas. If the additional arguments "at $x $y" are passed (the 'at'
# is really just syntactic sugar) instead of computing the position of
# the pendulum from the length of the pendulum rod and its angle, the
# length and angle are computed in reverse from the given location
# (which is taken to be the centre of the pendulum bob.)
proc showPendulum {canvas {at {}} {x {}} {y {}}} {
    global Theta dTheta pi length home
    if {$at eq "at" && ($x!=$home || $y!=25)} {
	set dTheta 0.0
	set x2 [expr {$x - $home}]
	set y2 [expr {$y - 25}]
	set length [expr {hypot($x2, $y2)}]
	set Theta  [expr {atan2($x2, $y2) * 180/$pi}]
    } else {
	set angle [expr {$Theta * $pi/180}]
	set x [expr {$home + $length*sin($angle)}]
	set y [expr {25    + $length*cos($angle)}]
    }
    $canvas coords rod $home 25 $x $y
    $canvas coords bob \
	    [expr {$x-15}] [expr {$y-15}] [expr {$x+15}] [expr {$y+15}]
}
showPendulum $w.c

# Update the phase-space graph according to the current angle and the
# rate at which the angle is changing (the first derivative with
# respect to time.)
proc showPhase {canvas} {
    global Theta dTheta points psw psh
    lappend points [expr {$Theta+$psw}] [expr {-20*$dTheta+$psh}]
    if {[llength $points] > 100} {
    	 set points [lrange $points end-99 end]
    }
    for {set i 0} {$i<100} {incr i 10} {
	set list [lrange $points end-[expr {$i-1}] end-[expr {$i-12}]]
	if {[llength $list] >= 4} {
	    $canvas coords graph$i $list
	}
    }
}

# Set up some bindings on the canvases.  Note that when the user
# clicks we stop the animation until they release the mouse
# button. Also note that both canvases are sensitive to <Configure>
# events, which allows them to find out when they have been resized by
# the user.
bind $w.c <Destroy> {
    after cancel $animationCallbacks(pendulum)
    unset animationCallbacks(pendulum)
}
bind $w.c <1> {
    after cancel $animationCallbacks(pendulum)
    showPendulum %W at %x %y
}
bind $w.c <B1-Motion> {
    showPendulum %W at %x %y
}
bind $w.c <ButtonRelease-1> {
    showPendulum %W at %x %y
    set animationCallbacks(pendulum) [after 15 repeat [winfo toplevel %W]]
}
bind $w.c <Configure> {
    %W coords plate 0 25 %w 25
    set home [expr %w/2]
    %W coords pivot [expr $home-5] 20 [expr $home+5] 30
}
bind $w.k <Configure> {
    set psh [expr %h/2]
    set psw [expr %w/2]
    %W coords x_axis 2 $psh [expr %w-2] $psh
    %W coords y_axis $psw [expr %h-2] $psw 2
    %W coords label_dtheta [expr $psw-4] 6
    %W coords label_theta [expr %w-6] [expr $psh+4]
}

# This procedure is the "business" part of the simulation that does
# simple numerical integration of the formula for a simple rotational
# pendulum.
proc recomputeAngle {} {
    global Theta dTheta pi length
    set scaling [expr {3000.0/$length/$length}]

    # To estimate the integration accurately, we really need to
    # compute the end-point of our time-step.  But to do *that*, we
    # need to estimate the integration accurately!  So we try this
    # technique, which is inaccurate, but better than doing it in a
    # single step.  What we really want is bound up in the
    # differential equation:
    #       ..             - sin theta
    #      theta + theta = -----------
    #                         length
    # But my math skills are not good enough to solve this!

    # first estimate
    set firstDDTheta [expr {-sin($Theta * $pi/180)*$scaling}]
    set midDTheta [expr {$dTheta + $firstDDTheta}]
    set midTheta [expr {$Theta + ($dTheta + $midDTheta)/2}]
    # second estimate
    set midDDTheta [expr {-sin($midTheta * $pi/180)*$scaling}]
    set midDTheta [expr {$dTheta + ($firstDDTheta + $midDDTheta)/2}]
    set midTheta [expr {$Theta + ($dTheta + $midDTheta)/2}]
    # Now we do a double-estimate approach for getting the final value
    # first estimate
    set midDDTheta [expr {-sin($midTheta * $pi/180)*$scaling}]
    set lastDTheta [expr {$midDTheta + $midDDTheta}]
    set lastTheta [expr {$midTheta + ($midDTheta + $lastDTheta)/2}]
    # second estimate
    set lastDDTheta [expr {-sin($lastTheta * $pi/180)*$scaling}]
    set lastDTheta [expr {$midDTheta + ($midDDTheta + $lastDDTheta)/2}]
    set lastTheta [expr {$midTheta + ($midDTheta + $lastDTheta)/2}]
    # Now put the values back in our globals
    set dTheta $lastDTheta
    set Theta $lastTheta
}

# This method ties together the simulation engine and the graphical
# display code that visualizes it.
proc repeat w {
    global animationCallbacks

    # Simulate
    recomputeAngle

    # Update the display
    showPendulum $w.c
    showPhase $w.k

    # Reschedule ourselves
    set animationCallbacks(pendulum) [after 15 [list repeat $w]]
}
# Start the simulation after a short pause
set animationCallbacks(pendulum) [after 500 [list repeat $w]]

Filemanager

Name Type Size Permission Actions
images Folder 0755
README File 2.03 KB 0644
anilabel.tcl File 6.51 KB 0644
aniwave.tcl File 3.41 KB 0644
arrow.tcl File 7.8 KB 0644
bind.tcl File 2.87 KB 0644
bitmap.tcl File 1.38 KB 0644
browse File 1.72 KB 0755
button.tcl File 1.47 KB 0644
check.tcl File 2.22 KB 0644
clrpick.tcl File 1.4 KB 0644
colors.tcl File 4.88 KB 0644
combo.tcl File 1.94 KB 0644
cscroll.tcl File 3.31 KB 0644
ctext.tcl File 4.76 KB 0644
dialog1.tcl File 660 B 0644
dialog2.tcl File 613 B 0644
en.msg File 3.8 KB 0644
entry1.tcl File 1.35 KB 0644
entry2.tcl File 2.06 KB 0644
entry3.tcl File 5.95 KB 0644
filebox.tcl File 2.2 KB 0644
floor.tcl File 77.24 KB 0644
form.tcl File 1.02 KB 0644
goldberg.tcl File 55.23 KB 0644
hello File 512 B 0755
hscale.tcl File 1.46 KB 0644
icon.tcl File 2.01 KB 0644
image1.tcl File 1002 B 0644
image2.tcl File 3.28 KB 0644
items.tcl File 9.5 KB 0644
ixset File 7.91 KB 0755
knightstour.tcl File 8.38 KB 0644
label.tcl File 1.29 KB 0644
labelframe.tcl File 1.8 KB 0644
license.terms File 2.16 KB 0644
mclist.tcl File 3.89 KB 0644
menu.tcl File 6.57 KB 0644
menubu.tcl File 4.37 KB 0644
msgbox.tcl File 1.98 KB 0644
nl.msg File 6.61 KB 0644
paned1.tcl File 1.08 KB 0644
paned2.tcl File 2.18 KB 0644
pendulum.tcl File 7.46 KB 0644
plot.tcl File 2.69 KB 0644
puzzle.tcl File 2.54 KB 0644
radio.tcl File 2.69 KB 0644
rmt File 5.22 KB 0755
rolodex File 8.11 KB 0755
ruler.tcl File 5.09 KB 0644
sayings.tcl File 2.21 KB 0644
search.tcl File 4.29 KB 0644
spin.tcl File 1.78 KB 0644
states.tcl File 1.63 KB 0644
style.tcl File 6.78 KB 0644
tclIndex File 4.25 KB 0644
tcolor File 10.99 KB 0755
text.tcl File 3.34 KB 0644
textpeer.tcl File 2.13 KB 0644
timer File 1.09 KB 0755
toolbar.tcl File 3.19 KB 0644
tree.tcl File 3.29 KB 0644
ttkbut.tcl File 3.34 KB 0644
ttkmenu.tcl File 2.35 KB 0644
ttknote.tcl File 2.41 KB 0644
ttkpane.tcl File 3.95 KB 0644
ttkprogress.tcl File 1.52 KB 0644
ttkscale.tcl File 1.39 KB 0644
twind.tcl File 10.57 KB 0644
unicodeout.tcl File 3.45 KB 0644
vscale.tcl File 1.44 KB 0644
widget File 22.83 KB 0755