---- ***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. In the process of designing the basic subroutine tasks, we could throw in some error checks. Such rule breaking helps keep the finished program more flexible. ---- ***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].'' !!!!!!