#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

			# *** Updateable External Values ***
global ln_AcFreq	# Accumulation frequency
global ln_Amount	# Amount
global ln_ExMoAmt	# Extra monthly payment amount
global ln_ExYrAmt	# Extra yearly amount
global ln_Interest	# Interest rate (percentage)
global ln_StAcDate	# Accumulation start date
global ln_StDate	# Loan start date
global ln_StExMoDate	# Extra monthly payment start date
global ln_StExYrDate	# Extra yearly payment start date
global ln_Term		# Term

			# *** Read-Only External Values ***
global Month		# Current month
global PCumIntrst	# Current cumulative interest
global PCumPrncpl	# Current cumulative principal
global PIntrst		# Current interest
global PPaymnt		# Current payment
global PPrncpl		# Current principal
global Year		# Current year

			# *** Updateable Internal Values ***
global AcMonth		# Start accumulation month
global AcYear		# Start accumulation year
global ExMoOn		# Is extra monthly amount active?
global ExMoMnth		# Start extra monthly amount month
global ExMoYear		# Start extra monthly amount year
global ExYrOn		# Is extra yearly amount active?
global ExYrMnth		# Start extra yearly amount month
global ExYrYear		# Start extra yearly amount year
global IsReset		# Time to recompute payment
global Rate		# Rate
global NExPay		# # extra payments
global ExPay		# Extra payments

proc useextrapay {} {
	return {
ln_extrapay -- register an extra loan payment
   Usage: ln_extrapay <month/4-digit year> <amount>
	}
}

proc usenextpay {} {
	return {
ln_nextpay -- compute next loan payment
   Usage: ln_nextpay
	}
}

proc useprinthead {} {
	return {
ln_printhead -- print payment heading
   Usage: ln_printhead
	}
}

proc useprintpay {} {
	return {
ln_printpay -- print payment
   Usage: ln_printpay
	}
}

proc usereset {} {
	return {
ln_reset -- reset loan variables
   Usage: ln_reset
	}
}

proc ln_extrapay {moyr amnt} {
	global NExPay ExPay

	if {![regexp {[0-9][0-9]/[0-9][0-9][0-9][0-9]} $moyr]} {
		puts "$moyr needs to be in mm/yyyy format including leading \
			zero"
		return 0
	}
	set NExPay [expr $NExPay + 1]
	set ExPay($moyr) $amnt
	return 1
}

proc ln_help {} {
	puts ""
	puts "List of commands:"
	puts ""
	puts [useextrapay]
	puts [usenextpay]
	puts [useprinthead]
	puts [useprintpay]
	puts [usereset]
	puts ""
	puts {List of variables:}
	puts ""
	puts {ln_AcFreq [int] -- Accumulation frequency}
	puts {ln_Amount [double] -- Loan amount}
	puts {ln_ExMoAmt [double] -- Extra monthly payment amount}
	puts {ln_ExYrAmt [double] -- Extra yearly payment amount}
	puts {ln_Interest [double] -- Loan interest rate (percentage)}
	puts {ln_StAcDate [string] -- Accumulation start date (mm/yyyy)}
	puts {ln_StDate [string] -- Loan start date (mm/yyyy)}
	puts {ln_StExMoDate [string] -- Extra monthly payment start}
	puts {   date (mm/yyyy)}
	puts {ln_StExYrDate [string] -- Extra yearly payment start}
	puts {   date (mm/yyyy)}
	puts {ln_Term [int] -- Loan term (years)}
}

