Posted to tcl by emiliano at Mon Jun 15 14:21:09 GMT 2009view pretty
package require Tcl 8.5 package require Tk namespace path {tcl::mathop tcl::mathfunc} array set p { dx 1.0 dt 0.5 k 1.0 rho 1.0 C 1.0 Q 1.0 nodos 21 q 9.0 } set bc newmann set conv Si proc reset {} { global p tvec norma conv set tvec [lrepeat $p(nodos) 10.0] lset tvec end 20.0 # no cambiar esto after cancel [after info] enablesteps redraw } proc step {} { global p bc tvec norma conv set new [list] for {set i 1} {$i <= [llength $tvec] - 2} {incr i} { lassign [lrange $tvec $i-1 $i+1 ] t-1 t t+1 lappend new [expr { $t + $p(dt)/($p(rho)*$p(C)) * ( ($p(k)/$p(dx)**2) * (${t-1}-2*$t+${t+1}) + $p(Q)) }] } set new [linsert $new 0 [lindex $tvec 0]] if {[string index $bc 0] eq "d"} { # dirichlet lappend new [lindex $tvec end] } else { # neumann lappend new [expr {[lindex $tvec end-1] - ($p(q) * $p(dx) / $p(k))}] } set max 0 foreach act $tvec fut $new { set dif [abs [- $fut $act]] set max [expr {$dif > $max ? $dif : $max}] } set norma [format %.3g $max] set tvec $new } proc converge? {args} { global p conv if {1 - 2 * ($p(dt) * $p(k)) / ($p(dx)**2 * $p(rho) * $p(C)) >= 0} { set conv "Si" .ac.conv configure -background white -foreground black } else { set conv "No" .ac.conv configure -background red2 -foreground yellow } } proc redraw {} { global tvec p set min [min {*}$tvec]; set max [max {*}$tvec] set w [winfo width .c]; set h [winfo height .c] lassign {20 40 70 20 5} oar oab oiz ode gap set ry [- $max $min] set cry [- $h $oar $oab] for {set i 0} {$i <= 10} {incr i} { set y [expr {$min + $ry / 10.0 * $i}] set cy [expr {($h - $oab) - $cry / $ry * ($y - $min)}] .c itemconfigure label&&$i -text [format %.2f $y] .c coords label&&$i [- $oiz $gap $gap] $cy .c coords grid&&$i [- $oiz $gap] $cy [- $w $ode -$gap] $cy } set mul1 [expr {double($w - $ode - $oiz) / ($p(nodos) - 1)}] set mul2 [expr {($h - $oab - $oar) / ($max - $min)}] set idx 0 foreach node $tvec { set x [expr {$oiz + $mul1 * $idx}] set y [expr {($h - $oab) - $mul2 * ($node - $min)}] lappend coords $x $y incr idx } .c coords plot $coords .c coords rect \ [- $oiz $gap] [- $oar $gap] [- $w $ode -$gap] [- $h $oab -$gap] } proc dostep { steps } { if {$steps == 0} { enablesteps return } step redraw after idle [list after 1 dostep [incr steps -1]] } proc enablesteps {} { .st.go configure -state normal } proc disablesteps {} { .st.go configure -state disabled } proc showvalue {x y} { global tvec set idx [.c index plot @$x,$y] lassign [lrange [.c coords plot] $idx $idx+1] cx cy .c coords idot [- $cx 3] [- $cy 3] [+ $cx 3] [+ $cy 3] .c coords itext $cx [- $cy 6] .c itemconfigure itext -text [format %.3f [lindex $tvec [/ $idx 2]]] } proc edit_reset {} { toplevel .edit pack [set t [text .edit.t]] $t insert end [info body reset] focus $t bind .edit <Double-Escape> [list update_reset $t] wm protocol .edit WM_DELETE_WINDOW [list update_reset $t] wm transient .edit . wm group .edit . grab set .edit } proc update_reset { t } { proc reset {} [$t get 1.0 end] grab release .edit destroy .edit reset } proc ttk::optionMenu {w var args} { upvar $var local set mbargs $w if {[info exists local]} { lappend mbargs -text $local } ttk::menubutton {*}$mbargs set m [menu $w.m -tearoff false] foreach item $args { $m add radiobutton \ -variable $var \ -value $item \ -label $item \ -command " set $var $item $w configure -text $item " } $w configure -menu $m return $w } ####################################################################### # GUI # option add *Spinbox.width 8 option add *Spinbox.from -100000.0 option add *Spinbox.to 100000.0 option add *Spinbox.increment 0.05 if {[tk windowingsystem] eq "x11"} { ttk::setTheme clam option add *Menu.background snow option add *Menu.activeBorderWidth 0 option add *Menu.activeForeground white option add *Menu.activeBackground #4a6984 } set po {-padx 3 -pady 3} wm title . "Simulador calor 1D" tk appname "Calor1D" ####################################################################### # el canvas (grafico) ttk::frame .bg; place .bg -x 0 -y 0 -relwidth 1.0 -relheight 1.0 canvas .c -bg white -width 600 .c create line {0 0 0 0} -tags plot -fill blue3 .c create text {0 0} -tags itext -anchor s .c create oval {0 0 0 0} -tags idot -fill red -outline green .c create rectangle {0 0 0 0} -width 2 -tags rect for {set i 0} {$i <= 10} {incr i} { .c create text {0 0} -anchor e -tags [list label $i] .c create line {0 0 0 0} -dash - -fill green3 -tags [list grid $i] } .c lower grid ttk::optionMenu .c.m bc dirichlet newmann .c.m configure -width 10 place .c.m -anchor se -relx 1.0 -rely 1.0 ####################################################################### # los parametros de la simulacion ttk::labelframe .params -text " Par\u00e1metros " foreach {w t} [list \ dx "Paso espacial\n\[m\]" \ dt "Paso temporal\n\[s\]" \ k "Conductividad\n\[W/(m.\u00b0K)\]" \ rho "Densidad\n\[kg/m\u00b3\]" \ C "Calor espec\u00edfico\n\[J/(kg.\u00b0K)\]" \ Q "Calor aportado\n\[J/m\]" \ q "Vector normal\n\[W/m\u00b2\]" ] { set l [ttk::label .params.l$w -text $t -anchor e -justify right] set s [spinbox .params.val$w -textvariable p($w)] grid $l $s -sticky news {*}$po } set l [ttk::label .params.lnodos -text Nodos\n -anchor e -justify right] set s [spinbox .params.nodos -command reset\ -textvariable p(nodos) -from 3 -to 1001 -increment 2] grid $l $s -sticky news {*}$po grid columnconfigure .params 0 -weight 1 ####################################################################### # la convergencia ttk::labelframe .ac -text " An\u00e1lisis de convergencia " foreach {var t} [list \ conv "Converge?" \ norma "Norma de\nconvergencia" \ ] { set l [ttk::label .ac.l$var -text $t -anchor e -justify right] set s [label .ac.$var -textvariable $var -width 8\ -anchor w -relief sunken -background white] grid $l $s -sticky ew {*}$po } grid columnconfigure .ac 0 -weight 1 ####################################################################### # el control de pasos de calculo ttk::labelframe .st -text " Pasos " ttk::label .st.lnstep -text "NÂș pasos" spinbox .st.nstep \ -textvariable numpasos -values {1 10 100 1000 10000} ttk::button .st.go -text "Comenzar" \ -command {disablesteps; dostep $numpasos} grid .st.lnstep .st.nstep -sticky news {*}$po grid .st.go - -sticky news {*}$po grid columnconfigure .st 0 -weight 1 ####################################################################### # el control del simulador ttk::labelframe .co -text " Control " ttk::button .co.reset -text "Reset" -command reset ttk::button .co.exit -text "Salir" -command exit pack .co.reset .co.exit -fill x {*}$po ####################################################################### # page layout grid .c .params -sticky news {*}$po grid ^ .ac -sticky news {*}$po grid ^ .st -sticky news {*}$po grid ^ .co -sticky new {*}$po grid columnconfigure . 0 -weight 1 grid rowconfigure . 3 -weight 1 ####################################################################### # bindings bind .c <Configure> redraw bind .c <Enter> { bind .c <Motion> [list showvalue \x25x \x25y] .c itemconfigure itext||idot -state normal } bind .c <Leave> { bind .c <Motion> {} .c itemconfigure itext||idot -state hidden } bind all <Control-E> {edit_reset} bind all <Control-e> {edit_reset} ####################################################################### # Listo. Empieza el simulador reset trace add variable p write converge?