5 CLOSE
6 OPEN "I",1,"PARA.DAT"
7 INPUT #1, CLRSCRN
8 CLOSE #1
10 REM  CALC SUBPROGRAM
20 REM
30 REM  SET UP
40 REM
45 CL$=CHR$(CLRSCRN):RE$=CHR$(13):BS$=CHR$(8):BU$=CHR$(19)
50 EK$=CHR$(27):BL$=" ":NU$=""
55 SC=1:PR=2:F1=3:    REM device codes
60 MV=20:L3=0:DIM N$(MV),V(MV)
67 DIM I$(80),P$(80),S(80),S$(80) 
68 REM infix, postfix expressions, value, operand stacks
100 OU=SC:REM Default output to screen 
199 REM ******************************************
200 REM *** PRINT HEADER
220 REM
230 PRINT CL$
240 PRINT "--------------------------------------------------"
250 PRINT SPC(18);"Desk Calculator"
260 PRINT "--------------------------------------------------"
270 PRINT:PRINT "Enter formulas, variable assignments, or commands."
280 PRINT "Type HELP for a list of commands.":PRINT
299 REM ******************************************
300 REM *** PROMPT AND GET INFIX EXPRESSION
310 REM EXPORT: T$
330 REM 
334 IF ME$<>NU$ THEN PRINT ME$:REM Error message if any
335 IF OU=PR AND ME$<>NU$ THEN LPRINT ME$
336 ME$=NU$
337 PRINT:PRINT ": ";: REM prompt for input
338 IF OU=PR THEN LPRINT:LPRINT ": ";
340 LN=80:FC=32:LC=127:GOSUB 20000:REM GET LINE
350 IF EC$="ESC" THEN GOTO 810
360 IF T$=NU$ THEN GOTO 300: REM re-prompt
399 REM ****************************************
400 REM PARSE INFIX EXPRESSION INTO TOKENS
410 REM IMPORT: T$ 
420 REM EXPORT: I$(),I
430 REM
450 N$="NOTVAL":IN$="NOTID":REM value,identifier flags
455 I=0
460 FOR C=1 TO LEN(T$):REM For each char in expression
470    C$=MID$(T$,C,1)
475    IF C$=BL$ THEN GOTO 570
480    GOSUB 5000: REM GET CHARACTER TYPE (TP$)
485    IF TP$="Bad character" THEN ME$=TP$:GOTO 300
486    IF TP$<>"NUMERIC" AND N$="VAL" THEN N$="NOTVAL"
490    IF TP$="OPERATOR" AND IN$="ID" AND C$<>"=" THEN ID$=I$(I):GOSUB 1400:I$(I)=RIGHT$(STR$(NU),LEN(STR$(NU))-1):IF ME$<>NU$ THEN GOTO 300
491    IF TP$="OPERATOR" AND IN$="ID" THEN IN$="NOTID":GOTO 508
493    IF TP$="NUMERIC" AND N$="VAL" THEN GOTO 570
499    IF TP$="ALPHA" AND IN$="NOTID" THEN I=I+1:I$(I)=C$:IN$="ID":GOTO 570
502    IF TP$<>"OPERATOR" AND IN$="ID" THEN I$(I)=I$(I)+C$:GOTO 570
505    IF TP$="NUMERIC" AND N$="NOTVAL" THEN I=I+1:I$(I)=RIGHT$(STR$(VAL(RIGHT$(T$,LEN(T$)-C+1))),LEN(STR$(VAL(RIGHT$(T$,LEN(T$)-C+1))))-1):N$="VAL":GOTO 570
508 IF TP$="OPERATOR" THEN I=I+1:I$(I)=C$:GOTO 570
570 NEXT
580 IF IN$="ID" AND I>1 THEN ID$=I$(I):GOSUB 1400:I$(I)=RIGHT$(STR$(NU),LEN(STR$(NU))-1):IF ME$<>NU$ THEN GOTO 300
599 REM *******************************************
600 REM INTERPRET EXPRESSION
610 REM IMPORT: I$(I)
611 REM
612 IF I=0 THEN GOTO 300
613 LW$=I$(1):GOSUB 900:I1$=UP$
615 C$=LEFT$(I$(1),1):GOSUB 5000
617 IF TP$="NUMERIC" AND I$(2)="=" THEN ME$="Can't assign a value to a number":GOTO 300
620 IF I$(2)="=" AND I>=2 THEN GOSUB 1500:GOTO 300
621 IF I1$="HELP" THEN GOSUB 6000:GOTO 300 REM LIST COMMANDS
623 IF I1$="LIST" THEN GOSUB 1600:GOTO 300 REM LIST VARIABLE VALUES
625 IF I1$="CLEAR" THEN L3=0:FOR N=1 TO MV:N$(N)=NU$:NEXT:GOTO 300
630 IF I1$="PON" THEN OU=PR:GOTO 300:REM Output to printer
640 IF I1$="POFF" THEN OU=SC:GOTO 300
650 IF I1$="EXAMPLES1" THEN RESTORE:PRINT CL$:FOR X=1 TO 11:READ X$:PRINT X$:NEXT:GOTO 300
660 IF I1$="EXAMPLES2" THEN RESTORE:PRINT CL$:FOR X=1 TO 11:READ X$:NEXT:FOR X=12 TO 23:READ X$:PRINT X$:NEXT:GOTO 300
670 IF I=1 THEN ID$=I$(1):GOSUB 1400:IF ME$=NU$ THEN GOTO 690
671 IF ME$<>NU$ THEN GOTO 300
680 IB=1:GOSUB 1009: REM  Default: evaluate expression
690 PRINT BL$;NU:REM Display numeric answer
691 IF OU=PR THEN LPRINT BL$;NU
700 GOTO 300: REM end with ESC
810 PRINT CL$:FOR N=1 TO 11:PRINT:NEXT
820 PRINT SPC(13);"Reloading Desk Master...":RUN "DESK.BAS"
898 REM ****************************************** 
899 REM ******************************************
900 REM *** TRANSLATE UPPERCASE TO LOWERCASE ***
910 REM IMPORT: LW$ (lowercase string)
915 REM EXPORT: UP$ (UPPERCASE STRING)
920 UP$=NU$
930 FOR N=1 TO LEN(LW$)
940    C$=MID$(LW$,N,1)
950    IF C$>"Z" THEN C$=CHR$(ASC(C$)-32)
960    UP$=UP$+C$
970 NEXT
980 RETURN
999 REM ***************************************
1009 REM  *** CONVERT INFIX EXPRESSION TO POSTFIX ***
1030 REM IMPORT: I$(),I 
1035 REM EXPORT: P$(),P
1040 REM
1060 TP=0:P=0:REM Top of stack
1062 FOR C=IB TO I
1064    C$=I$(C)
1066    IF C$=")" THEN GOSUB 2000:GOTO 1090 
1068    PC=1:PS=1
1070    IF C$<>"/" AND C$<>"*" AND C$<>"-" AND C$<>"+" THEN GOTO 1084
1072    IF C$="*" OR C$="/" THEN PC=2
1074    IF TP=0 THEN PS=0: GOTO 1080
1076    IF S$(TP)="*" OR S$(TP)="/" THEN PS=2
1078    IF S$(TP)="(" THEN PS=0
1080    IF PC>PS THEN TP=TP+1:S$(TP)=C$:GOTO 1090
1082 IF PC<PS THEN P=P+1:P$(P)=S$(TP):TP=TP-1:GOTO 1068
1083 IF PC=PS THEN P=P+1:P$(P)=S$(TP):S$(TP)=C$:GOTO 1090
1084    IF C$="(" THEN TP=TP+1:S$(TP)=C$:GOTO 1090
1086    REM Identifier
1088    P=P+1:P$(P)=C$
1090 NEXT
1092 GOSUB 2000: REM EMPTY OPERATOR STACK
1099 REM ******************************************
1140 REM *** EXECUTE POSTFIXED EXPRESSION ***
1145 REM IMPORT: P$(),P
1146 REM EXPORT: NU
1150 TP=0:REM Stack top
1160 FOR C=1 TO P:REM For each post-fixed token
1170    C$=P$(C)
1175    REM Perform arithmetic operation
1180    IF C$="+" THEN TP=TP-1:S(TP)=S(TP)+S(TP+1):GOTO 1230
1190    IF C$="-" THEN TP=TP-1:S(TP)=S(TP)-S(TP+1):GOTO 1230
1200    IF C$="*" THEN TP=TP-1:S(TP)=S(TP)*S(TP+1):GOTO 1230
1210    IF C$="/" AND S(TP)=0 THEN ME$="You can't divide by zero!":GOTO 1260
1215    IF C$="/" THEN TP=TP-1:S(TP)=S(TP)/S(TP+1):GOTO 1230
1220    TP=TP+1:S(TP)=VAL(C$)
1230 NEXT
1250 NU=S(TP):REM The answer, at last!
1260 RETURN
1299 REM *****************************************
1300 REM *** PUT VALUE INTO VARIABLE TABLE ***
1310 REM IMPORT: NU,ID$
1315 REM EXPORT: ME$
1320 N=0
1330 N=N+1:REM For each variable in the table already
1340    IF N$(N)=ID$ THEN V(N)=NU:GOTO 1380
1350 IF N<L3 THEN GOTO 1330
1360 IF L3=MV THEN ME$="No more variables allowed. ":GOTO 1380
1370 L3=L3+1:N$(L3)=I$(1):V(L3)=NU:REM Add value to variable table
1380 RETURN
1399 REM *****************************************
1400 REM *** GET VALUE FROM VARIABLE TABLE ***
1410 REM IMPORT: ID$
1415 REM EXPORT: NU,ME$
1420 N=0
1430 N=N+1:REM For each value in the table
1435    IF N>L3 THEN ME$="Undefined variable":GOTO 1470
1440    IF N$(N)=ID$ THEN NU=V(N):GOTO 1470
1450 GOTO 1430
1460 ME$="Undefined variable"
1470 RETURN
1499 REM ******************************************
1500 REM *** ASSIGN A VALUE TO A VARIABLE ***
1510 REM IMPORT: I$(),I 
1515 REM EXPORT: IB,ME$
1520 C$=LEFT$(I$(3),1):GOSUB 5000 REM GET TYPE
1530 IF I=3 AND TP$="NUMERIC" THEN NU=VAL(I$(3))
1540 IF I=3 AND TP$="ALPHA" THEN ID$=I$(3):GOSUB 1400
1550 IF I>3 THEN IB=3:GOSUB 1009:REM POSTFIX AND EXECUTE
1555 IF ME$<>NU$ THEN GOTO 1599
1560 ID$=I$(1):GOSUB 1300 REM PUT VALUE IN TABLE
1570 RETURN
1599 REM ***************************************
1600 REM DISPLAY VARIABLES
1610 REM
1620 PRINT:PRINT
1625 IF L3<1 THEN PRINT "No variables set":GOTO 1680
1630 PRINT "::::::::::::: SET VARIABLES ::::::::::::":PRINT
1635 IF OU=PR THEN LPRINT "::::::::::::::: SET VARIABLES ::::::::::::::":LPRINT
1650 FOR N=1 TO L3
1660    PRINT N$(N);"=";V(N)
1665    IF OU=PR THEN LPRINT N$(N);"=";V(N) 
1670 NEXT
1680 RETURN
1699 REM *******************************************
2000 REM *** EMPTY OPERATOR STACK ***
2010 REM
2020 IF TP=0 THEN GOTO 2080
2030 FOR N=TP TO 1 STEP -1
2050    IF S$(TP)<>"(" THEN P=P+1:P$(P)=S$(TP)
2060    TP=TP-1
2070 NEXT
2080 RETURN
2099 REM *****************************************
2500 REM *** WAIT FOR RESPONSE ***
2510 PRINT:PRINT:PRINT
2520 PRINT SPC(13);"Hit any key to continue...";
2530 K$=INPUT$(1)
2540 RETURN
2550 REM *****************************************
2570 RETURN
2645 RESTORE
2679 REM ***************************************
5000 REM *** DETERMINE CHARACTER TYPE ***
5010 REM IMPORT: C$
5015 REM EXPORT: TP$
5025 TP$="Bad character"
5030 IF (C$>="A" AND C$<="Z") OR (C$>="a" AND C$<="z")THEN TP$="ALPHA"
5040 IF (C$>="0" AND C$<="9") OR C$="." THEN TP$="NUMERIC"
5050 IF C$=")" OR C$="(" OR C$="+" OR C$="-" OR C$="*"OR C$="/" OR C$="=" THEN TP$="OPERATOR"
5060 RETURN
5099 REM ****************************************
6000 REM *** LIST COMMANDS ***
6010 RESTORE:FOR N=1 TO 23:READ X$:NEXT
6020 FOR N=24 TO 33
6030    READ X$
6040    PRINT X$
6050    IF OU=PR THEN LPRINT X$
6060 NEXT
6065 PRINT
6070 PRINT "Like HELP, type command after colon.":PRINT
6080 RETURN
6099 REM ******************************************
7000 REM *** SOPHISTICATED ERROR ROUTINE ***
7010 ME$="Error in expression":GOTO 300
7020 REM So much for sophistication
7099 REM *****************************************
20000 REM *** GET LINE ***
20020 REM IMPORT: LN,FC,LC
20030 REM EXPORT: T$,EC$
20040 REM
20060 EC$=NU$:T$=NU$
20080 C=0: REM for each character input
20090 C=C+1: C$=INPUT$(1): REM get character 
20095   IF C$=BU$ THEN C$=BS$:PRINT C$;
20100   IF C$=EK$ THEN EC$="ESC":GOTO 20250
20150   IF C$=RE$ THEN PRINT:GOTO 20250
20160   IF (ASC(C$)<FC OR ASC(C$)>LC) AND C$<>BS$ THEN C=C-1:GOTO 20090
20170   IF C$=BS$ AND C=1 THEN PRINT;:GOTO 20060
20180   PRINT C$;:IF OU=PR THEN LPRINT C$; 
20190   IF C$=BS$ AND C<=2 THEN PRINT :PRINT ": ";:GOTO 20000
20200   IF C$=BS$ AND C>2 THEN C=C-2:T$=LEFT$(T$,C):GOTO 20090
20210 IF C=LN THEN T$=T$+C$:GOTO 20250 
20240 T$=T$+C$:GOTO 20090 REM add character and get another
20250 IF OU=PR THEN LPRINT
20251 RETURN
49999 REM ****************************************
50000 DATA "Simple calculations: "," "," "
50010 DATA ": 2+2","  4"," ",": 5*5","  25"," "
50020 DATA ": 2+(8/2)","  6"
50030 DATA "Assignments: "," "," " 
50040 DATA ": A=15"," ",": A","  15"," "
50050 DATA ": TOTAL=A+15"," ",": TOTAL","  30"
50060 DATA " "
50070 DATA "     List of commands"
50080 DATA " "
50090 DATA "PON.................TURNS PRINTER ON"
50100 DATA "POFF................TURNS PRINTER OFF"
50110 DATA "LIST................LIST VALUES OF VARIABLES"
50120 DATA "CLEAR...............ERASES ALL VARIABLES"
50130 DATA "HELP................LIST THESE COMMANDS"
50140 DATA "EXAMPLES1...........SIMPLE CALCULATIONS"
50150 DATA "EXAMPLES2...........VARIABLE ASSIGNMENTS"
50160 DATA " "
55555 END