proc ln_nextpay {} {
	global ln_AcFreq ln_Amount ln_ExMoAmt ln_ExYrAmt ln_Interest \
		ln_StAcDate ln_StDate ln_StExMoDate ln_StExYrDate ln_Term
	global Month PCumIntrst PCumPrncpl PIntrst PPaymnt PPrncpl \
		 Year
	global AcMonth AcYear ExMoOn ExMoMnth ExMoYear ExYrOn ExYrMnth \
		ExYrYear IsReset Rate NExPay ExPay

	# Allow less than payment to come through, but trap here so we won't
	# get a zero return which doesn't allow the last payment to be
	# printed ... rather tahn trapping at the end of routine.

	if {$ln_Amount <= 0.0} {
		return 0
	}

	# Compute internal state variables if the loan has been reset.
	# Also determine if any extra payment applies (monthly and/or
	# yearly).

	if {$IsReset} {
		set IsReset 0
		set Rate [expr $ln_Interest/1200.0]
		set PPaymnt [expr $ln_Amount/((1.0-(pow(1.0+$Rate, \
			double(-$ln_Term*12))))/$Rate)]

		regexp {[0-9][0-9][0-9][0-9]$} $ln_StDate Year
		regexp {^[0-9][0-9]} $ln_StDate Month

		regexp {[0-9][0-9][0-9][0-9]$} $ln_StAcDate AcYear
		regexp {^[0-9][0-9]} $ln_StAcDate AcMonth

		regexp {[0-9][0-9][0-9][0-9]$} $ln_StExMoDate ExMoYear
		regexp {^[0-9][0-9]} $ln_StExMoDate ExMoMnth

		regexp {[0-9][0-9][0-9][0-9]$} $ln_StExYrDate ExYrYear
		regexp {^[0-9][0-9]} $ln_StExYrDate ExYrMnth
	}

	# Process accumulation frequency and date. Use default
	# values if not set.

	if {$ln_AcFreq <= 0} {
		set nfreq 1
	} else {
		set nfreq $ln_AcFreq
	}

	set dfreq [format "%02d/%04d" $Month $Year]
	if {[string compare $ln_StAcDate $dfreq] > 0} {
		set nfreq 1
	}

	set PIntrst 0.0
	set PPrncpl 0.0
	for {set ntimes 0} {($ln_Amount > 0.0) && ($ntimes < $nfreq)}	\
		{incr ntimes} {

		# Apply extra payment (monthly and/or yearly and/or ad hoc)
		# if necessary

		set exmonth 0.0
		if {$ExMoOn || (($Year == $ExMoYear)
			&& ($Month == $ExMoMnth))} {
			set exmonth $ln_ExMoAmt
			set ExMoOn 1
		}

		set exyear 0.0
		if {($ExYrOn || ($Year == $ExYrYear)) && ($Month == $ExYrMnth)} {
			set exyear $ln_ExYrAmt
			set ExYrOn 1
		}

		set exmoyr [format "%02d/%04d" $Month $Year]
		if {[info exists ExPay($exmoyr)]} {
			set expay $ExPay($exmoyr)
		} else {
			set expay 0.0
		}

		# Compute next line in amortization schedule

		if {$ln_Amount <= $PPaymnt} {
			set PPaymnt $ln_Amount
			set interest 0.0
		} else {
			set interest [expr $Rate*$ln_Amount]
			set PIntrst [expr $PIntrst+$interest]
		}
		set payment [expr $PPaymnt+$exmonth+$exyear+$expay-$interest]
		set PCumIntrst [expr $PCumIntrst+$interest]
		set PCumPrncpl [expr $PCumPrncpl+$payment]
		set ln_Amount [expr $ln_Amount-$payment]
		if {$ln_Amount < 0.0} {
			set ln_Amount 0.0
		}
		if {$ln_Amount >= 0} {
			set PPrncpl [expr $PPrncpl+$payment]
		}
		set Month [expr $Month + 1]
		if {$Month == 13} {
			set Month 1
		}
		if {$Month == 1} {
			set Year [expr ($Year+1)%10000]
		}
	}
	return 1
}

proc ln_printhead {} {
	return " MONTH    PAYMENT  INTEREST   PRINCIPAL   \
		CUM. INT.  CUM. PRI.  BALANCE"
}

proc ln_printpay {} {
	global ln_Amount Month PCumIntrst PCumPrncpl PIntrst PPaymnt \
		PPrncpl	Year

	return [format "%02d/%04d %9.2lf %9.2lf  %9.2lf  \
		%9.2lf  %9.2lf   %9.2lf" $Month $Year $PPaymnt \
		$PIntrst $PPrncpl $PCumIntrst $PCumPrncpl $ln_Amount]
}

proc ln_reset {} {
	global ln_AcFreq ln_Amount ln_ExMoAmt ln_ExYrAmt ln_Interest \
		ln_StAcDate ln_StDate ln_StExMoDate ln_StExYrDate ln_Term
	global Month PCumIntrst PCumPrncpl PIntrst PPaymnt PPrncpl \
		 Year
	global AcMonth AcYear ExMoOn ExMoMnth ExMoYear ExYrOn ExYrMnth \
		ExYrYear IsReset Rate NExPay ExPay

	set IsReset 1
	set ExMoOn 0
	set ExYrOn 0

	set ln_AcFreq 0
	set AcMonth 0
	set AcYear 0
	set Month 0
	set ln_Term 0
	set Year 0

	set ln_Amount 0.0
	set ln_Interest 0.0
	set Rate 0.0
	set ln_ExMoAmt 0.0
	set ln_ExYrAmt 0.0

	set ExMoMnth 0
	set ExMoYear 0
	set ExYrMnth 0
	set ExYrYear 0

	set PCumIntrst 0.0
	set PCumPrncpl 0.0
	set PIntrst 0.0
	set PPaymnt 0.0
	set PPrncpl 0.0

	set NExPay 0

	set ln_StAcDate ""
	set ln_StDate ""
	set ln_StExMoDate ""
	set ln_StExYrDate ""
	return 1
}

set tcl_precision 12
ln_reset
set command ""
while {[gets stdin line] >= 0} {
	set command "$command$line\n "
	if {[info complete $command]} {
		puts [eval $command]
		flush stdout
		set command ""
	}
}
exit 0
