100 '=== RPN CALC (by Num Kadoma)
110 GOTO *INI
120 '--- KEY
130 "." IF D OR E OR ASC B$=H THEN *K
140 D=I:IF B$=""LET K$="0."
150 GOTO "#"
160 "`" IF B$=""THEN *EXP
170 IF E OR ASC B$=H THEN *K
180 K$=E$,E=LEN B$+I:GOTO "#"
190 "$" K$="":GOTO "H"
200 "h" K$=CHR$ (ASC K$ AND &DF)
210 "H" IF D OR ASC B$=45THEN *K
220 IF ASC B$-H LET K$=H$+B$+K$,B$=""
230 "#" IF B$ THEN 270
240 IF F GOSUB *PUSH:PRINT :GOTO 260
250 PRINT #I,L$;
260 PRINT #I,C$;P$;
270 PRINT K$;:B$=B$+K$,F=O:GOTO *UPX
280 "B" M=LEN B$-I:IF M<O PRINT #I,L$;:F=O:GOTO 340
290 V$=RIGHT$ (B$,I):IF V$="."LET D=O
300 IF V$=E$ LET E=O
310 B$=LEFT$ (B$,M):PRINT CHR$ 8;
320 IF RIGHT$ (B$,I)="-"THEN "B"
330 IF M>O THEN *UPX
340 PRINT #I,C$;P$;"0";CHR$ 29;:GOTO *UPX
350 ";" X=O,F=O:GOTO *C
360 "]" S=X:GOTO *F
370 "[" N=S:IF B$ LET F=I
380 GOTO *PUSHV
390 "3" N=PI #:GOTO *PUSHV
400 *EXP N=EXP 1#
410 *PUSHV IF F GOSUB *PUSH
420 GOTO *OP1
430 "N" IF B$=""THEN *NEG
440 IF ASC B$=H OR E=LEN B$ THEN *K
450 V$=LEFT$ (B$,E):LOCATE I,3
460 IF MID$ (B$,E+I,I)<>"-"LET B$=V$+"-"+MID$ (B$,E+I,LEN B$):PRINT #I,B$;:GOTO *UPX
470 B$=V$+MID$ (B$,E+2,LEN B$):PRINT #I,B$;" ";CHR$ 8;
480 *UPX C=-I:IF ASC B$=H LET X=VAL ("&"+MID$ (B$,2,LEN B$)):GOTO *K
490 X=VAL B$,C=O:GOTO *K
500 *OP
510 "+" N=Y+X:GOTO *OP2
520 "-" N=Y-X:GOTO *OP2
530 "*" N=Y*X:GOTO *OP2
540 "/" N=Y/X:GOTO *OP2
550 "\" N=INT (Y/X):GOTO *OP2
560 "M" N=Y-INT (Y/X)*X:GOTO *OP2
570 *NEG N=-X:GOTO *OP1
580 "&" GOSUB *HML:P=P AND U,Q=Q AND V,R=R AND W:GOSUB *HEX:GOTO *OP2
590 "|" GOSUB *HML:P=P OR  U,Q=Q OR  V,R=R OR  W:GOSUB *HEX:GOTO *OP2
600 "^" GOSUB *HML:P=P XOR U,Q=Q XOR V,R=R XOR W:GOSUB *HEX:GOTO *OP2
610 "~" N=NOT X:GOTO *OP1
620 "<" N=Y*2^INT X:GOTO *OP2
630 ">" N=INT (Y/2^INT X):GOTO *OP2
640 *FN
650 "S" N=SIN X:GOTO *OP1
660 "C" N=COS X:GOTO *OP1
670 "T" N=TAN X:GOTO *OP1
680 "s" N=ASN X:GOTO *OP1
690 "c" N=ACS X:GOTO *OP1
700 "t" N=ATN X:GOTO *OP1
710 "I" N=HSN X:GOTO *OP1
720 "O" N=HCS X:GOTO *OP1
730 "A" N=HTN X:GOTO *OP1
740 "i" N=AHS X:GOTO *OP1
750 "o" N=AHC X:GOTO *OP1
760 "a" N=AHT X:GOTO *OP1
770 "x" N=RCP X:GOTO *OP1
780 "L" N=LOG X:GOTO *OP1
790 "l" N=LN X:GOTO *OP1
800 "b" N=LOG X/LOG 2#:GOTO *OP1
810 "X" N=TEN X:GOTO *OP1
820 "e" N=EXP X:GOTO *OP1
830 "Q" N=SQU X:GOTO *OP1
840 "U" N=CUB X:GOTO *OP1
850 "q" N=SQR X:GOTO *OP1
860 "u" N=CUR X:GOTO *OP1
870 "!" N=FACT X:GOTO *OP1
880 "D" N=DEG X:GOTO *OP1
890 "d" N=DMS X:GOTO *OP1
900 "P" N=Y^X:GOTO *OP2
910 "R" N=Y ROT X:GOTO *OP2
920 "p" M=Z:X=POL (X,Y),Y=Z,Z=M:GOTO *F
930 "r" M=Z:X=REC (X,Y),Y=Z,Z=M:GOTO *F
940 "J" N=NPR (Y,X):GOTO *OP2
950 "j" N=NCR (Y,X):GOTO *OP2
960 ":" N=ABS X:GOTO *OP1
970 "n" N=INT X:GOTO *OP1
980 "%" N=Y*X/100:GOTO *OP1
990 "K" N=X*&400:GOTO *OP1
1000 "G" GOSUB *GCD:IF M>O LET N=L  :GOTO *OP2 ELSE *F
1010 "g" GOSUB *GCD:IF M>O LET N=M/L:GOTO *OP2 ELSE *F
1020 *GCD M=-1:IF X=O OR Y=O RETURN
1030 L=ABS X,Y=ABS Y,M=L*Y
1040 IF L<Y LET N=Y,Y=L,L=N
1050 IF Y=O RETURN
1060 N=Y,Y=L-INT (L/Y)*Y,L=N:GOTO 1050
1070 *STACK
1080 "," X=O,Y=O,Z=O,T=O,F=O:GOTO *C
1090 "'" GOSUB *PUSH:F=O:GOTO *C
1100 "=" GOTO *F
1110 "V" N=Y:GOTO *OP2
1120 "@" GOSUB *PUSH:N=L:GOTO *X
1130 "W" N=Y,Y=X:GOTO *X
1140 "(" N=T:GOSUB *PUSH:GOTO *X
1150 ")" N=Y:GOSUB *POP:T=X:GOTO *X
1160 *SYS
1170 "v" A=(A+I)*-(A<2):GOSUB *DRG:GOTO *K
1180 "m" B=I-B:GOTO *F
1190 "0" M=&BFCBF:POKE M,PEEK M XOR &10:M=PEEK M AND &10,G$="1C1C3E7F001408141C1C3E7F001C413E":GOSUB *ICON:GOTO *K
1200 "1" M=&BFCBF:POKE M,PEEK M XOR &80:M=PEEK M AND &80,G$="00602A2F2F2860000F61202F2B206F03":GOSUB *ICON:GOTO *K
1210 "F" GOSUB *OFF:GOTO *K
1220 "Z" IF J<=40THEN *Z
1230 GOSUB *SOFF:K$="INIT"+W$+"SCRN:W6"+C$:J$="*Z":GOTO *K0
1240 *Z CLS :GOSUB *NRM:GOSUB *SON:END
1250 "_"
1260 "" GOTO *K
1270 '--- SUB
1280 *PUSH T=Z,Z=Y,Y=X:RETURN
1290 *POP Y=Z,Z=T:RETURN
1300 *HML M=G*G,P=INT (Y/M),U=INT (X/M)
1310 M=INT (Y/G),Q=M-P*G,R=Y-M*G
1320 M=INT (X/G),V=M-U*G,W=X-M*G:RETURN
1330 *HEX N=P*G*G+Q*G+R:RETURN
1340 *DRG ON A GOTO 1360,1370
1350 GRAD   :RETURN
1360 DEGREE :RETURN
1370 RADIAN :RETURN
1380 *ICON GCURSOR (232,7):GPRINT MID$ (G$,I+&10*SGN M,&10):RETURN
1390 *SON  POKE 8192,63:RETURN
1400 *SOFF POKE 8192,62:RETURN
1410 *REV M=785569:POKE M,64OR PEEK M:RETURN
1420 *NRM M=785569:POKE M,-65AND PEEK M:RETURN
1430 *K0 KEY &,K$+"G."+J$+C$:END
1440 *OFF POKE &BFE00,&8,&,&41:CALL &FFFDC:RETURN
1450 '--- INIT
1460 *INI CLS :CLEAR :DEFDBL L-N,P-Z
1470 I=1,C$=CHR$ 13,W$=CHR$ 34,J$="*A"
1480 K=I,J=PEEK 785565:IF J<=40THEN *A
1490 *S GOSUB *SOFF:M=8192,K$="INIT"+W$+"SCRN:W4"+C$+"CLS:PO.M,63:":GOTO *K0
1500 *A GPRINT "7F577D557D577F":LOCATE 2:PRINT "RPN CALC (by Num Kadoma)"
1510 *T T$="2_______B___;'____@__________________M&_()*+_-./##########__<=>_jHHHHHHG___Kg___J_______$___\_^n_hhhhhhG___Kg___J_______$___|_~V
1520 *U U$="____FZ_________F______________v_____________,___________________________________________________01_______________________________SCT_mDlLxW`PqQN[]__IOA__________sct__deXp_3Ru%:__r!ioa_________________b_____U
1530 DIM D$(I):D$(O)=".",P$=":",H$="$"
1540 H=ASC H$,A=I+SGN SIN 360,G=32768
1550 E$="e",Q$=C$+CHR$ 10,R$=Q$+H$
1560 S$="          ",L$=C$+S$+S$+S$+S$
1570 O$=CHR$ O
1580 IF INKEY$ THEN 1580ELSE *R
1590 '--- RESUME (G.*)
1600 * IF P$<>":"GOTO *INI
1610 J=PEEK 785565:IF J>40LET J$="*R":GOTO *S
1620 *R OPEN "SCRN:"FOR OUTPUT AS I
1630 ON ERROR GOTO *ERR:GOTO *P
1640 '--- MAIN
1650 *OP2 GOSUB *POP
1660 *OP1 L=X
1670 *X X=N
1680 *F F=I
1690 *C D=O,E=O
1700 *P CLS :IF B THEN 1720
1710 PRINT #I,T;Q$;Z;Q$;Y;Q$;X;:GOTO 1730
1720 C=10:PRINT #I,H$;RIGHT$ (S$+HEX$ T,C);D$(I-T+INT T);R$;RIGHT$ (S$+HEX$ Z,C);D$(I-Z+INT Z);R$;RIGHT$ (S$+HEX$ Y,C);D$(I-Y+INT Y);R$;RIGHT$ (S$+HEX$ X,C);D$(I-X+INT X);:C=O
1730 B$="":LOCATE
1740 *K K$=INPUT $I,J$=MID$ (T$,ASC K$+I,I)
1750 *J GOTO J$
1760 "2" K$=INPUT $I,J$=MID$ (U$,ASC K$+I,I):GOTO *J
1770 '--- ERROR
1780 *ERR M$="Error."
1790 IF ERN =&14IF C>O LET M$="DispErr.":B=O,C=O ELSE M$="Overflow."
1800 IF ERN =&15LET M$="DivBy0."
1810 PRINT #I,C$;" ";M$;" "
1820 M=ASC INPUT $I:IF M=&C IF C<O LET C=O:RESUME *F ELSE RESUME *P
1830 IF M=O IF ASC INPUT $I=&5THEN 1850
1840 GOTO 1820
1850 ON ERROR GOTO 0:RESUME
