proc main:
local mch%
global bd&,ed&
lock on

giprint "v1.5  ©Brian Stewart, 2001"
onerr restart

restart::
bd&=25567 :ed&=73413
do :dinit "Trurate Plus"
dtext "Present Value Rule","",$402
dtext "Single Repayment Loans","",$402
dtext "Period Rate Loans","",$402
dtext "Payment Planner","",$402
dtext "Quit Program","",$402
mch%=dialog :if mch%=2 :pvcalc:
elseif mch%=3 :srcalc:
elseif mch%=4 :prcalc:
elseif mch%=5 :plan:
endif :until mch%=6
endp

proc dt$:(f&)
local n,s&,yr%,mo%,dy%
local hr%,mn%,sc%,yd%,d$(10)
n=flt(f&-bd&)*86400.0
if n>&7fffffff :s&=n-4294967296.0
else s&=n :endif
secstodate s&,yr%,mo%,dy%,hr%,mn%,sc%,yd%
d$=pd$:(dy%)+pd$:(mo%)+gen$(yr%,4)
return d$ :endp

proc dl:(z) :local j&
j&=rd&+z*365/ppa+.5
return j&
endp

proc pd$:(d%) :local d$(3)
d$=gen$(d%,2) :if d%<10 :d$="0"+d$ :endif
d$=d$+"/" :return d$ :endp

proc prcalc:
local i,m,n,e,f%,o%
i=0 :m=12 :f%=3
do
if i>0 :n=m*i :e=100*((1+i/100)**m-1)
else :n=0 :e=0
endif
dinit "Period Rate Loan"
dfloat i,"Period rate (%)",0,1e10
dchoice f%,"Frequency","Days,Weeks,Months,Years,Others"
dtext "Effective Rate",fix$(e,5,12)+"%",1
dtext "Nominal Rate",fix$(n,5,12)+"%",1
dtext "APR",apr$:(e),$101
o%=dialog :if o%=0 :raise -1 :endif
if o%<>7 :m=freq:(f%,m) :endif
until o%=0
endp

proc apr$:(r) :local a
if r>=1e7
return sci$(r,5,12)
else a=intf((10*r)+.5+1e-9)/10
return fix$(a,1,12)
endif
endp

proc srcalc:
local l,p,t,r&,d&,m,n,i,e,a,f%,o%
m=1 :f%=4 :r&=bd& :d&=bd&
do :do :t=val(gen$(t,10))
dinit "Single Repayment Loan"
dfloat l," Loan (£)",0,1e10
dfloat p," Repayment (£)",0,1e10
dfloat t," Time",0,1e10
dchoice f%," Frequency","Days,Weeks,Months,Years,Others"
ddate r&,"•Relevant date",bd&,ed&
ddate d&,"•Repayment date",bd&,ed&
o%=dialog :if o%=0 :raise -1 :endif
m=freq:(f%,m)
if o%>5 :t=(d&-r&)*m/365 :endif
until t>0 and p-l>0
e=100*((p/l)**(m/t)-1)
i=100*((1+e/100)**(1/m)-1)
n=m*i :o%=1

dinit "Single Repayment Results"
dtext "Total Charge (TCC)","£"+fix$(p-l,2,12),1
dtext "Effective Rate",fix$(e,5,12)+"%",1
dtext "Nominal Rate",fix$(n,5,12)+"%",1
dtext "Period rate",fix$(i,5,12)+"%",1
dtext "APR",apr$:(e),$101
dchoice o%,"Another?","Yes,No"
dialog :until o%=2
endp

proc freq:(f%,cm) :local m,e%
if f%=1 :m=365
elseif f%=2 :m=52
elseif f%=3 :m=12
elseif f%=4 :m=1
elseif f%=5 :m=cm
do :dinit "Non-standard frequency"
dfloat m,"Periods in a year",0,1e9
e%=dialog :if e%=0 :raise -1 :endif
until m>0
endif
return m
endp

proc pvcalc:
global nlv&,nxt&,nsr&
global lva(50),lvl%(50)
global xta(100),xtt(100),xtf%(50)
global loan,depo,rd&,ppa
global spv,sdv,x,z,e%
global tap,tcc,prc,nar,ear,apr
local f%,o%
f%=3 :ppa=12
rd&=bd&
do :do :dinit "Present Value Rule"
dfloat loan," Loan (£)",0,1e10
dfloat depo," Deposit (£)",0,1e10
dchoice f%," Frequency","Days,Weeks,Months,Years,Others"
ddate rd&,"•Relevant date",bd&,ed&
e%=dialog :if e%=0 :raise -1 :endif
ppa=freq:(f%,ppa)
until loan>0
do :do :dinit "Repayment Pattern"
dlong nlv&,"No. of Levels",0,50
dlong nxt&,"No. of Extras",0,50
e%=dialog :if e%=0 :raise -1 :endif
until nlv&+nsr&+nxt&>0
tap=depo
if nlv&>0 :getlvs: :endif
if nxt&>0 :getxts: :endif
tcc=tap-loan
until tap>0 and tcc>0
busy "Working..."
x=1.0001
do :spv=depo-loan :sdv=0
if nlv&>0 :callvs: :endif
if nxt&>0 :calxts: :endif
z=(spv)/sdv :x=x-z
giprint "PV Error £"+fix$(spv,5,16)
until abs(z)<1e-9
prc=100*((1/x)-1) :nar=ppa*prc
ear=100*((1/x)**ppa-1)
o%=1 :dinit "Present Value Results"
dtext "Total Charge (TCC)","£"+fix$(tcc,2,12),1
dtext "Total Payable (TAP)","£"+fix$(tap,2,12),1
dtext "Effective Rate",fix$(ear,5,12)+"%",1
dtext "Nominal Rate",fix$(nar,5,12)+"%",1
dtext "Period rate",fix$(prc,5,12)+"%",1
dtext "APR",apr$:(ear),$301
dchoice o%,"Another?","Yes,No"
busy off
dialog :until o%=2
endp

