Tcl/Tk Calculator

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