Source code: # -------------------------------------------------------- # A Tcl/Tk Calculator. Written by Hattie Schroeder, 1997 # Copyright (c) 1997 Eolas Technologies Inc. # Freely modifiable/redistributable under the "Standard Tcl License" # See http://www.eolas.com/tcl/license.txt for details # -------------------------------------------------------- # --------------------------------------------------- # Entering a number # --------------------------------------------------- proc enter { n } { global clear number_list function if {[.e get] == 0} { .e delete 0 } elseif {[.e get] == "Error"} {clear} if {$clear == 1} { if {[.e get] != ""} { set number [.e get] scan $number %e number set number_list \ [lappend number_list $number] } .e configure -state normal .e delete 0 end .e insert end $n .e configure -state disabled } else { .e configure -state normal .e insert end $n .e configure -state disabled } if {$function != "none"} { set clear 0} } # ------------------------------------------------- # Entering a function # ------------------------------------------------- proc fun { fun } { global function clear equals set function $fun set clear 1 } # --------------------------------------------- # Entering a single function that requires # an immediate answer # ---------------------------------------------- proc single_fun { fun } { global sum clear function number_list if {[.e get] == ""} {return} else { scan [.e get] %e sum if {$fun == "square"} { set sum [expr $sum * $sum] } elseif {$fun == "sqrt"} { set sum [expr sqrt($sum)] } elseif {$fun == "invert"} { set sum [expr 1 / $sum] } .e configure -state normal .e delete 0 end .e insert end $sum set number_list {} set function none set sum 0 set next 0 .e configure -state disabled } } # ------------------------------------------------- # The "=" button # -------------------------------------------------- proc equals { } { global sum clear function number_list if {$function == "none"} { return } elseif {[.e get] == ""} { return } elseif {[lindex $number_list 0] == ""} { return } else { set sum [lindex $number_list 0] scan $sum %e sum set next [.e get] scan $next %e next if {$function == "add"} { set sum [expr $sum + $next] } if {$function == "minus"} { set sum [expr $sum - $next] } if {$function == "mult"} { set sum [expr $sum * $next] } if {$function == "div"} { if {$next != 0} { set sum [expr $sum / $next]} } if {$function == "square"} { set sum [expr $sum * $next] } .e configure -state normal .e delete 0 end if {$function == "div"} { if {$next == 0} { .e insert end "Error" set function none } else { .e insert 0 $sum } } else { .e insert 0 $sum } set number_list {} set function none set sum 0 set next 0 .e configure -state disabled } } # ----------------------------------------------- # The clear button # ----------------------------------------------- proc clear { } { global number_list function clear .e configure -state normal .e delete 0 end set number_list {} set clear 0 set function none .e configure -state disabled } # -------------------------------------------------- # The decimal button # -------------------------------------------------- proc decimal { } { global clear function number_list .e configure -state normal if {[.e get] == ""} { set num 0 set clear 0 } elseif {$clear == 1} { if {[.e get] != ""} { set number [.e get] scan $number %e number set number_list \ [lappend number_list $number] } set num 0 set clear 0 } else { set num [.e get] } scan $num %e num set num [string trimright $num 0] .e delete 0 end .e insert end $num .e configure -state disabled } # -------------------------------------------------- # The bindings for keyboard entry # -------------------------------------------------- bind . {enter 1} bind . {enter 2} bind . {enter 3} bind . {enter 4} bind . {enter 5} bind . {enter 6} bind . {enter 7} bind . {enter 8} bind . {enter 9} bind . {enter 0} bind . {clear} bind . {equals} bind . {equals} bind . {fun div} bind . {fun mult} bind . {fun minus} bind . {fun add} bind . {clear} bind . {clear} bind . {decimal} focus . # ----------------------------------------------- # Global variables # ------------------------------------------------- set clear 0 set function none set number_list {} # ----------------------------------------------------------------- # User interface # ----------------------------------------------------------------- entry .e -width 18 -background white -justify right -state disabled grid .e -row 0 -column 0 -columnspan 5 button .b1 -text 7 -command {enter 7} -foreground red -background lightgrey button .b2 -text 8 -command {enter 8} -foreground red -background lightgrey button .b3 -text 9 -command {enter 9} -foreground red -background lightgrey button .b4 -text / -command {fun div} -foreground purple -background lightgrey button .b5 -text Sq -command {single_fun square} -foreground purple -background lightgrey grid .b1 .b2 .b3 .b4 .b5 -columnspan 1 -sticky we button .b6 -text 4 -command {enter 4} -foreground red -background lightgrey button .b7 -text 5 -command {enter 5} -foreground red -background lightgrey button .b8 -text 6 -command {enter 6} -foreground red -background lightgrey button .b9 -text X -command {fun mult} -foreground purple -background lightgrey button .b10 -text Rt -command {single_fun sqrt} -foreground purple -background lightgrey grid .b6 .b7 .b8 .b9 .b10 -columnspan 1 -sticky we button .b11 -text 1 -command {enter 1} -foreground red -background lightgrey button .b12 -text 2 -command {enter 2} -foreground red -background lightgrey button .b13 -text 3 -command {enter 3} -foreground red -background lightgrey button .b14 -text - -command {fun minus} -foreground purple -background lightgrey button .b15 -text 1/x -command {single_fun invert} -foreground purple -background lightgrey grid .b11 .b12 .b13 .b14 .b15 -columnspan 1 -sticky we button .b16 -text C -command { clear } -foreground yellow -background lightgrey button .b17 -text 0 -command {enter 0} -foreground red -background lightgrey button .b18 -text . -command {decimal} -foreground blue -background lightgrey button .b19 -text + -command {fun add} -foreground purple -background lightgrey button .b20 -text = -command {equals} -foreground purple -background lightgrey grid .b16 .b17 .b18 .b19 .b20 -columnspan 1 -sticky we
Source code:
# -------------------------------------------------------- # A Tcl/Tk Calculator. Written by Hattie Schroeder, 1997 # Copyright (c) 1997 Eolas Technologies Inc. # Freely modifiable/redistributable under the "Standard Tcl License" # See http://www.eolas.com/tcl/license.txt for details # -------------------------------------------------------- # --------------------------------------------------- # Entering a number # --------------------------------------------------- proc enter { n } { global clear number_list function if {[.e get] == 0} { .e delete 0 } elseif {[.e get] == "Error"} {clear} if {$clear == 1} { if {[.e get] != ""} { set number [.e get] scan $number %e number set number_list \ [lappend number_list $number] } .e configure -state normal .e delete 0 end .e insert end $n .e configure -state disabled } else { .e configure -state normal .e insert end $n .e configure -state disabled } if {$function != "none"} { set clear 0} } # ------------------------------------------------- # Entering a function # ------------------------------------------------- proc fun { fun } { global function clear equals set function $fun set clear 1 } # --------------------------------------------- # Entering a single function that requires # an immediate answer # ---------------------------------------------- proc single_fun { fun } { global sum clear function number_list if {[.e get] == ""} {return} else { scan [.e get] %e sum if {$fun == "square"} { set sum [expr $sum * $sum] } elseif {$fun == "sqrt"} { set sum [expr sqrt($sum)] } elseif {$fun == "invert"} { set sum [expr 1 / $sum] } .e configure -state normal .e delete 0 end .e insert end $sum set number_list {} set function none set sum 0 set next 0 .e configure -state disabled } } # ------------------------------------------------- # The "=" button # -------------------------------------------------- proc equals { } { global sum clear function number_list if {$function == "none"} { return } elseif {[.e get] == ""} { return } elseif {[lindex $number_list 0] == ""} { return } else { set sum [lindex $number_list 0] scan $sum %e sum set next [.e get] scan $next %e next if {$function == "add"} { set sum [expr $sum + $next] } if {$function == "minus"} { set sum [expr $sum - $next] } if {$function == "mult"} { set sum [expr $sum * $next] } if {$function == "div"} { if {$next != 0} { set sum [expr $sum / $next]} } if {$function == "square"} { set sum [expr $sum * $next] } .e configure -state normal .e delete 0 end if {$function == "div"} { if {$next == 0} { .e insert end "Error" set function none } else { .e insert 0 $sum } } else { .e insert 0 $sum } set number_list {} set function none set sum 0 set next 0 .e configure -state disabled } } # ----------------------------------------------- # The clear button # ----------------------------------------------- proc clear { } { global number_list function clear .e configure -state normal .e delete 0 end set number_list {} set clear 0 set function none .e configure -state disabled } # -------------------------------------------------- # The decimal button # -------------------------------------------------- proc decimal { } { global clear function number_list .e configure -state normal if {[.e get] == ""} { set num 0 set clear 0 } elseif {$clear == 1} { if {[.e get] != ""} { set number [.e get] scan $number %e number set number_list \ [lappend number_list $number] } set num 0 set clear 0 } else { set num [.e get] } scan $num %e num set num [string trimright $num 0] .e delete 0 end .e insert end $num .e configure -state disabled } # -------------------------------------------------- # The bindings for keyboard entry # -------------------------------------------------- bind . {enter 1} bind . {enter 2} bind . {enter 3} bind . {enter 4} bind . {enter 5} bind . {enter 6} bind . {enter 7} bind . {enter 8} bind . {enter 9} bind . {enter 0} bind . {clear} bind . {equals} bind . {equals} bind . {fun div} bind . {fun mult} bind . {fun minus} bind . {fun add} bind . {clear} bind . {clear} bind . {decimal} focus . # ----------------------------------------------- # Global variables # ------------------------------------------------- set clear 0 set function none set number_list {} # ----------------------------------------------------------------- # User interface # ----------------------------------------------------------------- entry .e -width 18 -background white -justify right -state disabled grid .e -row 0 -column 0 -columnspan 5 button .b1 -text 7 -command {enter 7} -foreground red -background lightgrey button .b2 -text 8 -command {enter 8} -foreground red -background lightgrey button .b3 -text 9 -command {enter 9} -foreground red -background lightgrey button .b4 -text / -command {fun div} -foreground purple -background lightgrey button .b5 -text Sq -command {single_fun square} -foreground purple -background lightgrey grid .b1 .b2 .b3 .b4 .b5 -columnspan 1 -sticky we button .b6 -text 4 -command {enter 4} -foreground red -background lightgrey button .b7 -text 5 -command {enter 5} -foreground red -background lightgrey button .b8 -text 6 -command {enter 6} -foreground red -background lightgrey button .b9 -text X -command {fun mult} -foreground purple -background lightgrey button .b10 -text Rt -command {single_fun sqrt} -foreground purple -background lightgrey grid .b6 .b7 .b8 .b9 .b10 -columnspan 1 -sticky we button .b11 -text 1 -command {enter 1} -foreground red -background lightgrey button .b12 -text 2 -command {enter 2} -foreground red -background lightgrey button .b13 -text 3 -command {enter 3} -foreground red -background lightgrey button .b14 -text - -command {fun minus} -foreground purple -background lightgrey button .b15 -text 1/x -command {single_fun invert} -foreground purple -background lightgrey grid .b11 .b12 .b13 .b14 .b15 -columnspan 1 -sticky we button .b16 -text C -command { clear } -foreground yellow -background lightgrey button .b17 -text 0 -command {enter 0} -foreground red -background lightgrey button .b18 -text . -command {decimal} -foreground blue -background lightgrey button .b19 -text + -command {fun add} -foreground purple -background lightgrey button .b20 -text = -command {equals} -foreground purple -background lightgrey grid .b16 .b17 .b18 .b19 .b20 -columnspan 1 -sticky we