---- ***Slot_Calculator_Demo*** ---- This page is under development. Comments are welcome, but please load any comments at the bottom of the page. Thanks,[gold] ---- This page uses [Tcl]8/[Expect] 5.2 for [windows] to develop Slot_Calculator_Demo. (note: file is working in Expect5.2, but i did not put in statement "require Expect5.2" since lock with report error on some ports.) In developing a computer program or application, it is helpful to develop analogs for the individual tasks of the application. This program is finding inner diagonal of rectangular box, a subroutine was written for finding the square root of the sum of the squares for three sides, or successive numbers. ---- ***Program Listing*** ====== #!/usr/bin/env wish #start of deck #start of deck #start of deck #start of deck # finding inner diagonal of rectangular box # Slot_Calculator_Demo # 5Jan2009, [gold] set w .form catch {destroy $w} toplevel $w wm title $w "Slot Calculator Demo" wm iconname $w "form" set colorgrd seashell4 set colorback bisque set colorwarning tomato1 set reportcard "ready" set reportcard2 "zero entry detected !!! " set side1 3 set side2 50 set side3 5 proc testcasexxxx { w side1 side2 side3 answer } { # testcase is side of 5 units and 30 units # result or product is 150 units foreach i {f1 f2 f3 f4 f5} { $w.$i.entry delete 0 end } $w.f1.entry insert end $side1 $w.f2.entry insert end $side2 $w.f3.entry insert end $side3 $w.f4.entry insert end "" $w.f5.entry insert end "testcase, ans=$answer" } proc clearall { w } { global colorwarning global colorback foreach i {f1 f2 f3 f4 f5} { $w.$i.entry delete 0 end }} proc sumsquares { args } { set sum 0 foreach item $args { incr sum [ expr { $item * $item } ] } return [ expr { sqrt($sum) } ] } proc calculate { w side1 side2 side3 } { global colorwarning global colorback global answer2 $w.f4.entry delete 0 end $w.f5.entry delete 0 end set side1 [ $w.f1.entry get ] set side2 [ $w.f2.entry get ] set side3 [ $w.f3.entry get ] $w.f5.entry configure -background $colorback # set answer2 [ expr { $side1 * $side2 } ] set answer2 [ sumsquares $side1 $side2 $side3 ] $w.f4.entry insert end $answer2 if {$answer2 <= 0.0000001} { $w.f5.entry delete 0 end $w.f5.entry configure -background $colorwarning $w.f5.entry insert end "warning, negative or near zero detected in answer" } if {$side1 <= 0.0000001} { $w.f5.entry delete 0 end $w.f5.entry configure -background $colorwarning $w.f5.entry insert end "warning, negative or near zero detected in entry" } if {$side2 <= 0.0000001} { $w.f5.entry delete 0 end $w.f5.entry configure -background $colorwarning $w.f5.entry insert end "warning, negative or near zero detected in entry" } if {$answer2 <= 0.0000001} { $w.f5.entry configure -background $colorwarning $w.f5.entry insert end " !!! extra warning, negative or near zero detected in answer" } } proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \ #suchenwirth_subroutine;} proc colorpicker jill { set jill [lpick { seashell1 seashell2 seashell3}] return $jill; } label $w.msg -wraplength 4i -justify left -text "Slot Calculator Demo." pack $w.msg -side top #frame $w.buttons #pack $w.buttons -side bottom -fill x -pady 2m #button $w.buttons.dismiss -background $colorgrd -text exit -command "destroy $w" #button $w.buttons.clear -background $colorgrd -text "clear" -command { clearall $w } #button $w.buttons.testcase2 -background $colorgrd -text "testcase" -command { testcasexxxx $w 3 50 4 50} #button $w.buttons.calculate -text calculate -background $colorgrd -command {calculate $w $side1 $side2 $side3 } #pack $w.buttons.calculate $w.buttons.clear $w.buttons.dismiss $w.buttons.testcase2 -side left -expand 1 frame $w.buttons pack $w.buttons -side bottom -fill x -pady 2m foreach i {x1 x2 x3 x4 x5 x6} { frame $w.$i -bd 5 button $w.$i.button -background $colorgrd -width 15 -text exit -command "destroy $w" pack $w.$i.button -side left } pack $w.x1 $w.x2 $w.x3 $w.x4 $w.x5 $w.x6 -side bottom -fill x -expand 1 $w.x5.button config -text "testcase3" -command { testcasexxxx $w 1 3 5 5.92 } $w.x3.button config -text "clear" -command { clearall $w } $w.x6.button config -text calculate -background $colorgrd -command {calculate $w $side1 $side2 $side3} $w.x1.button config -text "testcase2" -command { testcasexxxx $w 1 2 3 3.74 } $w.x2.button config -text "testcase1" -command { testcasexxxx $w 1 1 1 1.73 } $w.x4.button config -text "exit" foreach i {f1 f2 f3 f4 f5} { frame $w.$i -bd 2 entry $w.$i.entry -relief sunken -width 20 -background $colorback label $w.$i.label -background [ colorpicker $colorback] pack $w.$i.entry -side right pack $w.$i.label -side left } $w.f1.label config -text side1: $w.f2.label config -text side2: $w.f3.label config -text side3: $w.f4.label config -text answer: $w.f5.label config -text report: pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 -side top -fill x console hide bind $w "destroy $w" focus $w.f1.entry #end of deck #end of deck #end of deck #end of deck #end of deck #end of deck ====== ---- ***Screenshots*** [WikiDbImage Slot_Calculator_Demo.PNG] [http://img504.imageshack.us/img504/2060/slotcalculatordemoxgy9.png] **Comments** Please place any comments here, Thanks. [gold] Change:Redundant procedure ? deleted. ---- **References** * http://en.wikipedia.org/wiki/calculators * Search on google.com for "counting rods" *Programming References ( TCL & C# )*** * [Base conversion] * Syntax [I love foreach] [use while to iterate over a list] * [additional list functions], [string reverse], * [split], [list] * [recursive list searching] http://wiki.tcl.tk/20813 ---- **Appendices** ***Tables*** ***Auxiliary Programs*** ---- ====== Auxilary Program ***early Program Listing*** ----- #!/usr/bin/env wish #start of deck #start of deck #start of deck #start of deck # Slot_Calculator_Demo # 5Jan2009, [gold] set w .form catch {destroy $w} toplevel $w wm title $w "Slot Calculator Demo" wm iconname $w "form" set colorgrd seashell4 set colorback bisque set colorwarning tomato1 set reportcard "ready" set reportcard2 "zero entry detected !!! " set side1 3 set side2 50 proc testcasexxxx { w side1 side2 answer } { # testcase is side of 5 units and 30 units # result or product is 150 units foreach i {f1 f2 f3 f4 f5} { $w.$i.entry delete 0 end } $w.f2.entry insert end $side1 $w.f3.entry insert end $side2 $w.f4.entry insert end "" $w.f5.entry insert end "testcase entered, ans=$answer" } proc clearall { w } { global colorwarning global colorback foreach i {f1 f2 f3 f4 f5} { $w.$i.entry delete 0 end }} proc calculate { w side1 side2 } { global colorwarning global colorback global answer2 $w.f4.entry delete 0 end $w.f5.entry delete 0 end set side1 [ $w.f2.entry get ] set side2 [ $w.f3.entry get ] $w.f5.entry configure -background $colorback set answer2 [ expr { $side1 * $side2 } ] $w.f4.entry insert end $answer2 if {$answer2 <= 0.0000001} { $w.f5.entry delete 0 end $w.f5.entry configure -background $colorwarning $w.f5.entry insert end "warning, negative or near zero detected in answer" } if {$side1 <= 0.0000001} { $w.f5.entry delete 0 end $w.f5.entry configure -background $colorwarning $w.f5.entry insert end "warning, negative or near zero detected in entry" } if {$side2 <= 0.0000001} { $w.f5.entry delete 0 end $w.f5.entry configure -background $colorwarning $w.f5.entry insert end "warning, negative or near zero detected in entry" } if {$answer2 <= 0.0000001} { $w.f5.entry configure -background $colorwarning $w.f5.entry insert end " !!! extra warning, negative or near zero detected in answer" } } proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \ #suchenwirth_subroutine;} proc colorpicker jill { set jill [lpick { seashell1 seashell2 seashell3}] return $jill; } label $w.msg -wraplength 4i -justify left -text "Slot Calculator Demo." pack $w.msg -side top #frame $w.buttons #pack $w.buttons -side bottom -fill x -pady 2m #button $w.buttons.dismiss -background $colorgrd -text exit -command "destroy $w" #button $w.buttons.clear -background $colorgrd -text "clear" -command { clearall $w } #button $w.buttons.testcase2 -background $colorgrd -text "testcase" -command { testcasexxxx $w 3 50 150} #button $w.buttons.calculate -text calculate -background $colorgrd -command {calculate $w $side1 $side2} #pack $w.buttons.calculate $w.buttons.clear $w.buttons.dismiss $w.buttons.testcase2 -side left -expand 1 frame $w.buttons pack $w.buttons -side bottom -fill x -pady 2m foreach i {x1 x2 x3 x4 x5 x6} { frame $w.$i -bd 5 button $w.$i.button -background $colorgrd -width 15 -text exit -command "destroy $w" pack $w.$i.button -side left } pack $w.x1 $w.x2 $w.x3 $w.x4 $w.x5 $w.x6 -side bottom -fill x -expand 1 $w.x5.button config -text "testcase3" -command { testcasexxxx $w 4 3 12} $w.x3.button config -text "clear" -command { clearall $w } $w.x6.button config -text calculate -background $colorgrd -command {calculate $w $side1 $side2} $w.x1.button config -text "testcase2" -command { testcasexxxx $w 3 50 150} $w.x2.button config -text "testcase1" -command { testcasexxxx $w 5 6 30} $w.x4.button config -text "exit" foreach i {f1 f2 f3 f4 f5} { frame $w.$i -bd 2 entry $w.$i.entry -relief sunken -width 20 -background $colorback label $w.$i.label -background [ colorpicker $colorback] pack $w.$i.entry -side right pack $w.$i.label -side left } $w.f1.label config -text factor1: $w.f2.label config -text side1: $w.f3.label config -text side2: $w.f4.label config -text answer: $w.f5.label config -text report: pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 -side top -fill x console hide bind $w "destroy $w" focus $w.f1.entry ---- *** Earlier Version*** #!/usr/bin/env wish ####finding area of rectangle from length of two sides #start of deck #start of deck #start of deck #start of deck # Slot_Calculator_Demo # 5Jan2009, [gold] set w .form catch {destroy $w} toplevel $w wm title $w "Slot Calculator Demo" wm iconname $w "form" set colorgrd seashell4 set colorback bisque set colorwarning tomato1 set reportcard "ready" set reportcard2 "zero entry detected !!! " set reportcard3 "stinker null entered !!! " set side1 3 set side2 50 proc testcasexxxx { w side1 side2 answer } { # testcase is side of 5 units and 30 units # result or product is 150 units foreach i {f1 f2 f3 f4 f5} { $w.$i.entry delete 0 end } $w.f2.entry insert end $side1 $w.f3.entry insert end $side2 $w.f4.entry insert end "" $w.f5.entry insert end "testcase entered, ans=$answer" } proc clearall { w } { global colorwarning global colorback foreach i {f1 f2 f3 f4 f5} { $w.$i.entry configure -background $colorback $w.$i.entry delete 0 end }} proc calculate { w side1 side2 } { global colorwarning global colorback global answer2 global reportcard3 $w.f4.entry delete 0 end $w.f5.entry delete 0 end set side1 [ $w.f2.entry get ] set side2 [ $w.f3.entry get ] if {[ $w.f2.entry get]==""} { $w.f2.entry configure -background $colorwarning } if {[ $w.f3.entry get]==""} { $w.f3.entry configure -background $colorwarning } if {[ $w.f2.entry get]==0} { $w.f2.entry configure -background $colorwarning } if {[ $w.f3.entry get]==0} { $w.f3.entry configure -background $colorwarning } set side1 [ $w.f2.entry get ] set side2 [ $w.f3.entry get ] if { $side1 == "" } { set side1 0 } if { $side2 == "" } { set side2 0 } $w.f5.entry configure -background $colorback set answer2 [ expr { $side1 * $side2 } ] $w.f4.entry insert end $answer2 if {$answer2 <= 0.0000001} { $w.f5.entry delete 0 end $w.f5.entry configure -background $colorwarning $w.f5.entry insert end "warning, negative or near zero detected in answer" } if {$side1 <= 0.0000001} { $w.f5.entry delete 0 end $w.f5.entry configure -background $colorwarning $w.f5.entry insert end "warning, negative or near zero detected in entry" } if {$side2 <= 0.0000001} { $w.f5.entry delete 0 end $w.f5.entry configure -background $colorwarning $w.f5.entry insert end "warning, negative or near zero detected in entry" } if {$answer2 <= 0.0000001} { $w.f5.entry configure -background $colorwarning $w.f5.entry insert end " !!! extra warning, negative or near zero detected in answer" } if {[ $w.f5.entry get]==""} { foreach i {f1 f2 f3 f4 f5} { $w.$i.entry configure -background $colorback } } } proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \ #suchenwirth_subroutine;} proc colorpicker jill { set jill [lpick { seashell1 seashell2 seashell3}] return $jill; } label $w.msg -wraplength 4i -justify left -text "Slot Calculator Demo." pack $w.msg -side top #frame $w.buttons #pack $w.buttons -side bottom -fill x -pady 2m #button $w.buttons.dismiss -background $colorgrd -text exit -command "destroy $w" #button $w.buttons.clear -background $colorgrd -text "clear" -command { clearall $w } #button $w.buttons.testcase2 -background $colorgrd -text "testcase" -command { testcasexxxx $w 3 50 150} #button $w.buttons.calculate -text calculate -background $colorgrd -command {calculate $w $side1 $side2} #pack $w.buttons.calculate $w.buttons.clear $w.buttons.dismiss $w.buttons.testcase2 -side left -expand 1 frame $w.buttons pack $w.buttons -side bottom -fill x -pady 2m foreach i {x1 x2 x3 x4 x5 x6 x7} { frame $w.$i -bd 5 button $w.$i.button -background $colorgrd -width 15 -text exit -command "destroy $w" pack $w.$i.button -side left } pack $w.x1 $w.x2 $w.x3 $w.x4 $w.x5 $w.x6 $w.x7 -side bottom -fill x -expand 1 $w.x5.button config -text "testcase3" -command { clearall $w; testcasexxxx $w 4 3 12} $w.x3.button config -text "clear" -command { clearall $w } $w.x7.button config -text calculate -background $colorgrd -command {calculate $w $side1 $side2} $w.x1.button config -text "testcase2" -command { clearall $w;testcasexxxx $w 3 50 150} $w.x2.button config -text "testcase1" -command { clearall $w; testcasexxxx $w 5 6 30} $w.x4.button config -text "exit" $w.x6.button config -text "testcase4" -command { clearall $w;testcasexxxx $w 4 "" 12; } foreach i {f1 f2 f3 f4 f5} { frame $w.$i -bd 2 entry $w.$i.entry -relief sunken -width 20 -background $colorback label $w.$i.label -background [ colorpicker $colorback] pack $w.$i.entry -side right pack $w.$i.label -side left } $w.f1.label config -text factor1: $w.f2.label config -text side1: $w.f3.label config -text side2: $w.f4.label config -text answer: $w.f5.label config -text report: pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 -side top -fill x console hide bind $w "destroy $w" focus $w.f1.entry #end of deck #end of deck #end of deck #end of deck #end of deck #end of deck #end of deck #end of deck ====== ---- !!!!!! %| [Category Toys] | [Category Calculator] |% ''There is no "[[Category Demos]]"; demos are covered by [Category Toys].'' !!!!!!