proc getlvs: :local n%,a,t&
n%=1 :while n%<=nlv& :t&=lvl%(n%)
do :dinit "Level "+gen$(n%,2)
dfloat lva(n%),"Amount (£)",0,1e10
dlong t&,"Length",1,1e3
e%=dialog :if e%=0 :raise -1 :endif
until t&>0
lvl%(n%)=t& :tap=tap+lva(n%)*t&
n%=n%+1 :endwh
endp

proc getxts: :local n%,vt,t&,o%
n%=1 :while n%<=nxt&
if rd&=bd& :t&=xtt(n%)
else t&=rd&+xtt(n%)*365/ppa
endif
vt=val(gen$(xtt(n%),10))
dinit "Extra "+gen$(n%,3)
dfloat xta(n%)," Amount (£)",0,1e10
dfloat vt," Time",0,1e10
if rd&>bd&
ddate t&,"•Date",bd&,ed&
endif
o%=dialog :if o%=0 :raise -1 :endif
if o%=4 :xtt(n%)=(t&-rd&)*ppa/365
else xtt(n%)=vt :endif
tap=tap+xta(n%)
n%=n%+1 :endwh
endp

proc callvs: :local n%,a,b%,e%
n%=1 :while n%<=nlv&
a=lva(n%) :e%=b%+lvl%(n%)
spv=spv+a*(x**(e%+1)-x**(b%+1))/(x-1)
sdv=sdv+a*(e%*x**(e%+1)-b%*x**(b%+1)-(e%+1)*x**e%+(b%+1)*x**b%)/(x-1)**2
b%=e% :n%=n%+1 :endwh
endp

proc calxts: :local n%
n%=1 :while n%<=nxt&
smpay:(xta(n%),xtt(n%))
n%=n%+1 :endwh
endp

proc smpay:(a,t)
spv=spv+a*x**t :sdv=sdv+t*a*x**(t-1)
endp

proc plan:
local p,l,a,n,i,x,o%,v%
local t$(16),c$(16) :v%=0
do
redo::
dinit "Payment Planner"
dfloat l," Start Balance (£)",-1e10,1e10
dfloat p," Final Balance (£)",-1e10,1e10
dfloat a," Payment (£)",-1e10,1e10
dfloat n," Number",-1e10,1e10
dfloat i,"•Rate (%)",-1e10,1e10
if v%=0 :dtext "","Results Invalid",$102
elseif v%=1 :dtext "Charge £"+c$,"Paid £"+t$
endif

v%=0 :o%=dialog
if o%=0 :raise -1 :endif
if o%=6 :i=fin:(arate:,5)
goto redo :endif

onerr badval
x=1/(1+i/100)
if n=0 and o%<>5 :raise -2 :endif
if o%=2 :if i<>0
l=fin:(p*x**n+a*(x**(n+1)-x)/(x-1),2)
else l=fin:(p+n*a,2) :endif
elseif o%=3 :if i<>0
p=fin:((l-a*(x**(n+1)-x)/(x-1))/x**n,2)
else p=fin:(l-n*a,2) :endif
elseif o%=4 :if i<>0
a=fin:((l-p*x**n)*(x-1)/(x**(n+1)-x),2)
else a=fin:((l-p)/n,2) :endif
elseif o%=5 :if i<>0
n=fin:(log((l*(x-1)+a*x)/(p*(x-1)+a*x))/log(x),3)
if n<=0 :raise -2 :endif
else n=fin:((l-p)/a,3) :endif
endif

onerr off
giprint "Updated..."
c$=fix$(a*n+p-l,2,16)
t$=fix$(a*n+p,2,16) :v%=1
until o%=0
return

badval::
onerr off
if err=-2 or err=-8
giprint "Values are not valid"
n=0 :a=0
else raise err
endif
goto redo
endp

proc fin:(a,z%) :local z$(16)
z$=fix$(a,z%,16) :return val(z$)
endp

proc arate:
local i,f%,m,e% :f%=3
dinit "Convert Rate"
dfloat i,"Annual rate (%)",-1e10,1e10
dchoice f%,"Frequency","Days,Weeks,Months,Years,Others"
e%=dialog :if e%=0 :raise -1 :endif
m=freq:(f%,m) :i=100*((1+i/100)**(1/m)-1)
return i :endp