Harmonic_oscillator_tcltk
There is a little program of mine, it's about Harmonic_oscillator
For more Information about Harmonic_oscillator you can take a look at Wikipedia
http://en.wikipedia.org/wiki/Harmonic_oscillator
Screenshot:
package require Tk
wm withdraw .
wm title . "Harmonic oscillator ver 1.01 - [email protected]"
wm minsize . 300 200
global GB
set GB(screenwidth) [winfo screenwidth .]
set GB(screenheight) [winfo screenheight .]
#Oben
pack [frame .ft -bd 2 -relief groov ] -side top -fill both -ipadx 2 -ipady 2 -padx 2 -pady 2
pack [frame .ft.f1 ] -side left -fill both -expand 1
pack [frame .ft.f2 ] -side left
pack [label .ft.f1.titel -text "Harmonic oscillator" -font {Arial 20}]
pack [button .ft.f2.help -text "Help" -command {tk_messageBox -message "Author: Lei ZHOU \n Last change: 11.04.2013"}] -side right -padx 10
#Unten
pack [frame .fu -bd 2 -relief groov ] -side bottom -fill both -ipadx 2 -ipady 2 -padx 2 -pady 2
pack [frame .fu.ok -bd 0 -relief solid ] -side left -fill both
pack [button .fu.ok.button -text "Start" -width 8 -font {Arial 14} -command start ] -side left -padx 10
pack [frame .fu.sep1 -bd 2 -relief raised -height 50 -width 3 ] -side left -padx 10
pack [frame .fu.m -bd 0 -relief solid ] -side top -fill both
pack [frame .fu.k -bd 0 -relief solid ] -side top -fill both
pack [frame .fu.c -bd 0 -relief solid ] -side top -fill both
pack [label .fu.m.b -text "Mass:" -width 12 -font {Arial 10} -justify right ] -side left
pack [label .fu.k.b -text "Stiffness:" -width 12 -font {Arial 10} -justify right ] -side left
pack [label .fu.c.b -text "Damping:" -width 12 -font {Arial 10} -justify right ] -side left
pack [entry .fu.m.e -textvar GB(m) -width 10 -font {Arial 10} -bd 2 ] -side left -pady 2
pack [entry .fu.k.e -textvar GB(k) -width 10 -font {Arial 10} -bd 2 ] -side left -pady 2
pack [entry .fu.c.e -textvar GB(c) -width 10 -font {Arial 10} -bd 2 ] -side left -pady 2
#Canvas
pack [frame .f -bd 2 -relief sunken] -fill both -expand 1
pack [canvas .f.c -bg white -cursor plus -highlightthickness 0 -bd 0 -width 500 -height 300] -side top -fill both -expand 1
wm deiconify .
update
set GB(width) [winfo width .]
set GB(height) [winfo height .]
wm geom . +[expr ($GB(screenwidth)-$GB(width))/2]-[expr ($GB(screenheight)-$GB(height))/2]
focus -force .
bind . <Escape> { exit}
#bind . <Escape> { eval [list exec wish85 $argv0] $argv &; exit}
bind .f.c <Expose> { view_init }
bind . <Return> { start }
bind . <F1> { console show }
set GB(m) 1.0
set GB(k) 100
set GB(c) 0.0
set GB(start) 0
set GB(omg) 0.0
set GB(frq) 0.0
set GB(prd) 0.0
set GB(ckr) 0.0
set GB(np) 5
set GB(nt) [expr $GB(np)*32]
set ux(0) 0.0
set GB(w) [winfo width .f.c]
set GB(h) [winfo height .f.c]
set GB(r) 0
set GB(x0) 0
set GB(y0) 0
set GB(x1) 0
set GB(y1) 0
set GB(id_masse) 0
set GB(id_stab) 0
set GB(id_kurve) 0
#########################################
proc view_init {} {
global GB
set GB(start) 0
.fu.ok.button conf -text "Start" -foreground black
.fu.m.e conf -state normal
.fu.k.e conf -state normal
.fu.c.e conf -state normal
set GB(w) [winfo width .f.c]
set GB(h) [winfo height .f.c]
set GB(r) [expr $GB(h)*0.03]
set GB(x0) [expr $GB(h)*0.8]
set GB(y0) [expr $GB(h)*0.5]
set GB(x1) [expr $GB(h)*0.4]
set GB(y1) [expr $GB(h)*0.2]
view_range
view_masse
view_koord
}
proc start {} {
global GB ux kx ky
#check
.fu.m.e conf -bg white
.fu.k.e conf -bg white
.fu.c.e conf -bg white
if ![string length $GB(m)] { .fu.m.e conf -bg red ; return }
if ![string length $GB(k)] { .fu.k.e conf -bg red ; return }
if ![string length $GB(c)] { .fu.c.e conf -bg red ; return }
if [catch {expr $GB(m)}] { .fu.m.e conf -bg red ; return }
if [catch {expr $GB(k)}] { .fu.k.e conf -bg red ; return }
if [catch {expr $GB(c)}] { .fu.c.e conf -bg red ; return }
if $GB(m)<=1.0e-6 { .fu.m.e conf -bg red ; return }
if $GB(k)<=1.0e-6 { .fu.k.e conf -bg red ; return }
if $GB(c)>$GB(ckr) {
.fu.c.e conf -bg red ; tk_messageBox -message "The Damping should be smaller than the critical damping!" ; return }
.fu.m.e conf -bg white
.fu.k.e conf -bg white
.fu.c.e conf -bg white
#start
if $GB(start)==1 { view_init ; return }
set GB(start) 1
.fu.ok.button conf -text "Stop" -foreground red
.fu.m.e conf -state disabled
.fu.k.e conf -state disabled
.fu.c.e conf -state disabled
set GB(w) [winfo width .f.c]
set GB(h) [winfo height .f.c]
set GB(r) [expr $GB(h)*0.03]
set GB(x0) [expr $GB(h)*0.8]
set GB(y0) [expr $GB(h)*0.5]
set GB(x1) [expr $GB(h)*0.4]
set GB(y1) [expr $GB(h)*0.2]
# rechnen
global ux
set GB(omg) [expr sqrt($GB(k)/$GB(m))]
set GB(frq) [expr $GB(omg)/2.0/3.14159265]
set GB(prd) [expr 1.0/$GB(frq)]
set GB(ckr) [expr 2.0*$GB(m)*$GB(omg)]
set dauer [expr $GB(prd)*$GB(np)]
set dt [expr int($dauer/$GB(nt)*1000)]
set t 0.0
for {set i 1} {$i<=$GB(nt)} {incr i} {
set kxi [expr $i*1.0/$GB(nt)]
set t [expr $dauer*$kxi]
set u [expr exp( -$GB(c)/(2.0*$GB(m))*$t) *cos( ($GB(omg)*sqrt(1.0-($GB(c)/(2*$GB(m)*$GB(omg)))*($GB(c)/(2*$GB(m)*$GB(omg))) ))*$t ) ]
set ux($i) [expr $GB(x1)+$u*$GB(r)*10.0]
set kx($i) [dx $kxi]
set ky($i) [dy $u]
set mx1($i) [expr $ux($i)-$GB(r)]
set mx2($i) [expr $ux($i)+$GB(r)]
}
while $GB(start)==1 {
view_range
view_masse
view_koord
view_titel
for {set i 1} {$i<=$GB(nt)} {incr i} {
if $GB(start)==0 { view_init ; return }
.f.c delete [.f.c find withtag tobedeleted]
.f.c create text [expr 20] [expr $GB(h)-20] -text "[expr int(100*$i/$GB(nt))]\%" -tag tobedeleted -anchor sw
foreach {x1 y1 x2 y2} [.f.c coords $GB(id_masse)] break
.f.c coords $GB(id_kurve) [concat [.f.c coords $GB(id_kurve)] $kx($i) $ky($i)]
.f.c coords $GB(id_masse) [lreplace [.f.c coords $GB(id_masse)] 0 3 $mx1($i) $y1 $mx2($i) $y2]
.f.c coords $GB(id_stab) [lreplace [.f.c coords $GB(id_stab)] 0 0 $ux($i)]
update
after $dt
}
}
}
proc view_range {} {
global GB
.f.c delete all
.f.c create rect 0 0 [expr $GB(w)-1] [expr $GB(h)-1] -fill "" -width 0
}
####################################
global GB(id_masse) GB(id_stab)
proc view_masse { } {
global GB
set r $GB(r)
set h [expr $GB(h)*0.6]
set x $GB(x1)
set y $GB(y1)
set GB(id_masse) [.f.c create oval [expr $x-$r] [expr $y-$r] [expr $x+$r] [expr $y+$r] -fill black ]
set x1 $x
set y1 [expr $y+$h/2.0]
set x2 $x
set y2 [expr $y+$h]
set GB(id_stab) [.f.c create line $x $y $x1 $y1 $x2 $y2 -fill black -width 2 -smooth 1]
#Lager
set x1 [expr $x2-$h/10.0]
set y1 [expr $y2]
set x2 [expr $x2+$h/10.0]
set y2 [expr $y2]
.f.c create line $x1 $y1 $x2 $y2 -fill black -width 2
}
####################################
proc dx {x} { return [expr $::GB(x0)+$x*$::GB(h)*0.8] }
proc dy {y} { return [expr $::GB(y0)-$y*$::GB(h)*0.3]}
proc view_koord {} {
global GB
set x0 [expr $GB(x0)]
set y0 [expr $GB(y0)]
set h [expr $GB(h)*0.4]
#X-achse
set x1 [expr $x0]
set y1 [expr $y0]
set x2 [expr $x0+$h*2]
set y2 [expr $y0]
.f.c create line [dx 0] [dy 0] [dx 1] [dy 0] -fill black -width 1 -arrow last -arrowshape {10 15 5}
#Y-achse
set x1 [expr $x0]
set y1 [expr $y0+$h]
set x2 [expr $x0]
set y2 [expr $y0-$h]
.f.c create line $x1 $y1 $x2 $y2 -fill black -width 1 -arrow last -arrowshape {10 15 5}
set GB(id_kurve) [.f.c create line [dx 0] [dy 1] [dx 0] [dy 1] -width 2 -fill blue]
}
####################################
proc view_titel {} {
global GB
.f.c create text 10 20 -text "Angular frequency \t= [format %.5f $GB(omg)]" -anchor nw
.f.c create text 10 40 -text "Eigenfrequency \t= [format %.5f $GB(frq)]" -anchor nw
.f.c create text 10 60 -text "Period \t= [format %.5f $GB(prd)]" -anchor nw
.f.c create text 10 80 -text "crit. Dampfung\t= [format %.5f $GB(ckr)]" -anchor nw
}
#start
view_init
LZ Have Fun!