Tcl HomeTcl Home hosted by
ActiveState

Google SiteSearch

Mortgage Payments Tclet

Mortgage Payments: Interest and Principal

This Web page shows a simple example that uses the Tcl web browser plugin. Enter information about a home loan in the three entries, then type Return in any of the entries or click on the Calculate button. The Tcl applet will compute the monthly payment for the specified loan and display it just below the entries. In addition, it will create a graph that shows how much of the loan principal has been repaid after each year of the loan. If you move the mouse over the bars in the graph, additional information about that year will be displayed under the graph.

Source:

The Tcl script for this application is about 270 lines long, including comments:

# mortgage.tcl --
#
# This file contains a script that displays a simple spreadsheet for
# calculating interest payments on a mortgage or other loan.  It is
# intended to be used in conjunction with the Tcl/Tk plugin for
# Netscape.
#
# SCCS: @(#) mortgage.tcl 1.2 96/06/05 17:43:53

eval destroy [winfo child .]

# The following variables provide configuration information that
# controls the display.

set axisFont {Helvetica 12 bold}
set titleFont {Helvetica 18 bold}
set barColor #7ab8cd
set accentColor #90daf3
set msgColor red
set graph(width) [winfo pixels . 5i]
set graph(height) [winfo pixels . 3i]
set graph(xOrigin) [winfo pixels . 0.8i]
set graph(yOrigin) [winfo pixels . 3.5i]

# monthly --
#
# Given a loan principal, a term in years, and an annual percentage
# rate, returns the monthly payment.
#
# Arguments:
# principal -		The amount borrowed.
# term -		The time over which the loan must be repaid, in used.
# rate -		The interest rate, in percent.

proc monthly {principal term rate} {
    set months [expr round($term*12)]
    set interest [expr $rate/1200.0]
    set principal [expr (double($principal))]
    if {$interest <= 0} {
	 set payment [expr $principal/$months]
    } else {
	set annuity [expr (1 - pow(1+$interest, -$months))/$interest]
	set payment [expr $principal/$annuity]
    }
    return $payment
}

# validate --
# This procedure is invoked to make sure that an entry contains a valid
# number.  If so, it returns 1.  If not, it sets the global variable
# "msg" with a diagnostic message, moves the input focus to the
# offending entry, and returns 0.
#
# Arguments:
# entry -		Name of the entry widget.
# info -		Description of the value stored in the entry, such
#			as "principal";  used in diagnostic messages.

proc validate {entry info} {
    global msg
    set value [$entry get]
    if {$value == ""} {
	set msg "Please enter a $info"
	focus $entry
	return 0
    }
    if {$value <= 0} {
	set msg "Please enter a positive $info"
	focus $entry
	return 0
    }
    if [catch {expr {2 * $value}}] {
	set msg "The $info isn't a proper number; please re-enter"
	$entry selection range 0 end
	focus $entry
	return 0
    }
    if {($info == "loan period") && ($value > 60)} {
	set msg "The $info is too long - use a $info of less than 60 years"
	$entry selection range 0 end
	focus $entry
	return 0
    }
    if {($info == "rate of interest") && ($value > 20)} {
	set msg "You can't afford an interest rate of $value%!"
	$entry selection range 0 end
	focus $entry
	return 0
    }

    return 1
}

# calculate --
#
# This procedure is invoked whatever Return is typed in any of the entry
# widgets.  It validates the contents of the entries, and recalculates
# the payment information.
#
# Arguments:
# None.

proc calculate {} {
    global principal term rate msg graph

    if {![validate .f1.e "principal amount"]
	    || ![validate .f2.e "loan period"]
	    || ![validate .f3.e "rate of interest"]} {
	return
    }
    set msg "Calculating "
    update idletasks
    set payment [monthly $principal $term $rate]
    .pay configure -text "Monthly payment is [format {$%.2f} $payment]."
    set msg ""
    plot .c $graph(xOrigin) $graph(yOrigin) $graph(width) $graph(height) $principal $term $rate $payment
}

# yaxis --
#
# This procedure picks an an appropriate scale factor for the y-axis of
# a plot, and draws the y axis, tick marks, and labels in a canvas.  It
# returns the vertical scale factor to use for the plot (what to
# multiply a y-value by to get a canvas coordinate).
#
# Arguments:
# c -			Canvas in which to draw.
# xOrigin, yOrigin -	Location of the origin for the plot.
# height -		Height of the y-axis, in pixels.
# yMax -		Maximum y-coordinate that will be displayed.
# format -		Format string to use when displaying tick labels
#			(such as %.2f).

proc yaxis {c xOrigin yOrigin height yMax format} {
    global axisFont

    set log [expr log10($yMax)]
    set unit [expr pow(10, floor($log))]
    set factor [expr $yMax/$unit]
    if {$factor <= 2.0} {
	set unit [expr $unit/5.0]
    } elseif {$factor < 5.0} {
	set unit [expr $unit/2.0]
    }
    set nUnits [expr floor(($yMax + $unit - 1)/$unit)]
    set scale [expr $height/($unit*$nUnits)]
    $c create line $xOrigin $yOrigin $xOrigin [expr $yOrigin-$height] \
	    -width 1 -fill black
    set x2 [expr $xOrigin + 5]
    for {set i 0} {$i <= $nUnits} {incr i} {
	set y [expr $i*$unit]
	set yCanv [expr $yOrigin - $y * $scale]
	$c create line $xOrigin $yCanv $x2 $yCanv -width 1 -fill black
	$c create text [expr $xOrigin-2] $yCanv -text [format $format $y] \
		-anchor e -font $axisFont -fill black
    }
    return $scale
}

