home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 326-350 / apd345 / calcpad.amos / calcpad.amosSourceCode < prev    next >
AMOS Source Code  |  1992-09-02  |  35KB  |  1,057 lines
  1. ', 
  2. Global XVQ$,IVQ,JVQ
  3. Rem          ** CalcPad 1200 **      
  4. Rem        ** Bill Currie 1993 **    
  5. '
  6. Rem             ** Demo ** 
  7. '
  8. '
  9. Rem Imbedding Routine
  10. '
  11. '
  12. Rem AMOS copyright notice  
  13. AMOSC
  14. Procedure AMOSC
  15.    Screen Open 0,320,256,32,Lowres
  16.    Curs Off : Paper 0 : Cls 0 : Print 
  17.    Get Icon Palette 
  18.    Locate 0,1
  19.    Centre ">>> Program by Bill Currie <<<"
  20.    Flash 3,"(f00,32)(f80,32)(ff0,32)(0f0,32)(08f,32)(88f,32)(f0f,32)"
  21.    Pen 3 : Ink 3 : Box 50,40 To 270,150
  22.    Locate 0,11
  23.    Centre Border$("CalcPad",1)
  24.    Ink 0 : Pen 2
  25.    Paste Icon 220,20,2
  26.    _SMALL_COPYRIGHT[225]
  27.    Cls 0
  28. End Proc
  29. Procedure _SMALL_COPYRIGHT[YDISPLAY]
  30.    Auto View Off 
  31.    Screen Open 7,320,24,16,0 : Curs Off : Flash Off : Cls 0
  32.    Screen Display 7,,-100,,
  33.    Paste Bob 260,3,1
  34.    Paper 0 : Pen 7 : Print At(1,1);"This program was written using"
  35.    Get Sprite Palette 
  36.    View : Wait Vbl 
  37.    For Y=1 To Screen Height/2
  38.       Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2
  39.       Screen Offset 7,,Screen Height/2-Y
  40.       View : Wait Vbl 
  41.    Next 
  42.    Do 
  43.       If Mouse Key=1 Then Exit 
  44.    Loop 
  45.    For Y=Screen Height/2 To 0 Step -1
  46.       Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2
  47.       Screen Offset 7,,Screen Height/2-Y
  48.       View : Wait Vbl 
  49.    Next 
  50.    Screen Close 7
  51.    Auto View On 
  52. End Proc
  53. '
  54. Screen Open 5,320,256,4,Lowres
  55. Curs Off : Colour 0,$77 : Paper 0 : Cls 0 : Flash Off : Colour 3,$FF0
  56. Locate 5,1 : Input "Date ? ";DATE$
  57. Cls 0 : Curs Off 
  58. Pen 3
  59. Locate 5,1 : Print DATE$
  60. Locate 0,24 : Centre "CalcPad"
  61. '
  62. '
  63. Rem End of Imbedding Routine 
  64. '''''''''''''''''''''''''''''''''''''''' 
  65. '
  66. Global CHECK$
  67. PAD
  68. '
  69. '''''''''''''''''''''''''''''''''''''''' 
  70. End 
  71. Rem          ** Demo End **
  72. '
  73. Rem ******** Procedures & Global ********* 
  74. '
  75. Procedure PAD
  76.    Limit Mouse 
  77.    '
  78.    Screen Open 0,320,56,4,Hires
  79.    Screen Display 0,210,100,320,56
  80.    Curs Off : Cls 1 : Colour 0,$77
  81.    Screen 0
  82.    Screen Show 0
  83.    Global CHECK$
  84.    Global SIGFIGS,ID$,EVAL$,FUNCTION$
  85.    Global A$,B$,C$,D$,E$,F$,G$,H$,I$,J$,K$,L$,M$
  86.    Global N$,O$,P$,Q$,R$,S$,T$,U$,V$,W$,X$,Y$,Z$
  87.    Locate 3,2 : Centre " [C]alculator [P]ad " : Print : Print : Centre "[H]elp      [E]xit"
  88.    BEGIN:
  89.    Do 
  90.       K$=Inkey$
  91.       If K$="C" or(K$="c") Then CALCULATOR : Goto BEGIN
  92.       If K$="P" or(K$="p") Then QUICKPAD : Goto BEGIN
  93.       If K$="H" or(K$="h") Then HELP : Goto BEGIN
  94.       If K$="E" or(K$="e") Then AMOSC : End 
  95.    Loop 
  96.    '
  97. End Proc
  98. Procedure CALCULATOR
  99.    Shared SIGFIGS,ID$,EVAL$,FUNCTION$
  100.    Shared A$,B$,C$,D$,E$,F$,G$,H$,I$,J$,K$,L$,M$
  101.    Shared N$,O$,P$,Q$,R$,S$,T$,U$,V$,W$,X$,Y$,Z$
  102.    On Error Goto ER
  103.    Goto OK
  104.    ER:
  105.    ERR
  106.    Resume XIT
  107.    OK:
  108.    Screen Open 1,320,88,4,Hires
  109.    Screen Display 1,210,100,320,88
  110.    Curs Off : Cls 1 : Colour 0,$77
  111.    Degree 
  112.    Cls 1 : Home : Paper 1
  113.    Centre "* Calculator *"
  114.    Wind Open 1,16,8,36,1,0
  115.    Wind Open 2,16,24,36,1,0
  116.    Wind Open 3,16,40,36,1,0
  117.    Wind Open 4,16,56,36,1,0
  118.    RETRY:
  119.    Window 1
  120.    Paper 0
  121.    Clw 
  122.    Input " ";FUNCTION1$
  123.    If FUNCTION1$<>"" Then FUNCTION$=FUNCTION1$
  124.    Centre ""+Right$(FUNCTION$,34)
  125.    Window 2
  126.    Paper 0
  127.    Clw 
  128.    Input "Significant Figures ";SIGFIGS;
  129.    Curs Off 
  130.    Window 3
  131.    Paper 0
  132.    Clw : Curs Off 
  133.    FV$=FUNCTION$
  134.    '
  135.    Rem Functions to lower case
  136.    '
  137.    FV$=Upper$(FV$)
  138.    Restore NWDT
  139.    For J=1 To 20
  140.       Read AV$
  141.       BV$=Lower$(AV$)
  142.       L=Len(AV$)
  143.       Do 
  144.          I=Instr(FV$,AV$)
  145.          If I=0 Then Exit 
  146.          FV$=Left$(FV$,I-1)+BV$+Mid$(FV$,I+L)
  147.       Loop 
  148.    Next J
  149.    '
  150.    Rem Replace upper case letters by 'numbers'
  151.    VARS$=""
  152.    For J=65 To 90
  153.       Do 
  154.          I=Instr(FV$,Chr$(J))
  155.          If I=0 Then Exit 
  156.          If X Curs>25 Then Clw : Home 
  157.          Cright 
  158.          If J=65 Then Input "a = ";A$; : Print A$; : VARS$=VARS$+" a = "+A$ : Exit 
  159.          If J=66 Then Input "b = ";B$; : Print B$; : VARS$=VARS$+" b = "+B$ : Exit 
  160.          If J=67 Then Input "c = ";C$; : Print C$; : VARS$=VARS$+" c = "+C$ : Exit 
  161.          If J=68 Then Input "d = ";D$; : Print D$; : VARS$=VARS$+" d = "+D$ : Exit 
  162.          If J=69 Then Input "e = ";E$; : Print E$; : VARS$=VARS$+" e = "+E$ : Exit 
  163.          If J=70 Then Input "f = ";F$; : Print F$; : VARS$=VARS$+" f = "+F$ : Exit 
  164.          If J=71 Then Input "g = ";G$; : Print G$; : VARS$=VARS$+" g = "+G$ : Exit 
  165.          If J=72 Then Input "h = ";H$; : Print H$; : VARS$=VARS$+" h = "+H$ : Exit 
  166.          If J=73 Then Input "i = ";I$; : Print I$; : VARS$=VARS$+" i = "+I$ : Exit 
  167.          If J=74 Then Input "j = ";J$; : Print J$; : VARS$=VARS$+" j = "+J$ : Exit 
  168.          If J=75 Then Input "k = ";K$; : Print K$; : VARS$=VARS$+" k = "+K$ : Exit 
  169.          If J=76 Then Input "l = ";L$; : Print L$; : VARS$=VARS$+" l = "+L$ : Exit 
  170.          If J=77 Then Input "m = ";M$; : Print M$; : VARS$=VARS$+" m = "+M$ : Exit 
  171.          If J=78 Then Input "n = ";N$; : Print N$; : VARS$=VARS$+" n = "+N$ : Exit 
  172.          If J=79 Then Input "o = ";O$; : Print O$; : VARS$=VARS$+" o = "+O$ : Exit 
  173.          If J=80 Then Input "p = ";P$; : Print P$; : VARS$=VARS$+" p = "+P$ : Exit 
  174.          If J=81 Then Input "q = ";Q$; : Print Q$; : VARS$=VARS$+" q = "+Q$ : Exit 
  175.          If J=82 Then Input "r = ";R$; : Print R$; : VARS$=VARS$+" r = "+R$ : Exit 
  176.          If J=83 Then Input "s = ";S$; : Print S$; : VARS$=VARS$+" s = "+S$ : Exit 
  177.          If J=84 Then Input "t = ";T$; : Print T$; : VARS$=VARS$+" t = "+T$ : Exit 
  178.          If J=85 Then Input "u = ";U$; : Print U$; : VARS$=VARS$+" u = "+U$ : Exit 
  179.          If J=86 Then Input "v = ";V$; : Print V$; : VARS$=VARS$+" v = "+V$ : Exit 
  180.          If J=87 Then Input "w = ";W$; : Print W$; : VARS$=VARS$+" w = "+W$ : Exit 
  181.          If J=88 Then Input "x = ";X$; : Print X$; : VARS$=VARS$+" x = "+X$ : Exit 
  182.          If J=89 Then Input "y = ";Y$; : Print Y$; : VARS$=VARS$+" y = "+Y$ : Exit 
  183.          If J=90 Then Input "z = ";Z$; : Print Z$; : VARS$=VARS$+" z = "+Z$ : Exit 
  184.       Loop 
  185.    Next J
  186.    '
  187.    FV$=Upper$(FV$)
  188.    '
  189.    NWDT:
  190.    Data "ASIN","ACOS","ATAN","HSIN","HCOS","HTAN","SINH","COSH","TANH"
  191.    Data "SIN","COS","TAN","LOG","EXP","SQR","ABS","INT","SGN","LN"
  192.    Data "PI"
  193.    '
  194.    EVAL["$",FV$,SIGFIGS]
  195.    '
  196.    Window 1 : Cline : Centre Right$(FUNCTION$,34)
  197.    Curs Off 
  198.    EVAL["$",FV$,SIGFIGS]
  199.    Window 4
  200.    Paper 0
  201.    Clw 
  202.    If SIGFIGS=0 Then ANS$=EVAL$
  203.    If SIGFIGS>0 Then ANS$=EVAL$+"  "+Str$(SIGFIGS)+" SF"
  204.    Centre ANS$
  205.    Window 0
  206.    Paper 0
  207.    Locate 3,9 : Print Zone$("[P]rint",1)
  208.    Locate 16,9 : Print Zone$("[N]ext",2)
  209.    Locate 30,9 : Print Zone$("[E]xit",3)
  210.    Do 
  211.       K$=Inkey$
  212.       If(K$="N") or(K$="n") Then Goto RETRY
  213.       If(K$="P") or(K$="p") Then Lprint FUNCTION$ : Lprint " ";VARS$ : Lprint "    ";ANS$ : Lprint 
  214.       If(K$="E") or(K$="e") Then Exit 
  215.    Loop 
  216.    Clear Key 
  217.    Screen Close 1
  218.    XIT:
  219. End Proc
  220. Procedure EVAL[IDS$,FUNCTION$,SIGFIGS]
  221.    On Error Goto ER
  222.    Goto OK
  223.    ER:
  224.    EVAL$="Error"
  225.    Resume XITC
  226.    OK:
  227.    Shared EVAL,EVAL#,EVAL$
  228.    Rem All Local Variables and Labels end in VQ 
  229.    If IDS$="$"
  230.       Shared A$,B$,C$,D$,E$,F$,G$,H$,I$,J$,K$,L$,M$,N$,O$,P$,Q$,R$,S$,T$,U$,V$,W$,X$,Y$,Z$
  231.       AVQVQ$=A$ : BVQVQ$=B$ : CVQVQ$=C$ : DVQVQ$=D$ : EVQVQ$=E$ : FVQVQ$=F$ : GVQVQ$=G$
  232.       HVQVQ$=H$ : IVQVQ$=I$ : JVQVQ$=J$ : KVQVQ$=K$ : LVQVQ$=L$ : MVQVQ$=M$
  233.       NVQVQ$=N$ : OVQVQ$=O$ : PVQVQ$=P$ : QVQVQ$=Q$ : RVQVQ$=R$ : SVQVQ$=S$ : TVQVQ$=T$
  234.       UVQVQ$=U$ : VVQVQ$=V$ : WVQVQ$=W$ : XVQVQ$=X$ : YVQVQ$=Y$ : ZVQVQ$=Z$
  235.    End If 
  236.    If IDS$="#"
  237.       Shared A#,B#,C#,D#,E#,F#,G#,H#,I#,J#,K#,L#,M#,N#,O#,P#,Q#,R#,S#,T#,U#,V#,W#,X#,Y#,Z#
  238.       AVQVQ$=Str$(A#) : BVQVQ$=Str$(B#) : CVQVQ$=Str$(C#) : DVQVQ$=Str$(D#) : EVQVQ$=Str$(E#) : FVQVQ$=Str$(F#) : GVQVQ$=Str$(G#)
  239.       HVQVQ$=Str$(H#) : IVQVQ$=Str$(I#) : JVQVQ$=Str$(J#) : KVQVQ$=Str$(K#) : LVQVQ$=Str$(L#) : MVQVQ$=Str$(M#)
  240.       NVQVQ$=Str$(N#) : OVQVQ$=Str$(O#) : PVQVQ$=Str$(P#) : QVQVQ$=Str$(Q#) : RVQVQ$=Str$(R#) : SVQVQ$=Str$(S#) : TVQVQ$=Str$(T#)
  241.       UVQVQ$=Str$(U#) : VVQVQ$=Str$(V#) : WVQVQ$=Str$(W#) : XVQVQ$=Str$(X#) : YVQVQ$=Str$(Y#) : ZVQVQ$=Str$(Z#)
  242.    End If 
  243.    If IDS$=""
  244.       Shared A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
  245.       AVQVQ$=Str$(A) : BVQVQ$=Str$(B) : CVQVQ$=Str$(C) : DVQVQ$=Str$(D) : EVQVQ$=Str$(E) : FVQVQ$=Str$(F) : GVQVQ$=Str$(G)
  246.       HVQVQ$=Str$(H) : IVQVQ$=Str$(I) : JVQVQ$=Str$(J) : KVQVQ$=Str$(K) : LVQVQ$=Str$(L) : MVQVQ$=Str$(M)
  247.       NVQVQ$=Str$(N) : OVQVQ$=Str$(O) : PVQVQ$=Str$(P) : QVQVQ$=Str$(Q) : RVQVQ$=Str$(R) : SVQVQ$=Str$(S) : TVQVQ$=Str$(T)
  248.       UVQVQ$=Str$(U) : VVQVQ$=Str$(V) : WVQVQ$=Str$(W) : XVQVQ$=Str$(X) : YVQVQ$=Str$(Y) : ZVQVQ$=Str$(Z)
  249.    End If 
  250.    FVQ$=FUNCTION$
  251.    Gosub EVALLVQ
  252.    EVAL$=EVAL$
  253.    Goto XITC
  254.    EVALLVQ:
  255.    GVQ$="" : HVQ$="" : EVAL$=""
  256.    KEEPFVQ$=FVQ$ : KEEPGVQ$=GVQ$ : KEEPHVQ$=HVQ$
  257.    FVQ$=Upper$(FVQ$)
  258.    FVQ$="dummy"+FVQ$+"dummy"
  259.    Gosub SPACEREPLACEVQ
  260.    Gosub PIREPLACEVQ
  261.    Gosub AZREPLACEVQ
  262.    Do 
  263.       Gosub BRACKETSVQ
  264.       If GVQ$="Error" Then Exit 
  265.       Exit If FVQ$='end'
  266.       Gosub ARITHVQ
  267.       If GVQ$="Error" Then Exit 
  268.       Gosub TRIGVQ
  269.       If GVQ$="Error" Then Exit 
  270.    Loop 
  271.    '
  272.    Rem Avoid two .'s or two E's 
  273.    If Instr(Mid$(GVQ$,Instr(GVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  274.    If Instr(Mid$(GVQ$,Instr(GVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  275.    'If(Instr(GVQ$,"E")>0) and(Instr("123456789",Mid$(GVQ$,Instr(GVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  276.    '
  277.    If GVQ$="Error" Then EVAL$="Error" : Goto XITC
  278.    '
  279.    Rem Insert a space in front of an E
  280.    '
  281.    IVQ=Instr(GVQ$,"E")
  282.    If IVQ=0 Then Goto OKEVAL
  283.    GVQ$=Left$(GVQ$,IVQ-1)+" "+Mid$(GVQ$,IVQ)
  284.    OKEVAL:
  285.    '
  286.    Rem -0 is not really required as an answer 
  287.    If GVQ$="-0" Then GVQ$="0"
  288.    '
  289.    FINALCHECK:
  290.    IVQ=0
  291.    Do 
  292.       IVQ=IVQ+1
  293.       If IVQ>Len(GVQ$) Then Exit 
  294.       If Instr(" 1234567890.E+-",Mid$(GVQ$,IVQ,1))=0 Then GVQ$="Error" : Exit 
  295.    Loop 
  296.    '
  297.    Gosub ROUNDINGVQ
  298.    '
  299.    EVAL$=GVQ$
  300.    '
  301.    FVQ$=KEEPFVQ$ : GVQ$=KEEPGVQ$ : HVQ$=KEEPHVQ$
  302.    '
  303.    Return 
  304.    ROUNDINGVQ:
  305.    MARKERVQ=0
  306.    NVQ=Int(SIGFIGS)
  307.    If(NVQ<=0) or(GVQ$="0") Then Gosub ROUNDVQ : Goto XIT3
  308.    '
  309.    Rem Remove Tail End
  310.    IVQ=Instr(GVQ$," E")
  311.    FVQ$=GVQ$ : HVQ$=""
  312.    If IVQ<>0 Then FVQ$=Left$(GVQ$,IVQ-1) : HVQ$=Mid$(GVQ$,IVQ)
  313.    '
  314.    Rem Get any - sign 
  315.    SVQ$=""
  316.    If Left$(FVQ$,1)="-" Then SVQ$="-" : FVQ$=Mid$(FVQ$,2)
  317.    '
  318.    Rem Remove D.Pt. 
  319.    IVQ=Instr(FVQ$,".")
  320.    If IVQ<>0 Then FVQ$=Left$(FVQ$,IVQ-1)+Mid$(FVQ$,IVQ+1)
  321.    '
  322.    Rem Remove leading zeros 
  323.    KVQ=0
  324.    Do 
  325.       If Left$(FVQ$,1)<>"0" Then Exit 
  326.       FVQ$=Mid$(FVQ$,2)
  327.       Inc KVQ
  328.    Loop 
  329.    '
  330.    Rem MARKERVQ=0 
  331.    LVQ=Len(FVQ$)
  332.    If LVQ<=NVQ Then Goto XIT
  333.    Rem Chop off unwanted end
  334.    FVQ$=Left$(FVQ$,NVQ+1)
  335.    If Instr("01234",Right$(FVQ$,1))<>0 Then FVQ$=Left$(FVQ$,NVQ) : Goto XIT
  336.    FVQ$=Left$(FVQ$,NVQ) : JVQ=0
  337.    Do 
  338.       If Right$(FVQ$,1)=Chr$(48+JVQ) Then FVQ$=Left$(FVQ$,NVQ-1)+Chr$(48+JVQ+1) : Goto XIT
  339.       Inc JVQ
  340.       If JVQ=9 Then Exit 
  341.    Loop 
  342.    Rem Two 9's at end 
  343.    JVQ=1
  344.    Do 
  345.       If Mid$(FVQ$,NVQ-JVQ,1)<>"9" Then FVQ$=Left$(FVQ$,NVQ-JVQ-1)+Chr$(Asc(Mid$(FVQ$,NVQ-JVQ,1))+1) : Goto XIT
  346.       Inc JVQ
  347.       If JVQ=NVQ Then Exit 
  348.    Loop 
  349.    FVQ$="1"+String$("0",LVQ) : MARKERVQ=1
  350.    XIT:
  351.    If MARKERVQ=0 Then FVQ$=FVQ$+String$("0",LVQ-Len(FVQ$))
  352.    Rem Replace leading zeros
  353.    FVQ$=String$("0",KVQ)+FVQ$
  354.    Rem Replace D.Pt.
  355.    If IVQ=0 Then Goto XIT2
  356.    If MARKERVQ=0 Then FVQ$=Left$(FVQ$,IVQ-1)+"."+Mid$(FVQ$,IVQ)
  357.    If MARKERVQ=1 Then FVQ$=Left$(FVQ$,IVQ)+"."+Mid$(FVQ$,IVQ+1)
  358.    MARKERVQ=0
  359.    Rem Remove unwanted zeros at right 
  360.    Do 
  361.       If Right$(FVQ$,1)<>"0" Then Exit 
  362.       If Right$(FVQ$,2)=".0" Then Exit 
  363.       FVQ$=Left$(FVQ$,Len(FVQ$)-1)
  364.    Loop 
  365.    XIT2:
  366.    GVQ$=FVQ$+HVQ$
  367.    Rem Remove unwanted zeros at left
  368.    Do 
  369.       If Left$(GVQ$,1)<>"0" Then Exit 
  370.       If Left$(GVQ$,2)="0." Then Exit 
  371.       GVQ$=Right$(GVQ$,Len(GVQ$)-1)
  372.    Loop 
  373.    Rem Replace sign 
  374.    GVQ$=SVQ$+GVQ$
  375.    XIT3:
  376.    Return 
  377.    ROUNDVQ:
  378.    Rem Rounding 
  379.    '
  380.    IVQ=Instr(GVQ$," E")
  381.    FVQ$=GVQ$ : HVQ$=""
  382.    If IVQ<>0 Then FVQ$=Left$(GVQ$,IVQ-1) : HVQ$=Mid$(GVQ$,IVQ)
  383.    '
  384.    IVQ=Instr(FVQ$,".")
  385.    AVQ$=FVQ$
  386.    If IVQ<>0 Then AVQ$=Left$(FVQ$,IVQ-1)+Mid$(FVQ$,IVQ+1)
  387.    Rem Primitive rounding for eg .98! ,default - number of significant figures unspecified
  388.    KVQ=Len(AVQ$)
  389.    If KVQ<6 Then Goto XITB
  390.    If Right$(AVQ$,6)="899999" Then AVQ$=Left$(AVQ$,KVQ-6)+"900000"
  391.    If Right$(AVQ$,6)="799999" Then AVQ$=Left$(AVQ$,KVQ-6)+"800000"
  392.    If Right$(AVQ$,6)="699999" Then AVQ$=Left$(AVQ$,KVQ-6)+"700000"
  393.    If Right$(AVQ$,6)="599999" Then AVQ$=Left$(AVQ$,KVQ-6)+"600000"
  394.    If Right$(AVQ$,6)="499999" Then AVQ$=Left$(AVQ$,KVQ-6)+"500000"
  395.    If Right$(AVQ$,6)="399999" Then AVQ$=Left$(AVQ$,KVQ-6)+"400000"
  396.    If Right$(AVQ$,6)="299999" Then AVQ$=Left$(AVQ$,KVQ-6)+"300000"
  397.    If Right$(AVQ$,6)="199999" Then AVQ$=Left$(AVQ$,KVQ-6)+"200000"
  398.    If Right$(AVQ$,6)="099999" Then AVQ$=Left$(AVQ$,KVQ-6)+"100000"
  399.    If Right$(AVQ$,6)="899998" Then AVQ$=Left$(AVQ$,KVQ-6)+"900000"
  400.    If Right$(AVQ$,6)="799998" Then AVQ$=Left$(AVQ$,KVQ-6)+"800000"
  401.    If Right$(AVQ$,6)="699998" Then AVQ$=Left$(AVQ$,KVQ-6)+"700000"
  402.    If Right$(AVQ$,6)="599998" Then AVQ$=Left$(AVQ$,KVQ-6)+"600000"
  403.    If Right$(AVQ$,6)="499998" Then AVQ$=Left$(AVQ$,KVQ-6)+"500000"
  404.    If Right$(AVQ$,6)="399998" Then AVQ$=Left$(AVQ$,KVQ-6)+"400000"
  405.    If Right$(AVQ$,6)="299998" Then AVQ$=Left$(AVQ$,KVQ-6)+"300000"
  406.    If Right$(AVQ$,6)="199998" Then AVQ$=Left$(AVQ$,KVQ-6)+"200000"
  407.    If Right$(AVQ$,6)="299998" Then AVQ$=Left$(AVQ$,KVQ-6)+"100000"
  408.    If Right$(AVQ$,6)="199998" Then AVQ$=Left$(AVQ$,KVQ-6)+"200000"
  409.    If Right$(AVQ$,6)="099998" Then AVQ$=Left$(AVQ$,KVQ-6)+"100000"
  410.    If IVQ=0 Then FVQ$=AVQ$ : Goto XIT2A
  411.    FVQ$=Left$(AVQ$,IVQ-1)+"."+Mid$(AVQ$,IVQ)
  412.    Do 
  413.       If Right$(FVQ$,1)<>"0" Then Exit 
  414.       If Right$(FVQ$,2)=".0" Then Exit 
  415.       FVQ$=Left$(FVQ$,Len(FVQ$)-1)
  416.    Loop 
  417.    XIT2A:
  418.    GVQ$=FVQ$+HVQ$
  419.    Rem Remove unwanted zeros at left
  420.    Do 
  421.       If Left$(GVQ$,1)<>"0" Then Exit 
  422.       If Left$(GVQ$,2)="0." Then Exit 
  423.       GVQ$=Right$(GVQ$,Len(GVQ$)-1)
  424.    Loop 
  425.    XITB:
  426.    Return 
  427.    SPACEREPLACEVQ:
  428.    Do 
  429.       IVQ=Instr(FVQ$," ")
  430.       If IVQ=0 Then Exit 
  431.       FVQ$=Left$(FVQ$,IVQ-1)+Right$(FVQ$,Len(FVQ$)-IVQ)
  432.    Loop 
  433.    Return 
  434.    PIREPLACEVQ:
  435.    Do 
  436.       IVQ=Instr(FVQ$,'PI')
  437.       Exit If IVQ=0
  438.       FVQ$=Left$(FVQ$,IVQ-1)+Str$(Pi#)+Mid$(FVQ$,IVQ+2)
  439.    Loop 
  440.    Return 
  441.    AZREPLACEVQ:
  442.    '
  443.    Rem Functions to lower case
  444.    '
  445.    Restore NWDT
  446.    For JVQ=1 To 19
  447.       Read AVQ$
  448.       BVQ$=Lower$(AVQ$)
  449.       L=Len(AVQ$)
  450.       Do 
  451.          IVQ=Instr(FVQ$,AVQ$)
  452.          If IVQ=0 Then Exit 
  453.          FVQ$=Left$(FVQ$,IVQ-1)+BVQ$+Mid$(FVQ$,IVQ+L)
  454.       Loop 
  455.    Next JVQ
  456.    '
  457.    Rem Replace upper case letters by 'numbers'
  458.    For JVQ=65 To 90
  459.       Read XVQ$
  460.       '
  461.       If Instr(FVQ$,Chr$(JVQ))<>0
  462.          For IVQ=1 To Len(XVQ$)
  463.             If Instr("0123456789+-*/^eE. ",Mid$(XVQ$,IVQ,1))=0
  464.                EVAL$="Error" : Goto XITC
  465.             End If 
  466.          Next IVQ
  467.       End If 
  468.       '
  469.       If(Instr(XVQ$,".")=0) and(Instr(XVQ$,"e")=0) and(Instr(XVQ$,"E")=0) and Len(XVQ$)>10 Then XVQ$=XVQ$+".0"
  470.       '
  471.       Do 
  472.          XINVQ$=XVQ$
  473.          IVQ=Instr(FVQ$,Chr$(JVQ))
  474.          If IVQ=0 Then Exit 
  475.          For J2VQ=48 To 57
  476.             If Mid$(FVQ$,IVQ+1,1)=Chr$(J2VQ) Then EVAL$="Error" : Goto XITC
  477.          Next J2VQ
  478.          If Mid$(FVQ$,IVQ+1,1)="." Then EVAL$="Error" : Goto XITC
  479.          For J2VQ=48 To 57
  480.             If Mid$(FVQ$,IVQ-1,1)=Chr$(J2VQ) Then XINVQ$="*"+XINVQ$
  481.          Next J2VQ
  482.          If Mid$(FVQ$,IVQ-1,1)="." Then XINVQ$="*"+XINVQ$
  483.          For J2VQ=65 To 90
  484.             If Mid$(FVQ$,IVQ-1,1)=Chr$(J2VQ) Then XINVQ$="*"+XINVQ$
  485.          Next J2VQ
  486.          For J2VQ=65 To 90
  487.             If Mid$(FVQ$,IVQ+1,1)=Chr$(J2VQ) Then XINVQ$=XINVQ$+"*"
  488.          Next J2VQ
  489.          Rem pi   
  490.          If Mid$(FVQ$,IVQ+1,1)=" " Then XINVQ$=XINVQ$+"*"
  491.          '
  492.          FVQ$=Left$(FVQ$,IVQ-1)+XINVQ$+Mid$(FVQ$,IVQ+1)
  493.       Loop 
  494.    Next JVQ
  495.    '
  496.    FVQ$=Upper$(FVQ$)
  497.    '
  498.    NWDT:
  499.    Data "ASIN","ACOS","ATAN","HSIN","HCOS","HTAN","SINH","COSH","TANH"
  500.    Data "SIN","COS","TAN","LOG","EXP","SQR","ABS","INT","SGN","LN"
  501.    Data AVQVQ$,BVQVQ$,CVQVQ$,DVQVQ$,EVQVQ$
  502.    Data FVQVQ$,GVQVQ$,HVQVQ$,IVQVQ$,JVQVQ$
  503.    Data KVQVQ$,LVQVQ$,MVQVQ$,NVQVQ$,OVQVQ$
  504.    Data PVQVQ$,QVQVQ$,RVQVQ$,SVQVQ$,TVQVQ$
  505.    Data UVQVQ$,VVQVQ$,WVQVQ$,XVQVQ$,YVQVQ$,ZVQVQ$
  506.    '
  507.    Return 
  508.    BRACKETSVQ:
  509.    IVQ=Instr(FVQ$,')')
  510.    If IVQ=0 Then GVQ$=Mid$(FVQ$,6,(Len(FVQ$)-10)) : FVQ$='end' : HVQ$='end' : Gosub ARITHVQ : Goto FINBR
  511.    HVQ$=Mid$(FVQ$,IVQ+1) : FVQ$=Left$(FVQ$,IVQ-1)
  512.    '''''''''''''' 
  513.    If Instr("0123456789. ",Left$(HVQ$,1))<>0 Then EVAL$="Error" : Goto XITC
  514.    '''''''''''''' 
  515.    JVQ=0
  516.    Do 
  517.       JVQ=JVQ+1
  518.       IVQ=Instr(Right$(FVQ$,JVQ),"(")
  519.       If IVQ<>0 Then Exit 
  520.       If JVQ=Len(FVQ$) Then GVQ$="Error" : Goto FINBR
  521.    Loop 
  522.    GVQ$=Mid$(FVQ$,Len(FVQ$)-JVQ+2) : FVQ$=Left$(FVQ$,Len(FVQ$)-JVQ)
  523.    FINBR:
  524.    Return 
  525.    ARITHVQ:
  526.    Gosub POWERSVQ
  527.    Gosub COMPRESS_SIGNSVQ
  528.    Gosub MULT_DIVVQ
  529.    If GVQ$="error" Then Goto ARERR
  530.    Gosub COMPRESS_SIGNSVQ
  531.    Gosub AD_SUBVQ
  532.    Gosub COMPRESS_SIGNSVQ
  533.    ARERR:
  534.    Return 
  535.    SPACEREMOVEVQ:
  536.    Do 
  537.       IVQ=Instr(GVQ$," ")
  538.       If IVQ=0 Then Exit 
  539.       GVQ$=Left$(GVQ$,IVQ-1)+Right$(GVQ$,Len(GVQ$)-IVQ)
  540.    Loop 
  541.    Return 
  542.    TRIGVQ:
  543.    On Error Goto ERROUTINE
  544.    IVQ=Len(FVQ$) : CVQ#=Val(GVQ$)
  545.    DUMMYVQ$=Right$(FVQ$,1) : If Instr('+-*/^(Y',DUMMYVQ$)<>0 Then Goto NEWFX
  546.    DUMMYVQ$=Right$(FVQ$,4) : If DUMMYVQ$='ASIN' Then CVQ#=Acos(Sqr(1-CVQ#^2)) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-4) : Goto NEWFX2
  547.    DUMMYVQ$=Right$(FVQ$,4) : If DUMMYVQ$='ACOS' Then CVQ#=Acos(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-4) : Goto NEWFX2
  548.    DUMMYVQ$=Right$(FVQ$,4) : If DUMMYVQ$='ATAN' Then CVQ#=Atan(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-4) : Goto NEWFX2
  549.    DUMMYVQ$=Right$(FVQ$,4) : If DUMMYVQ$='HSIN' Then CVQ#=(Exp(CVQ#)-Exp(-CVQ#))/2 : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-4) : Goto NEWFX2
  550.    DUMMYVQ$=Right$(FVQ$,4) : If DUMMYVQ$='SINH' Then CVQ#=(Exp(CVQ#)-Exp(-CVQ#))/2 : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-4) : Goto NEWFX2
  551.    DUMMYVQ$=Right$(FVQ$,4) : If DUMMYVQ$='HCOS' Then CVQ#=(Exp(CVQ#)+Exp(-CVQ#))/2 : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-4) : Goto NEWFX2
  552.    DUMMYVQ$=Right$(FVQ$,4) : If DUMMYVQ$='COSH' Then CVQ#=(Exp(CVQ#)+Exp(-CVQ#))/2 : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-4) : Goto NEWFX2
  553.    DUMMYVQ$=Right$(FVQ$,4) : If DUMMYVQ$='HTAN' Then CVQ#=(Exp(CVQ#)-Exp(-CVQ#))/(Exp(CVQ#)+Exp(-CVQ#)) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-4) : Goto NEWFX2
  554.    DUMMYVQ$=Right$(FVQ$,4) : If DUMMYVQ$='TANH' Then CVQ#=(Exp(CVQ#)-Exp(-CVQ#))/(Exp(CVQ#)+Exp(-CVQ#)) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-4) : Goto NEWFX2
  555.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='SIN' Then CVQ#=Sin(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  556.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='COS' Then CVQ#=Cos(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  557.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='TAN' Then CVQ#=Tan(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  558.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='LOG' Then CVQ#=Log(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  559.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='EXP' Then CVQ#=Exp(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  560.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='SQR' Then CVQ#=Sqr(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  561.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='ABS' Then CVQ#=Abs(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  562.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='INT' Then CVQ#=Int(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  563.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='SGN' Then CVQ#=Sgn(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  564.    DUMMYVQ$=Right$(FVQ$,2) : If DUMMYVQ$='LN' Then CVQ#=Ln(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-2) : Goto NEWFX2
  565.    NEWFX2:
  566.    DUMMYVQ$=Right$(FVQ$,1)
  567.    If Instr('+-*/^(Y',DUMMYVQ$)<>0 Then Goto NEWFX
  568.    FVQ$=FVQ$+"*"
  569.    NEWFX:
  570.    FVQ$=FVQ$+GVQ$+HVQ$
  571.    Goto NERR
  572.    ERROUTINE:
  573.    GVQ$="Error"
  574.    Resume NERR
  575.    NERR:
  576.    Return 
  577.    POWERSVQ:
  578.    POWERTEST:
  579.    Gosub SPACEREMOVEVQ
  580.    IVQ=Instr(GVQ$,'^')
  581.    If IVQ=0 Then Goto NPRS
  582.    Rem g$ = lef1vq$ + lefvq$ ^ rigvq$ +rig1vq$  
  583.    Rem first get rid of any first sequences of +'s or -'s after the ^ 
  584.    FULLRVQ$=Right$(GVQ$,Len(GVQ$)-IVQ)
  585.    Do 
  586.       If Left$(FULLRVQ$,1)="+" Then FULLRVQ$=Mid$(FULLRVQ$,2) : Goto RETRY1
  587.       If Len(FULLRVQ$)>1 Then If Left$(FULLRVQ$,2)="--" Then FULLRVQ$=Mid$(FULLRVQ$,3) : Goto RETRY1
  588.       If Len(FULLRVQ$)>1 Then If Left$(FULLRVQ$,2)="-+" Then FULLRVQ$="-"+Mid$(FULLRVQ$,3) : Goto RETRY1
  589.       Exit 
  590.       RETRY1:
  591.    Loop 
  592.    GVQ$=Left$(GVQ$,IVQ)+FULLRVQ$
  593.    Rem ****** 
  594.    Rem get right hand side
  595.    Rem remember ^ is at position ivq
  596.    JVQ=IVQ+1
  597.    RIGVQ$=Mid$(GVQ$,JVQ,1)
  598.    Do 
  599.       If JVQ=Len(GVQ$) Then Exit 
  600.       JVQ=JVQ+1
  601.       DUMMYVQ$=Mid$(GVQ$,JVQ,1) : DUMMY1VQ$=Mid$(GVQ$,JVQ-1,1)
  602.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto RETRY2
  603.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto RETRY2
  604.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto RETRY2
  605.       Exit 
  606.       RETRY2:
  607.    Loop 
  608.    Rem Avoid two .'s or two E's 
  609.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  610.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  611.    'If(Instr(RIGVQ$,"E")>0) and(Instr("123456789",Mid$(RIGVQ$,Instr(RIGVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  612.    If JVQ=Len(GVQ$) Then RIG1VQ$='' : Else RIG1VQ$=Mid$(GVQ$,JVQ)
  613.    '
  614.    Rem Now get the left hand side 
  615.    Rem Remember ^ is still at position ivq
  616.    Rem Use KVQ this time, instead of JVQ
  617.    Rem The left hand side should be easier
  618.    KVQ=IVQ-1
  619.    LEFVQ$=Mid$(GVQ$,KVQ,1)
  620.    Do 
  621.       KVQ=KVQ-1
  622.       Exit If KVQ=0
  623.       DUMMYVQ$=Mid$(GVQ$,KVQ,1)
  624.       DUMMY1VQ$=""
  625.       If KVQ>1 Then DUMMY1VQ$=Mid$(GVQ$,KVQ-1,1)
  626.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto RETRY3
  627.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto RETRY3
  628.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto RETRY3
  629.       If DUMMYVQ$="-" Then If DUMMY1VQ$="+" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : KVQ=KVQ-1 : Exit 
  630.       If DUMMYVQ$="-" Then If DUMMY1VQ$="-" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : KVQ=KVQ-1 : Exit 
  631.       If DUMMYVQ$="-" Then If DUMMY1VQ$="" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : KVQ=KVQ-1 : Exit 
  632.       Exit 
  633.       RETRY3:
  634.    Loop 
  635.    Rem Avoid two .'s or two E's 
  636.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  637.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  638.    'If(Instr(LEFVQ$,"E")>0) and(Instr("123456789",Mid$(LEFVQ$,Instr(LEFVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  639.    If KVQ=0 Then LEF1VQ$='' : Else LEF1VQ$=Mid$(GVQ$,1,KVQ) : 
  640.    Rem *****
  641.    LLVQ#=Val(LEFVQ$) : RRVQ#=Val(RIGVQ$)
  642.    If(Abs(LLVQ#)<>LLVQ#) and(RRVQ#<>Int(RRVQ#)) Then EVAL$="Error" : Goto XITC
  643.    MIVQ#=LLVQ#^RRVQ#
  644.    '
  645.    Rem Try -1^5 in AMOS? Are odd powers of - nos OK? Assumed not! 
  646.    Rem If Left$(LEFVQ$,1)="-" and 2*Int(RRVQ#/2)<>RRVQ# and RRVQ#=Int(RRVQ#) Then MIDDVQ$="-"+Mid$(MIDDVQ$,2)               
  647.    Rem Possible correction for powers that are odd integers. Leave??! Unsure! Making matters worse ?  
  648.    Rem I don't like this. However...?Complex Numbers?... ... ...
  649.    Rem Look at later. See line two from here !  
  650.    '
  651.    MIDDVQ$=Str$(MIVQ#)
  652.    '
  653.    If Left$(LEFVQ$,1)="-" and 2*Int(RRVQ#/2)<>RRVQ# and RRVQ#=Int(RRVQ#) Then MIDDVQ$="-"+Mid$(MIDDVQ$,2)
  654.    '
  655.    If Left$(MIDDVQ$,1)<>"-" Then MIDDVQ$=Mid$(MIDDVQ$,2) : Rem NB Removing a space
  656.    GVQ$=LEF1VQ$+MIDDVQ$+RIG1VQ$
  657.    Goto POWERTEST
  658.    NPRS:
  659.    Return 
  660.    PPREMOVEVQ:
  661.    Do 
  662.       IVQ=Instr(GVQ$,"++")
  663.       If IVQ=0 Then Exit 
  664.       GVQ$=Left$(GVQ$,IVQ-1)+"+"+Mid$(GVQ$,IVQ+2)
  665.       PMVQ$="Y"
  666.    Loop 
  667.    Return 
  668.    PMREMOVEVQ:
  669.    Do 
  670.       IVQ=Instr(GVQ$,"+-")
  671.       If IVQ=0 Then Exit 
  672.       GVQ$=Left$(GVQ$,IVQ-1)+"-"+Mid$(GVQ$,IVQ+2)
  673.       PMVQ$="Y"
  674.    Loop 
  675.    Return 
  676.    MPREMOVEVQ:
  677.    Do 
  678.       IVQ=Instr(GVQ$,"-+")
  679.       If IVQ=0 Then Exit 
  680.       GVQ$=Left$(GVQ$,IVQ-1)+"-"+Mid$(GVQ$,IVQ+2)
  681.       PMVQ$="Y"
  682.    Loop 
  683.    Return 
  684.    MMREMOVEVQ:
  685.    Do 
  686.       IVQ=Instr(GVQ$,"--")
  687.       If IVQ=0 Then Exit 
  688.       GVQ$=Left$(GVQ$,IVQ-1)+"+"+Mid$(GVQ$,IVQ+2)
  689.       PMVQ$="Y"
  690.    Loop 
  691.    Return 
  692.    COMPRESS_SIGNSVQ:
  693.    Do 
  694.       PMVQ$="N"
  695.       Gosub PPREMOVEVQ
  696.       Gosub PMREMOVEVQ
  697.       Gosub MPREMOVEVQ
  698.       Gosub MMREMOVEVQ
  699.       If PMVQ$="N" Then Exit 
  700.    Loop 
  701.    Return 
  702.    MULT_DIVVQ:
  703.    On Error Goto ERROUTINEMD
  704.    LEFTMOSTMD:
  705.    Gosub SPACEREMOVEVQ
  706.    IVQ=Instr(GVQ$,'*')
  707.    IIVQ=Instr(GVQ$,'/')
  708.    If IIVQ>1 and(IIVQ<IVQ or IVQ=0) Then IVQ=IIVQ : LVQ$="/" : Goto WORKOUT1
  709.    If IVQ>1 Then LVQ$="*" : Goto WORKOUT1
  710.    Goto NMRMD
  711.    WORKOUT1:
  712.    Rem gv$ = lef1vq$   lefvq$ # rigvq$   rig1vq$  , where # is * or / 
  713.    Rem find right number
  714.    JVQ=IVQ+1
  715.    RIGVQ$=Mid$(GVQ$,JVQ,1)
  716.    Do 
  717.       If JVQ=Len(GVQ$) Then Exit 
  718.       JVQ=JVQ+1
  719.       DUMMYVQ$=Mid$(GVQ$,JVQ,1) : DUMMY1VQ$=Mid$(GVQ$,JVQ-1,1)
  720.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON
  721.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON
  722.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON
  723.       Exit 
  724.       KEEP_ON:
  725.    Loop 
  726.    Rem Avoid two .'s or two E's 
  727.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  728.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  729.    'If(Instr(RIGVQ$,"E")>0) and(Instr("123456789",Mid$(RIGVQ$,Instr(RIGVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  730.    If JVQ=Len(GVQ$) Then RIG1VQ$='' : Else RIG1VQ$=Mid$(GVQ$,JVQ)
  731.    Rem ********** 
  732.    Rem Find left number 
  733.    KVQ=IVQ-1
  734.    LEFVQ$=Mid$(GVQ$,KVQ,1)
  735.    Do 
  736.       KVQ=KVQ-1
  737.       Exit If KVQ=0
  738.       DUMMYVQ$=Mid$(GVQ$,KVQ,1)
  739.       DUMMY1VQ$=""
  740.       If KVQ-1>0 Then DUMMY1VQ$=Mid$(GVQ$,KVQ-1,1)
  741.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK
  742.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK
  743.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK
  744.       Exit 
  745.       REWORK:
  746.    Loop 
  747.    Rem Avoid two .'s or two E's 
  748.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  749.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  750.    'If(Instr(LEFVQ$,"E")>0) and(Instr("123456789",Mid$(LEFVQ$,Instr(LEFVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  751.    If KVQ=0 Then LEF1VQ$='' : Else LEF1VQ$=Mid$(GVQ$,1,KVQ)
  752.    Rem
  753.    Rem now work out lef1vq$ lefvq$ # rigvq$ rig1vq$ 
  754.    Rem
  755.    LLVQ#=Val(LEFVQ$) : RRVQ#=Val(RIGVQ$)
  756.    If LVQ$="*" Then MIVQ#=LLVQ#*RRVQ#
  757.    If LVQ$="/" Then MIVQ#=LLVQ#/RRVQ#
  758.    MIDDVQ$=Str$(MIVQ#)
  759.    If Left$(MIDDVQ$,1)<>"-" Then MIDDVQ$=Right$(MIDDVQ$,Len(MIDDVQ$)-1) : Rem NB Removing a space  
  760.    GVQ$=LEF1VQ$+MIDDVQ$+RIG1VQ$
  761.    Goto LEFTMOSTMD
  762.    Rem
  763.    NMRMD:
  764.    Goto NERRMD
  765.    ERROUTINEMD:
  766.    GVQ$="Error"
  767.    Resume NERRMD
  768.    NERRMD:
  769.    Return 
  770.    AD_SUBVQ:
  771.    LEFTMOSTADSUB:
  772.    Gosub SPACEREMOVEVQ
  773.    Gosub COMPRESS_SIGNSVQ
  774.    '
  775.    Rem Avoiding E+
  776.    Do 
  777.       I2VQ=Instr(GVQ$,"E+")
  778.       If I2VQ=0 Then Exit 
  779.       GVQ$=Left$(GVQ$,I2VQ-1)+"EE"+Mid$(GVQ$,I2VQ+2)
  780.    Loop 
  781.    '
  782.    Rem Avoid possible initial - sign, starting from 2nd character 
  783.    IVQ=Instr(Mid$(GVQ$,2),'+')
  784.    '
  785.    Rem Now replacing E+ 
  786.    Do 
  787.       I2VQ=Instr(GVQ$,"EE")
  788.       If I2VQ=0 Then Exit 
  789.       GVQ$=Left$(GVQ$,I2VQ-1)+"E+"+Mid$(GVQ$,I2VQ+2)
  790.    Loop 
  791.    Rem Having avoided E+ now continue 
  792.    '
  793.    Rem Avoiding E-
  794.    Do 
  795.       I2VQ=Instr(GVQ$,"E-")
  796.       If I2VQ=0 Then Exit 
  797.       GVQ$=Left$(GVQ$,I2VQ-1)+"EE"+Mid$(GVQ$,I2VQ+2)
  798.    Loop 
  799.    '
  800.    Rem Avoid possible initial - sign, starting from 2nd character 
  801.    IIVQ=Instr(Mid$(GVQ$,2),'-')
  802.    '
  803.    Rem Now replacing E- 
  804.    Do 
  805.       I2VQ=Instr(GVQ$,"EE")
  806.       If I2VQ=0 Then Exit 
  807.       GVQ$=Left$(GVQ$,I2VQ-1)+"E-"+Mid$(GVQ$,I2VQ+2)
  808.    Loop 
  809.    Rem Having avoided E- now continue 
  810.    '
  811.    Rem Find which is leftmost, + or - 
  812.    '
  813.    If IIVQ>0 and(IIVQ<IVQ or IVQ=0) Then IVQ=IIVQ : LVQ$="-" : Goto WORKOUT2
  814.    If IVQ>0 Then LVQ$="+" : Goto WORKOUT2
  815.    Goto NMRADSUB
  816.    '
  817.    WORKOUT2:
  818.    Rem Remember to adjust IVQ since search began with 2nd item  
  819.    IVQ=IVQ+1
  820.    Rem gvq$ = lef1vq$   lefvq$ # rigvq$   rig1vq$  , where # is + or -  
  821.    Rem find right number
  822.    JVQ=IVQ+1
  823.    RIGVQ$=Mid$(GVQ$,JVQ,1)
  824.    Do 
  825.       If JVQ=Len(GVQ$) Then Exit 
  826.       JVQ=JVQ+1
  827.       DUMMYVQ$=Mid$(GVQ$,JVQ,1) : DUMMY1VQ$=Mid$(GVQ$,JVQ-1,1)
  828.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON2
  829.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON2
  830.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON2
  831.       Exit 
  832.       KEEP_ON2:
  833.    Loop 
  834.    Rem Avoid two .'s or two E's 
  835.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  836.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  837.    'If(Instr(RIGVQ$,"E")>0) and(Instr("123456789",Mid$(RIGVQ$,Instr(RIGVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  838.    If JVQ=Len(GVQ$) Then RIG1VQ$='' : Else RIG1VQ$=Mid$(GVQ$,JVQ)
  839.    Rem ********** 
  840.    Rem Find left number 
  841.    KVQ=IVQ-1
  842.    LEFVQ$=Mid$(GVQ$,KVQ,1)
  843.    Do 
  844.       KVQ=KVQ-1
  845.       Exit If KVQ=0
  846.       DUMMYVQ$=Mid$(GVQ$,KVQ,1)
  847.       DUMMY1VQ$=""
  848.       If KVQ-1>0 Then DUMMY1VQ$=Mid$(GVQ$,KVQ-1,1)
  849.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK2
  850.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK2
  851.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK2
  852.       Rem Don't forget negative numbers, working left to right 
  853.       If DUMMYVQ$="-" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : KVQ=KVQ-1 : Exit 
  854.       Exit 
  855.       REWORK2:
  856.    Loop 
  857.    Rem Avoid two .'s or two E's 
  858.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  859.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  860.    'If(Instr(LEFVQ$,"E")>0) and(Instr("123456789",Mid$(LEFVQ$,Instr(LEFVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  861.    If KVQ=0 Then LEF1VQ$='' : Else LEF1VQ$=Mid$(GVQ$,1,KVQ)
  862.    Rem
  863.    Rem now work out lef1vq$ lefvq$ # rigvq$ rig1vq$ 
  864.    Rem
  865.    LLVQ#=Val(LEFVQ$) : RRVQ#=Val(RIGVQ$)
  866.    If LVQ$="+" Then MIVQ#=LLVQ#+RRVQ#
  867.    If LVQ$="-" Then MIVQ#=LLVQ#-RRVQ#
  868.    MIDDVQ$=Str$(MIVQ#)
  869.    '
  870.    Rem NB Removing a space  
  871.    If Left$(MIDDVQ$,1)<>"-" Then MIDDVQ$=Right$(MIDDVQ$,Len(MIDDVQ$)-1)
  872.    '
  873.    GVQ$=LEF1VQ$+MIDDVQ$+RIG1VQ$
  874.    Goto LEFTMOSTADSUB
  875.    Rem
  876.    NMRADSUB:
  877.    If Left$(GVQ$,1)="+" Then GVQ$=Mid$(GVQ$,2)
  878.    Return 
  879.    XITC:
  880.    EVAL$=EVAL$
  881.    EVAL=Val(EVAL$)
  882.    EVAL#=Val(EVAL$)
  883. End Proc[EVAL$]
  884. Global CHECK$
  885. Procedure QUICKPAD
  886.    On Error Goto ER
  887.    Goto OK
  888.    ER:
  889.    ERR
  890.    Resume XIT
  891.    OK:
  892.    Screen Open 1,320,56,4,Hires
  893.    Screen Display 1,210,100,320,56
  894.    Curs Off : Cls 1 : Colour 0,$77
  895.    Cls 1 : Home : Paper 1
  896.    Centre "* Reminder *"
  897.    Paper 0
  898.    Wind Open 1,16,8,36,1,0
  899.    Wind Open 2,16,24,36,1,0
  900.    Window 2 : Clw : Centre CHECK$
  901.    RETRY:
  902.    Window 1 : Clw : Input " ";CHECK1$
  903.    If CHECK1$<>"" Then CHECK$=Left$(CHECK1$,34)
  904.    Curs Off 
  905.    Window 2 : Clw : Centre CHECK$
  906.    Window 0
  907.    Locate 3,5 : Print Zone$("[P]rint",1)
  908.    Locate 17,5 : Print Zone$("[R]edo",2)
  909.    Locate 30,5 : Print Zone$("[E]xit",3)
  910.    Do 
  911.       K$=Inkey$
  912.       If(K$="R") or(K$="r") Then Goto RETRY
  913.       If(K$="P") or(K$="p") Then Lprint CHECK$ : Lprint 
  914.       If(K$="E") or(K$="e") Then Exit 
  915.    Loop 
  916.    Clear Key 
  917.    Screen Close 1
  918.    XIT:
  919. End Proc
  920. Procedure HELP
  921.    On Error Goto ER
  922.    Goto OK
  923.    ER:
  924.    ERR
  925.    Resume XIT
  926.    OK:
  927.    Screen Open 1,640,256,4,Hires
  928.    Curs Off : Flash Off : Colour 3,$FF0
  929.    Cls 0
  930.    Paper 0
  931.    Print 
  932.    Print : Centre "****** HELP ******"
  933.    Print 
  934.    Print : Centre " CalcPad "
  935.    Print : Print : Print : Print 
  936.    Pen 3
  937.    'Print : Print : Centre "To include PAD in an AMOS program"
  938.    'Print : Print : Centre "merge Pad.AMOS" 
  939.    'Print : Print : Centre "Procedure Pad may then be used" 
  940.    Print : Print : Centre "CalcPad consists of a NotePad"
  941.    Print : Print : Centre "to put in a short reminder,"
  942.    Print : Print : Centre "and a Calculator"
  943.    Print : Print : Centre "which can handle arithmetic"
  944.    Print : Print : Centre "and algebraic & trigonometric formulae"
  945.    Print : Print : Centre "using all the letters of the alphabet"
  946.    Wait 50
  947.    Do 
  948.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  949.    Loop 
  950.    Cls 0
  951.    Paper 0
  952.    Home 
  953.    Print 
  954.    Centre "* CALCULATOR HELP *"
  955.    Print 
  956.    Print 
  957.    Pen 3
  958.    Centre " Functions and Trigonometric Expressions Allowed"
  959.    Pen 2
  960.    Print 
  961.    Print 
  962.    Centre "SIN"
  963.    Print 
  964.    Centre "COS"
  965.    Print 
  966.    Centre "TAN"
  967.    Print 
  968.    Centre "ASIN"
  969.    Print 
  970.    Centre "ACOS"
  971.    Print 
  972.    Centre "ATAN"
  973.    Print 
  974.    Centre "HSIN or SINH"
  975.    Print 
  976.    Centre "HCOS or COSH"
  977.    Print 
  978.    Centre "HTAN or TANH"
  979.    Print 
  980.    Centre "LOG for base 10"
  981.    Print 
  982.    Centre "EXP"
  983.    Print 
  984.    Centre "LN Naperian,ie for base e"
  985.    Print 
  986.    Centre "SQR for square roots"
  987.    Print 
  988.    Centre "ABS"
  989.    Print 
  990.    Centre "INT"
  991.    Print 
  992.    Centre "SGN returns +1,-1 or for a zero,0"
  993.    Wait 50
  994.    Do 
  995.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  996.    Loop 
  997.    Cls 0 : Home 
  998.    Pen 3
  999.    Print : Centre "* CALCULATOR HELP *"
  1000.    Print 
  1001.    Pen 2
  1002.    Print : Centre "Calculator Error Reports"
  1003.    Print 
  1004.    Print : Centre '"Error" is generated for'
  1005.    Print 
  1006.    Print : Centre "Errors in the input function"
  1007.    Print 
  1008.    Print : Centre "Division by zero"
  1009.    Print 
  1010.    Print : Centre "Errors in evaluating functions"
  1011.    Print 
  1012.    Centre "E.G"
  1013.    Print 
  1014.    Centre "Tan(90)"
  1015.    Print 
  1016.    Centre "LOG, -ve nos generate error report"
  1017.    Print 
  1018.    Centre "LN, -ve nos generate error report"
  1019.    Print 
  1020.    Centre "SQR, -ve nos generate error report"
  1021.    Print 
  1022.    Centre "Non-integer powers of -ve nos generate error report"
  1023.    Print 
  1024.    Pen 3
  1025.    Print : Centre "*"
  1026.    Pen 2
  1027.    Print : Print : Centre "Range -10^18 to 10^18"
  1028.    Pen 3
  1029.    Print : Print : Centre "*"
  1030.    Pen 2
  1031.    Wait 50
  1032.    Do 
  1033.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  1034.    Loop 
  1035.    Clear Key 
  1036.    Screen Close 1
  1037.    XIT:
  1038. End Proc
  1039. Procedure ERR
  1040.    On Error Goto ER
  1041.    Goto OK
  1042.    ER:
  1043.    Resume XIT
  1044.    OK:
  1045.    Screen Open 3,320,48,4,Hires
  1046.    Screen Display 3,200,100,320,48
  1047.    Curs Off : Cls 1
  1048.    Print : Centre "Error - Out of Memory/Range?"
  1049.    Print : Print : Centre "Press Left Mouse Key"
  1050.    Wait 50
  1051.    Do : Exit If Mouse Key=1 : Loop 
  1052.    Screen Close 3
  1053.    XIT:
  1054. End Proc
  1055. '
  1056. Rem               ** End **  
  1057. '