0 'FINCAL.BA 11/02/87
1 'Copyright 1987, Mike Aiello
2 'Financial Calculation Program
9 '
10 '-----------declarations------------
11 '
15 DEFINT A-Z
20 DIM PL,II,KX,KP,KV,KN(8),KS(8),KA(8),EX,EV#,ED
25 DIM BK$,RV$,NR$,FN$,KY$(8),SS$,EV$
30 DIM IP#,IR#,NP,NY,PV#,PM#,FV#,CF
50 '
51 '-------------initialize------------
52 '
60 BK$="                                        ":RV$=CHR$(27)+"p":NR$=CHR$(27)+"q":PL=170:NY=1:CF=0
100 '
101 'program initialization
102 '
105 GOSUB 29000 'disp init scrn
110 CLS:GOSUB 9000 'disp stat scrn
150 '
151 'fn keys
152 '
155 SCREEN 0,0:CALL 23161:KEY OFF
170 DATA "NPer","I%Yr","PV  ","Paym","FV  ","    ","Clr ","Exit"
175 FOR II=1TO8:READ KY$(II):KX=II:GOSUB 9100:GOSUB 9300:NEXT II
195 KX=6:GOSUB 9200 'key 6 not used
200 '
201 '-------branch to control loop-----
202 '
205 GOTO 32000
210 '
215 '-----application subroutines------
220 '
249 'number of periods
250 KX=6:GOSUB 9500:GOSUB 9800:CF=-1:GOSUB 10100:NP=EV#:KX=6:GOSUB 9500:GOSUB 9700:EX=0:RETURN
260 KX=7:GOSUB 9500:GOSUB 9800:CF=-1:GOSUB 10100:NY=EV#:IR#=IP#/(CDBL(NY)*100):KX=7:GOSUB 9500:GOSUB 9700:EX=0:RETURN
299 'annual interest rate
300 CF=-1:GOSUB 10100:IP#=EV#:IR#=IP#/(CDBL(NY)*100):EX=0:RETURN
310 EX=0:RETURN
349 'present value
350 KX=6:GOSUB 9500:GOSUB 9800:CF=-1:GOSUB 10100:PV#=EV#:KX=6:GOSUB 9500:GOSUB 9700:EX=0:RETURN
360 IFIR#<>0THENCF=0:PV#=-FV#/((1+IR#)^NP)-PM#*((1-(1+IR#)^(-NP))/IR#)
370 EX=0:RETURN
399 'payment
400 KX=6:GOSUB 9500:GOSUB 9800:CF=-1:GOSUB 10100:PM#=EV#:KX=6:GOSUB 9500:GOSUB 9700:EX=0:RETURN
410 IFIR#<>0THENCF=0:PM#=(IR#/(1-(1+IR#)^(-NP)))*(-PV#-(FV#/(1+IR#)^NP))
420 EX=0:RETURN
449 'future value
450 KX=6:GOSUB 9500:GOSUB 9800:CF=-1:GOSUB 10100:FV#=EV#:KX=6:GOSUB 9500:GOSUB 9700:EX=0:RETURN
460 IFIR#<>0THENCF=0:FV#=-PV#*(1+IR#)^NP-PM#*(((1+IR#)^NP-1)/IR#)
470 EX=0:RETURN
997 '
999 '
1000 KX=1:GOSUB 9500:KV=0:GOSUB 9600
1020 ON KEY GOSUB 1940, 1940, 1940, 1940, 1940, 250, 260, 8000
1030 K6$=KY$(6):KY$(6)="Entr":K7$=KY$(7):KY$(7)="N/Yr":KX=6:GOSUB 9100:KX=7:GOSUB 9100:GOSUB 9700
1100 IF EX THEN GOTO 1100
1900 GOSUB 9000:KV=0:GOSUB 9600
1920 ON KEY GOSUB 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000
1930 KY$(6)=K6$:KY$(7)=K7$:KV=-1:GOSUB 9600:KX=1:GOSUB 9500:GOSUB 9700
1940 EX=-1:RETURN
2000 KX=2:GOSUB 9500:GOSUB 9800
2100 GOSUB 300
2900 GOSUB 9000:KX=2:GOSUB 9500:GOSUB 9700:EX=-1:RETURN
3000 KX=3:GOSUB 9500:KV=0:GOSUB 9600
3020 ON KEY GOSUB 3940, 3940, 3940, 3940, 3940, 350, 360, 8000
3030 K6$=KY$(6):KY$(6)="Entr":K7$=KY$(7):KY$(7)="Calc":KX=6:GOSUB 9100:KX=7:GOSUB 9100:GOSUB 9700
3100 IF EX THEN GOTO 3100
3900 GOSUB 9000:KV=0:GOSUB 9600
3920 ON KEY GOSUB 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000
3930 KY$(6)=K6$:KY$(7)=K7$:KV=-1:GOSUB 9600:KX=6:GOSUB 9200:KX=3:GOSUB 9500:GOSUB 9700
3940 EX=-1:RETURN
4000 KX=4:GOSUB 9500:KV=0:GOSUB 9600
4020 ON KEY GOSUB 4940, 4940, 4940, 4940, 4940, 400, 410, 8000
4030 K6$=KY$(6):KY$(6)="Entr":K7$=KY$(7):KY$(7)="Calc":KX=6:GOSUB 9100:KX=7:GOSUB 9100:GOSUB 9700
4100 IF EX THEN GOTO 4100
4900 GOSUB 9000:KV=0:GOSUB 9600
4920 ON KEY GOSUB 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000
4930 KY$(6)=K6$:KY$(7)=K7$:KV=-1:GOSUB 9600:KX=6:GOSUB 9200:KX=4:GOSUB 9500:GOSUB 9700
4940 EX=-1:RETURN
5000 KX=5:GOSUB 9500:KV=0:GOSUB 9600
5020 ON KEY GOSUB 5940, 5940, 5940, 5940, 5940, 450, 460, 8000
5030 K6$=KY$(6):KY$(6)="Entr":K7$=KY$(7):KY$(7)="Calc":KX=6:GOSUB 9100:KX=7:GOSUB 9100:GOSUB 9700
5100 IF EX THEN GOTO 5100
5900 GOSUB 9000:KV=0:GOSUB 9600
5920 ON KEY GOSUB 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000
5930 KY$(6)=K6$:KY$(7)=K7$:KV=-1:GOSUB 9600:KX=6:GOSUB 9200:KX=5:GOSUB 9500:GOSUB 9700
5940 EX=-1:RETURN
6000 EX=-1:RETURN
7000 KX=7:GOSUB 9500:GOSUB 9800
7100 NP=0:NY=1:IP#=0:IR#=0:PV#=0:PM#=0:FV#=0:CF=0
7900 GOSUB 9000:KX=7:GOSUB 9500:GOSUB 9700:EX=-1:RETURN
7997 '
7998 'normal exit -- unset loop flag
7999 '
8000 EX=0:RETURN
8996 '
8997 '---------utility subroutines-----
8998 '
8999 'display status screen
9000 PRINT@0,BK$;BK$;BK$;BK$;BK$;BK$;BK$;
9010 PRINT@42,""; :PRINT USING"Periods:                ### - ###/yr";NP;NY;
9020 PRINT@82,""; :PRINT USING"     I%:              ##.##";IP#;
9030 PRINT@122,"";:PRINT USING"     PV: ###,###,###,###.##";PV#;
9040 PRINT@162,"";:PRINT USING"Payment:     ###,###,###.##";PM#;
9050 PRINT@202,"";:PRINT USING"     FV: ###,###,###,###.##";FV#;
9060 IFCFTHENPRINT@255,RV$;"ReCalc Needed!";NR$;
9098 EX=-1:RETURN
9099 'set fn key avail
9100 KN(KX)=-1:RETURN
9199 'set fn key not available
9200 KN(KX)=0:KS(KX)=0:KA(KX)=0:KEY (KX) OFF:KP=280+(KX-1)*5:PRINT@KP,"    ";:RETURN
9299 'set available key on
9300 IF KN(KX) AND (NOT KA(KX)) THEN KS(KX)=-1:KA(KX)=0:KP=280+(KX-1)*5: PRINT@KP, KY$(KX);:KEY KX,"":KEY (KX) ON
9310 RETURN
9399 'set available key off
9400 IF KN(KX) AND KS(KX) AND (NOT KA(KX)) THEN KS(KX)=0:KP=280+(KX-1)*5: PRINT@KP, "####";:KEY (KX) OFF
9410 RETURN
9499 'toggle key active
9500 IF NOT KN(KX) THEN RETURN
9520 KP=280+(KX-1)*5
9530 IF NOT KA(KX) THEN KA(KX)=-1:PRINT@KP, RV$+KY$(KX)+NR$;:KEY (KX) OFF:RETURN ELSE KA(KX)=0:PRINT@KP,KY$(KX);:KEY (KX) ON:RETURN
9599 'set all keys availability
9600 FOR KX=1TO8
9620 IF KV THEN GOSUB 9100 ELSE IF NOT KA(KX) THEN GOSUB 9200
9630 NEXT KX:RETURN
9699 'set all keys on
9700 FOR KX=1TO8:GOSUB 9300:NEXT KX:RETURN
9799 'set all keys off
9800 FOR KX=1TO8:GOSUB 9400:NEXT KX:RETURN
10099 'get numeric input
10100 SS$=INKEY$:IFSS$<>""THEN 10100
10105 PRINT@40,BK$;BK$;BK$;BK$;BK$;:PRINT@PL,"Value ====> ";:EV$="":ED=0
10110 SS$=INKEY$:IF SS$="" THEN 10110
10120 IF SS$=CHR$(8) AND LEN(EV$)>0 THEN PRINT CHR$(127);:EV$=LEFT$(EV$,LEN(EV$)-1):GOTO 10110
10130 IF SS$=CHR$(13) THEN 10180
10140 IF (SS$>="0" AND SS$<="9") THEN EV$=EV$+SS$:PRINT SS$;:GOTO 10110
10150 IF LEN(EV$)=0 AND (SS$="-" OR SS$="+") THEN :EV$=EV$+SS$:PRINT SS$;:GOTO 10110
10160 IF SS$="." AND NOT ED THEN ED=-1:EV$=EV$+SS$:PRINT SS$;:GOTO 10110
10170 BEEP:GOTO 10110
10180 EV#=VAL(EV$):RETURN
28999 'initial program screen
29000 CLS:SCREEN 0,0
29010 PRINT@122,"* * FINCAL - Financial Calculator * *"
29020 PRINT@205," Copyright 1987 M. Aiello"
29030 FORII=1TO800:NEXT II:RETURN
31997 '
31998 '---------main menu loop---------
31999 '
32000 EX = -1
32100 ON KEY GOSUB 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000
32200 IF EX THEN 32200 'wait for fn key
32250 '
32251 'normal exit
32252 '
32255 CLS
32260 CALL 23164,0,23366 'reset fn keys
32265 CALL 27795 're-init BASIC fn keys
32270 KEY OFF
32275 CLOSE:MAXFILES=1
32300 MENU