# xaxis --
#
# This procedure is similar to yaxis above except that it handles the
# x-axis instead of a y-axis.
#
# Arguments:
# c -			Canvas in which to draw.
# xOrigin, yOrigin -	Location of the origin for the plot.
# width -		Width of the y-axis, in pixels.
# xMax -		Maximum x-coordinate that will be displayed.
# format -		Format string to use when displaying tick labels
#			(such as %.2f).

proc xaxis {c xOrigin yOrigin width xMax format} {
    global axisFont

    set log [expr log10($xMax)]
    set unit [expr pow(10, floor($log))]
    set factor [expr $xMax/$unit]
    if {$factor <= 2.0} {
	set unit [expr $unit/5.0]
    } elseif {$factor < 5.0} {
	set unit [expr $unit/2.0]
    }
    set nUnits [expr floor(($xMax + $unit - 1)/$unit)]
    set scale [expr $width/($unit*$nUnits)]
    $c create line $xOrigin $yOrigin [expr $xOrigin+$width] $yOrigin \
	    -width 1 -fill black
    set y2 [expr $yOrigin - 5]
    for {set i 0} {$i <= $nUnits} {incr i} {
	set x [expr $i*$unit]
	set xCanv [expr $xOrigin + $x * $scale]
	$c create line $xCanv $yOrigin $xCanv $y2 -width 1 -fill black
	$c create text $xCanv [expr $yOrigin+2] -text [format $format $x] \
		-anchor n -font $axisFont -fill black
    }
    return $scale
}

# plot --
#
# Given information about a loan and a canvas to draw in, create a bar
# chart in the canvas of principal paid, as a function of time, with
# active bars that provide additional information when the mouse passes
# over them.
#
# Arguments:
# c -			Canvas in which to draw.
# xOrigin, yOrigin -	Location of the origin for the plot.
# width, height -	Dimensions of the plot, in pixels.
# principal -		Initial loan amount.
# term -		Duration of loan, in years.
# rate -		Interest rate for the loan, in percent.
# payment -		Monthly payment.

proc plot {c xOrigin yOrigin width height principal term rate payment} {
    global barColor accentColor titleFont axisFont

    $c delete all
    set xScale [xaxis $c $xOrigin $yOrigin $width $term %.0f]
    set yScale [yaxis $c $xOrigin $yOrigin $height $principal %.0f]
    set x [expr $xOrigin + $width/2]
    $c create text $x [expr $yOrigin - $height - 5] \
	    -text {Principal Paid ($)} -font $titleFont -anchor s
    $c create text $x [expr $yOrigin + [winfo pixels $c 16p]] \
	    -text "Year Of Loan" -font $axisFont -anchor n

    set orig $principal
    set rate [expr $rate/1200.0]
    for {set year 1} {$year <= $term} {incr year} {
	for {set month 0} {$month < 12} {incr month} {
	    set principal [expr $principal + ($principal*$rate) - $payment]
	}
	if {$year == 1} {
	    set plural ""
	} else {
	    set plural "s"
	}
	set princPaid [expr $orig - $principal]
	set msg [format {After %d year%s you will have paid $%.0f\
		of principal and $%.0f of interest.} $year $plural $princPaid \
		[expr 12*$year*$payment - $princPaid]]
	set x2 [expr $xOrigin + $xScale*$year]
	set x1 [expr $x2 - $xScale]
	set y1 [expr $yOrigin - $yScale*$princPaid]
	if {$y1 > ($yOrigin-1)} {
	    set y1 [expr $yOrigin - 1]
	}
	set id [$c create rectangle $x1 $y1 $x2 $yOrigin -fill $barColor \
		-outline black -width 1 -tags bar]
	$c bind $id <Enter> [list set msg $msg]
    }
    $c bind bar <Enter> "$c itemconfigure current -fill $accentColor"
    $c bind bar <Leave> "$c itemconfigure current -fill $barColor"
    $c lower bar
}

# resize --
#
# This procedure is invoked when the canvas window used for plotting
# changes size.  It recalculates the geometry of the plot to take
# advantage of all the space available in the canvas.
#
# Arguments:
# c -			Name of the canvas widget that changed size.

proc resize c {
    global graph
    set graph(width) [expr [winfo width $c] - [winfo pixels $c 1i]]
    set graph(height) [expr [winfo height $c] - [winfo pixels $c 1i]]
    set graph(xOrigin) [winfo pixels $c .8i]
    set graph(yOrigin) [expr $graph(height) + [winfo pixels $c .5i]]
}

frame .f1
frame .f2
frame .f3
pack .f1 .f2 .f3 -side top -anchor w -fill x
label .f1.l -text "Enter principal amount ($):" -width 25 -anchor w
entry .f1.e -textvariable principal
bind .f1.e <Return> calculate
pack .f1.l .f1.e -side left
label .f2.l -text "Enter loan period (years):" -width 25 -anchor w
entry .f2.e -textvariable term
bind .f2.e <Return> calculate
pack .f2.l .f2.e -side left
button .f2.calculate -text Calculate -command calculate
pack .f2.calculate -side right -expand 1
label .f3.l -text "Enter interest rate (%):" -width 25 -anchor w
entry .f3.e -textvariable rate
bind .f3.e <Return> calculate
pack .f3.l .f3.e -side left
label .pay -anchor w
pack .pay -side top -fill x
canvas .c -width 10 -height 10 -relief sunken -bd 2
pack .c -side top -anchor w -fill both -expand yes
bind .c <Configure> {resize .c}
label .msg -textvariable msg -anchor w -fg $msgColor
pack .msg -side top -fill x