home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 326-350 / apd345 / evaluator.amos / evaluator.amosSourceCode < prev    next >
AMOS Source Code  |  1992-09-02  |  80KB  |  2,693 lines
  1. '
  2. Rem           *** Evaluator1200 ***  
  3. Rem      ***   Bill Currie 1991/93   *** 
  4. '
  5. Set Buffer 20
  6. Hot Spot 2,8,5
  7. Change Mouse 5
  8. '
  9. Global F$
  10. '
  11. Dim LQZ$(200),MITQZ$(70)
  12. Global LQZ$(),FLEQZ$,MITQZ$(),LLQZ$
  13. Global DRECTORYQZ$,MESSAGE1QZ$,MESSAGE2QZ$
  14. Global NQZ,XQZ,IQZ,CRQZ
  15. CRQZ=0
  16. '
  17. Rem                 ** End **  
  18. '
  19. '
  20. Rem AMOS copyright notice  
  21. AMOSC
  22. Procedure AMOSC
  23.    Screen Open 0,320,256,32,Lowres
  24.    Curs Off : Paper 0 : Cls 0 : Print 
  25.    Get Icon Palette 
  26.    Locate 0,1
  27.    Centre ">>> Program by Bill Currie <<<"
  28.    Flash Off : Colour 3,$FF0
  29.    Pen 3 : Ink 3 : Box 50,40 To 270,150
  30.    Locate 0,11
  31.    Centre Border$("Evaluator",1)
  32.    Ink 0 : Pen 2
  33.    Paste Icon 230,20,2
  34.    _SMALL_COPYRIGHT[225]
  35. End Proc
  36. Procedure _SMALL_COPYRIGHT[YDISPLAY]
  37.    '
  38.    Auto View Off 
  39.    '  
  40.    Screen Open 7,320,24,16,0 : Curs Off : Flash Off : Cls 0
  41.    Screen Display 7,,-100,,
  42.    Paste Bob 260,3,1
  43.    Paper 0 : Pen 7 : Print At(1,1);"This program was written using"
  44.    Get Sprite Palette 
  45.    View : Wait Vbl 
  46.    '
  47.    For Y=1 To Screen Height/2
  48.       Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2
  49.       Screen Offset 7,,Screen Height/2-Y
  50.       View : Wait Vbl 
  51.    Next 
  52.    '
  53.    Do 
  54.       If Mouse Key=1 Then Exit 
  55.    Loop 
  56.    '
  57.    For Y=Screen Height/2 To 0 Step -1
  58.       Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2
  59.       Screen Offset 7,,Screen Height/2-Y
  60.       View : Wait Vbl 
  61.    Next 
  62.    '
  63.    Screen Close 7
  64.    Auto View On 
  65.    '
  66. End Proc
  67. '
  68. INFO
  69. Procedure INFO
  70.    Cls 
  71.    Locate 0,10
  72.    Centre "Evaluator"
  73.    Print : Centre "***********"
  74.    Print : Print : Print : Print : Pen 1 : Centre "Other AMOS Program Disks available :"
  75.    Print : Print : Pen 3 : 
  76.    Centre "NoteBook: Loose-leaf Notebook "
  77.    Print : Centre "ScrapBook: Loose-leaf Scrapbook"
  78.    Locate 0,15
  79.    Do 
  80.       If Mouse Key=1 Then Exit 
  81.    Loop 
  82.    
  83. End Proc
  84. '
  85. Limit Mouse 
  86. '
  87. Dim K$(181)
  88. Global K$()
  89. Global TRY$
  90. 'Global X,N,I,TP,K1$ 
  91. X#=0 : Y#=0 : Z#=0 : T#=0
  92. X$=""
  93. SIGFIGS=0
  94. Goto BEGIN
  95. Rem                   ************************** 
  96. Rem                   *********  EVAL  ********* 
  97. Rem                   ************************** 
  98. '
  99. Rem                   By   Bill Currie - 1991/93 
  100. '
  101. Rem                Written with AMOS (Version 1.35)  
  102. '
  103. Rem Unfold USERHELP for information on Eval  
  104. '
  105. Procedure USERHELP
  106.    Rem
  107.    Rem   This program allows functions to be INPUT and EVALuated in an AMOS   
  108.    Rem  program, or used in an AMOS program. All letters from A to Z may be   
  109.    Rem  used as variables (case insensitive), allowing a total of 26  
  110.    Rem  variables (if required !)   
  111.    Rem
  112.    Rem   If X$ is a number as a string, and FV$ is a function of X  
  113.    Rem  then EVAL will work out EVAL$, the value of FV$ for X$.   
  114.    Rem
  115.    Rem   The program allows trigonometric functions etc. to be used.    
  116.    Rem
  117.    Rem   The program first replaces X$ by the corresponding number  
  118.    Rem  using the routine AZREPLACEVQ, and then procedes to work out EVAL$.       
  119.    Rem
  120.    Rem    EVAL has many uses where a function is required to be INPUT.  
  121.    Rem
  122.    Rem  Letters VQ are appended to EVAL Parameters to avoid program clashes.  
  123.    Rem
  124.    Rem               See the Simple Program.  
  125. End Proc
  126. '    
  127. Rem Unfold SIMPLEPROGRAM for example of usage
  128. '
  129. Procedure SIMPLEPROGRAM
  130.    Rem Remove Rem ' s for program   
  131.    Rem
  132.    Rem Screen Open 0,320,200,16,Lowres
  133.    Rem Global EVAL$,X$
  134.    Rem Degree 
  135.    Rem Do 
  136.    Rem    Input 'x = (* to finish) ';X$ 
  137.    Rem    If X$="*" Then Exit   
  138.    Rem    Input 'y = ';FUNCTION$  
  139.    Rem    Input 'Sig Figs (0 for none) ';SIGFIGS  
  140.    Rem
  141.    Rem    EVAL[FUNCTION$,SIGFIGS] 
  142.    Rem
  143.    Rem    Print 'y = ';EVAL$  
  144.    Rem    Print 'y = ';Param$ 
  145.    Rem    Print   
  146.    Rem Loop   
  147.    Rem End
  148. End Proc
  149. Rem
  150. Rem                        ****************  
  151. Rem ********************* Procedure for EVAL ***************************   
  152. '
  153. Rem  Global or Shared Variables (as used) :  Eval,Eval#,Eval$  
  154. Rem A to Z or A# to Z# or A$ to Z$   
  155. Rem  All Local Variables end in VQ to avoid program clashes  
  156. Rem  IDS$="" or "#" or "$" for Integer,Decimal or String Variables 
  157. Rem  FUNCTION$ is the function to be Evaluated 
  158. Rem  SIGFIGS is the accuracy 'worked to' (Significant Figures),0 for none.   
  159. '
  160. Rem  The procedure has (obviously?) been folded !  
  161. '
  162. Procedure EVAL[IDS$,FUNCTION$,SIGFIGS]
  163.    On Error Goto ER
  164.    Goto OK
  165.    ER:
  166.    EVAL$="Error"
  167.    Resume XITC
  168.    OK:
  169.    Shared EVAL,EVAL#,EVAL$
  170.    Rem All Local Variables and Labels end in VQ 
  171.    If IDS$="$"
  172.       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$
  173.       AVQVQ$=A$ : BVQVQ$=B$ : CVQVQ$=C$ : DVQVQ$=D$ : EVQVQ$=E$ : FVQVQ$=F$ : GVQVQ$=G$
  174.       HVQVQ$=H$ : IVQVQ$=I$ : JVQVQ$=J$ : KVQVQ$=K$ : LVQVQ$=L$ : MVQVQ$=M$
  175.       NVQVQ$=N$ : OVQVQ$=O$ : PVQVQ$=P$ : QVQVQ$=Q$ : RVQVQ$=R$ : SVQVQ$=S$ : TVQVQ$=T$
  176.       UVQVQ$=U$ : VVQVQ$=V$ : WVQVQ$=W$ : XVQVQ$=X$ : YVQVQ$=Y$ : ZVQVQ$=Z$
  177.    End If 
  178.    If IDS$="#"
  179.       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#
  180.       AVQVQ$=Str$(A#) : BVQVQ$=Str$(B#) : CVQVQ$=Str$(C#) : DVQVQ$=Str$(D#) : EVQVQ$=Str$(E#) : FVQVQ$=Str$(F#) : GVQVQ$=Str$(G#)
  181.       HVQVQ$=Str$(H#) : IVQVQ$=Str$(I#) : JVQVQ$=Str$(J#) : KVQVQ$=Str$(K#) : LVQVQ$=Str$(L#) : MVQVQ$=Str$(M#)
  182.       NVQVQ$=Str$(N#) : OVQVQ$=Str$(O#) : PVQVQ$=Str$(P#) : QVQVQ$=Str$(Q#) : RVQVQ$=Str$(R#) : SVQVQ$=Str$(S#) : TVQVQ$=Str$(T#)
  183.       UVQVQ$=Str$(U#) : VVQVQ$=Str$(V#) : WVQVQ$=Str$(W#) : XVQVQ$=Str$(X#) : YVQVQ$=Str$(Y#) : ZVQVQ$=Str$(Z#)
  184.    End If 
  185.    If IDS$=""
  186.       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
  187.       AVQVQ$=Str$(A) : BVQVQ$=Str$(B) : CVQVQ$=Str$(C) : DVQVQ$=Str$(D) : EVQVQ$=Str$(E) : FVQVQ$=Str$(F) : GVQVQ$=Str$(G)
  188.       HVQVQ$=Str$(H) : IVQVQ$=Str$(I) : JVQVQ$=Str$(J) : KVQVQ$=Str$(K) : LVQVQ$=Str$(L) : MVQVQ$=Str$(M)
  189.       NVQVQ$=Str$(N) : OVQVQ$=Str$(O) : PVQVQ$=Str$(P) : QVQVQ$=Str$(Q) : RVQVQ$=Str$(R) : SVQVQ$=Str$(S) : TVQVQ$=Str$(T)
  190.       UVQVQ$=Str$(U) : VVQVQ$=Str$(V) : WVQVQ$=Str$(W) : XVQVQ$=Str$(X) : YVQVQ$=Str$(Y) : ZVQVQ$=Str$(Z)
  191.    End If 
  192.    FVQ$=FUNCTION$
  193.    Gosub EVALLVQ
  194.    EVAL$=EVAL$
  195.    Goto XITC
  196.    EVALLVQ:
  197.    GVQ$="" : HVQ$="" : EVAL$=""
  198.    KEEPFVQ$=FVQ$ : KEEPGVQ$=GVQ$ : KEEPHVQ$=HVQ$
  199.    FVQ$=Upper$(FVQ$)
  200.    FVQ$="dummy"+FVQ$+"dummy"
  201.    Gosub SPACEREPLACEVQ
  202.    Gosub PIREPLACEVQ
  203.    Gosub AZREPLACEVQ
  204.    Do 
  205.       Gosub BRACKETSVQ
  206.       If GVQ$="Error" Then Exit 
  207.       Exit If FVQ$='end'
  208.       Gosub ARITHVQ
  209.       If GVQ$="Error" Then Exit 
  210.       Gosub TRIGVQ
  211.       If GVQ$="Error" Then Exit 
  212.    Loop 
  213.    '
  214.    Rem Avoid two .'s or two E's 
  215.    If Instr(Mid$(GVQ$,Instr(GVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  216.    If Instr(Mid$(GVQ$,Instr(GVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  217.    'If(Instr(GVQ$,"E")>0) and(Instr("123456789",Mid$(GVQ$,Instr(GVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  218.    '
  219.    If GVQ$="Error" Then EVAL$="Error" : Goto XITC
  220.    '
  221.    Rem Insert a space in front of an E
  222.    '
  223.    IVQ=Instr(GVQ$,"E")
  224.    If IVQ=0 Then Goto OKEVAL
  225.    GVQ$=Left$(GVQ$,IVQ-1)+" "+Mid$(GVQ$,IVQ)
  226.    OKEVAL:
  227.    '
  228.    Rem -0 is not really required as an answer 
  229.    If GVQ$="-0" Then GVQ$="0"
  230.    '
  231.    FINALCHECK:
  232.    IVQ=0
  233.    Do 
  234.       IVQ=IVQ+1
  235.       If IVQ>Len(GVQ$) Then Exit 
  236.       If Instr(" 1234567890.E+-",Mid$(GVQ$,IVQ,1))=0 Then GVQ$="Error" : Exit 
  237.    Loop 
  238.    '
  239.    Gosub ROUNDINGVQ
  240.    '
  241.    EVAL$=GVQ$
  242.    '
  243.    FVQ$=KEEPFVQ$ : GVQ$=KEEPGVQ$ : HVQ$=KEEPHVQ$
  244.    '
  245.    Return 
  246.    ROUNDINGVQ:
  247.    MARKERVQ=0
  248.    NVQ=Int(SIGFIGS)
  249.    If(NVQ<=0) or(GVQ$="0") Then Gosub ROUNDVQ : Goto XIT3
  250.    '
  251.    Rem Remove Tail End
  252.    IVQ=Instr(GVQ$," E")
  253.    FVQ$=GVQ$ : HVQ$=""
  254.    If IVQ<>0 Then FVQ$=Left$(GVQ$,IVQ-1) : HVQ$=Mid$(GVQ$,IVQ)
  255.    '
  256.    Rem Get any - sign 
  257.    SVQ$=""
  258.    If Left$(FVQ$,1)="-" Then SVQ$="-" : FVQ$=Mid$(FVQ$,2)
  259.    '
  260.    Rem Remove D.Pt. 
  261.    IVQ=Instr(FVQ$,".")
  262.    If IVQ<>0 Then FVQ$=Left$(FVQ$,IVQ-1)+Mid$(FVQ$,IVQ+1)
  263.    '
  264.    Rem Remove leading zeros 
  265.    KVQ=0
  266.    Do 
  267.       If Left$(FVQ$,1)<>"0" Then Exit 
  268.       FVQ$=Mid$(FVQ$,2)
  269.       Inc KVQ
  270.    Loop 
  271.    '
  272.    Rem MARKERVQ=0 
  273.    LVQ=Len(FVQ$)
  274.    If LVQ<=NVQ Then Goto XIT
  275.    Rem Chop off unwanted end
  276.    FVQ$=Left$(FVQ$,NVQ+1)
  277.    If Instr("01234",Right$(FVQ$,1))<>0 Then FVQ$=Left$(FVQ$,NVQ) : Goto XIT
  278.    FVQ$=Left$(FVQ$,NVQ) : JVQ=0
  279.    Do 
  280.       If Right$(FVQ$,1)=Chr$(48+JVQ) Then FVQ$=Left$(FVQ$,NVQ-1)+Chr$(48+JVQ+1) : Goto XIT
  281.       Inc JVQ
  282.       If JVQ=9 Then Exit 
  283.    Loop 
  284.    Rem Two 9's at end 
  285.    JVQ=1
  286.    Do 
  287.       If Mid$(FVQ$,NVQ-JVQ,1)<>"9" Then FVQ$=Left$(FVQ$,NVQ-JVQ-1)+Chr$(Asc(Mid$(FVQ$,NVQ-JVQ,1))+1) : Goto XIT
  288.       Inc JVQ
  289.       If JVQ=NVQ Then Exit 
  290.    Loop 
  291.    FVQ$="1"+String$("0",LVQ) : MARKERVQ=1
  292.    XIT:
  293.    If MARKERVQ=0 Then FVQ$=FVQ$+String$("0",LVQ-Len(FVQ$))
  294.    Rem Replace leading zeros
  295.    FVQ$=String$("0",KVQ)+FVQ$
  296.    Rem Replace D.Pt.
  297.    If IVQ=0 Then Goto XIT2
  298.    If MARKERVQ=0 Then FVQ$=Left$(FVQ$,IVQ-1)+"."+Mid$(FVQ$,IVQ)
  299.    If MARKERVQ=1 Then FVQ$=Left$(FVQ$,IVQ)+"."+Mid$(FVQ$,IVQ+1)
  300.    MARKERVQ=0
  301.    Rem Remove unwanted zeros at right 
  302.    Do 
  303.       If Right$(FVQ$,1)<>"0" Then Exit 
  304.       If Right$(FVQ$,2)=".0" Then Exit 
  305.       FVQ$=Left$(FVQ$,Len(FVQ$)-1)
  306.    Loop 
  307.    XIT2:
  308.    GVQ$=FVQ$+HVQ$
  309.    Rem Remove unwanted zeros at left
  310.    Do 
  311.       If Left$(GVQ$,1)<>"0" Then Exit 
  312.       If Left$(GVQ$,2)="0." Then Exit 
  313.       GVQ$=Right$(GVQ$,Len(GVQ$)-1)
  314.    Loop 
  315.    Rem Replace sign 
  316.    GVQ$=SVQ$+GVQ$
  317.    XIT3:
  318.    Return 
  319.    ROUNDVQ:
  320.    Rem Rounding 
  321.    '
  322.    IVQ=Instr(GVQ$," E")
  323.    FVQ$=GVQ$ : HVQ$=""
  324.    If IVQ<>0 Then FVQ$=Left$(GVQ$,IVQ-1) : HVQ$=Mid$(GVQ$,IVQ)
  325.    '
  326.    IVQ=Instr(FVQ$,".")
  327.    AVQ$=FVQ$
  328.    If IVQ<>0 Then AVQ$=Left$(FVQ$,IVQ-1)+Mid$(FVQ$,IVQ+1)
  329.    Rem Primitive rounding for eg .98! ,default - number of significant figures unspecified
  330.    KVQ=Len(AVQ$)
  331.    If KVQ<6 Then Goto XITB
  332.    If Right$(AVQ$,6)="899999" Then AVQ$=Left$(AVQ$,KVQ-6)+"900000"
  333.    If Right$(AVQ$,6)="799999" Then AVQ$=Left$(AVQ$,KVQ-6)+"800000"
  334.    If Right$(AVQ$,6)="699999" Then AVQ$=Left$(AVQ$,KVQ-6)+"700000"
  335.    If Right$(AVQ$,6)="599999" Then AVQ$=Left$(AVQ$,KVQ-6)+"600000"
  336.    If Right$(AVQ$,6)="499999" Then AVQ$=Left$(AVQ$,KVQ-6)+"500000"
  337.    If Right$(AVQ$,6)="399999" Then AVQ$=Left$(AVQ$,KVQ-6)+"400000"
  338.    If Right$(AVQ$,6)="299999" Then AVQ$=Left$(AVQ$,KVQ-6)+"300000"
  339.    If Right$(AVQ$,6)="199999" Then AVQ$=Left$(AVQ$,KVQ-6)+"200000"
  340.    If Right$(AVQ$,6)="099999" Then AVQ$=Left$(AVQ$,KVQ-6)+"100000"
  341.    If Right$(AVQ$,6)="899998" Then AVQ$=Left$(AVQ$,KVQ-6)+"900000"
  342.    If Right$(AVQ$,6)="799998" Then AVQ$=Left$(AVQ$,KVQ-6)+"800000"
  343.    If Right$(AVQ$,6)="699998" Then AVQ$=Left$(AVQ$,KVQ-6)+"700000"
  344.    If Right$(AVQ$,6)="599998" Then AVQ$=Left$(AVQ$,KVQ-6)+"600000"
  345.    If Right$(AVQ$,6)="499998" Then AVQ$=Left$(AVQ$,KVQ-6)+"500000"
  346.    If Right$(AVQ$,6)="399998" Then AVQ$=Left$(AVQ$,KVQ-6)+"400000"
  347.    If Right$(AVQ$,6)="299998" Then AVQ$=Left$(AVQ$,KVQ-6)+"300000"
  348.    If Right$(AVQ$,6)="199998" Then AVQ$=Left$(AVQ$,KVQ-6)+"200000"
  349.    If Right$(AVQ$,6)="299998" Then AVQ$=Left$(AVQ$,KVQ-6)+"100000"
  350.    If Right$(AVQ$,6)="199998" Then AVQ$=Left$(AVQ$,KVQ-6)+"200000"
  351.    If Right$(AVQ$,6)="099998" Then AVQ$=Left$(AVQ$,KVQ-6)+"100000"
  352.    If IVQ=0 Then FVQ$=AVQ$ : Goto XIT2A
  353.    FVQ$=Left$(AVQ$,IVQ-1)+"."+Mid$(AVQ$,IVQ)
  354.    Do 
  355.       If Right$(FVQ$,1)<>"0" Then Exit 
  356.       If Right$(FVQ$,2)=".0" Then Exit 
  357.       FVQ$=Left$(FVQ$,Len(FVQ$)-1)
  358.    Loop 
  359.    XIT2A:
  360.    GVQ$=FVQ$+HVQ$
  361.    Rem Remove unwanted zeros at left
  362.    Do 
  363.       If Left$(GVQ$,1)<>"0" Then Exit 
  364.       If Left$(GVQ$,2)="0." Then Exit 
  365.       GVQ$=Right$(GVQ$,Len(GVQ$)-1)
  366.    Loop 
  367.    XITB:
  368.    Return 
  369.    SPACEREPLACEVQ:
  370.    Do 
  371.       IVQ=Instr(FVQ$," ")
  372.       If IVQ=0 Then Exit 
  373.       FVQ$=Left$(FVQ$,IVQ-1)+Right$(FVQ$,Len(FVQ$)-IVQ)
  374.    Loop 
  375.    Return 
  376.    PIREPLACEVQ:
  377.    Do 
  378.       IVQ=Instr(FVQ$,'PI')
  379.       Exit If IVQ=0
  380.       FVQ$=Left$(FVQ$,IVQ-1)+Str$(Pi#)+Mid$(FVQ$,IVQ+2)
  381.    Loop 
  382.    Return 
  383.    AZREPLACEVQ:
  384.    '
  385.    Rem Functions to lower case
  386.    '
  387.    Restore NWDT
  388.    For JVQ=1 To 19
  389.       Read AVQ$
  390.       BVQ$=Lower$(AVQ$)
  391.       L=Len(AVQ$)
  392.       Do 
  393.          IVQ=Instr(FVQ$,AVQ$)
  394.          If IVQ=0 Then Exit 
  395.          FVQ$=Left$(FVQ$,IVQ-1)+BVQ$+Mid$(FVQ$,IVQ+L)
  396.       Loop 
  397.    Next JVQ
  398.    '
  399.    Rem Replace upper case letters by 'numbers'
  400.    For JVQ=65 To 90
  401.       Read XVQ$
  402.       '
  403.       If Instr(FVQ$,Chr$(JVQ))<>0
  404.          For IVQ=1 To Len(XVQ$)
  405.             If Instr("0123456789+-*/^eE. ",Mid$(XVQ$,IVQ,1))=0
  406.                EVAL$="Error" : Goto XITC
  407.             End If 
  408.          Next IVQ
  409.       End If 
  410.       '
  411.       If(Instr(XVQ$,".")=0) and(Instr(XVQ$,"e")=0) and(Instr(XVQ$,"E")=0) and Len(XVQ$)>10 Then XVQ$=XVQ$+".0"
  412.       '
  413.       Do 
  414.          XINVQ$=XVQ$
  415.          IVQ=Instr(FVQ$,Chr$(JVQ))
  416.          If IVQ=0 Then Exit 
  417.          For J2VQ=48 To 57
  418.             If Mid$(FVQ$,IVQ+1,1)=Chr$(J2VQ) Then EVAL$="Error" : Goto XITC
  419.          Next J2VQ
  420.          If Mid$(FVQ$,IVQ+1,1)="." Then EVAL$="Error" : Goto XITC
  421.          For J2VQ=48 To 57
  422.             If Mid$(FVQ$,IVQ-1,1)=Chr$(J2VQ) Then XINVQ$="*"+XINVQ$
  423.          Next J2VQ
  424.          If Mid$(FVQ$,IVQ-1,1)="." Then XINVQ$="*"+XINVQ$
  425.          For J2VQ=65 To 90
  426.             If Mid$(FVQ$,IVQ-1,1)=Chr$(J2VQ) Then XINVQ$="*"+XINVQ$
  427.          Next J2VQ
  428.          For J2VQ=65 To 90
  429.             If Mid$(FVQ$,IVQ+1,1)=Chr$(J2VQ) Then XINVQ$=XINVQ$+"*"
  430.          Next J2VQ
  431.          Rem pi   
  432.          If Mid$(FVQ$,IVQ+1,1)=" " Then XINVQ$=XINVQ$+"*"
  433.          '
  434.          FVQ$=Left$(FVQ$,IVQ-1)+XINVQ$+Mid$(FVQ$,IVQ+1)
  435.       Loop 
  436.    Next JVQ
  437.    '
  438.    FVQ$=Upper$(FVQ$)
  439.    '
  440.    NWDT:
  441.    Data "ASIN","ACOS","ATAN","HSIN","HCOS","HTAN","SINH","COSH","TANH"
  442.    Data "SIN","COS","TAN","LOG","EXP","SQR","ABS","INT","SGN","LN"
  443.    Data AVQVQ$,BVQVQ$,CVQVQ$,DVQVQ$,EVQVQ$
  444.    Data FVQVQ$,GVQVQ$,HVQVQ$,IVQVQ$,JVQVQ$
  445.    Data KVQVQ$,LVQVQ$,MVQVQ$,NVQVQ$,OVQVQ$
  446.    Data PVQVQ$,QVQVQ$,RVQVQ$,SVQVQ$,TVQVQ$
  447.    Data UVQVQ$,VVQVQ$,WVQVQ$,XVQVQ$,YVQVQ$,ZVQVQ$
  448.    '
  449.    Return 
  450.    BRACKETSVQ:
  451.    IVQ=Instr(FVQ$,')')
  452.    If IVQ=0 Then GVQ$=Mid$(FVQ$,6,(Len(FVQ$)-10)) : FVQ$='end' : HVQ$='end' : Gosub ARITHVQ : Goto FINBR
  453.    HVQ$=Mid$(FVQ$,IVQ+1) : FVQ$=Left$(FVQ$,IVQ-1)
  454.    '''''''''''''' 
  455.    If Instr("0123456789. ",Left$(HVQ$,1))<>0 Then EVAL$="Error" : Goto XITC
  456.    '''''''''''''' 
  457.    JVQ=0
  458.    Do 
  459.       JVQ=JVQ+1
  460.       IVQ=Instr(Right$(FVQ$,JVQ),"(")
  461.       If IVQ<>0 Then Exit 
  462.       If JVQ=Len(FVQ$) Then GVQ$="Error" : Goto FINBR
  463.    Loop 
  464.    GVQ$=Mid$(FVQ$,Len(FVQ$)-JVQ+2) : FVQ$=Left$(FVQ$,Len(FVQ$)-JVQ)
  465.    FINBR:
  466.    Return 
  467.    ARITHVQ:
  468.    Gosub POWERSVQ
  469.    Gosub COMPRESS_SIGNSVQ
  470.    Gosub MULT_DIVVQ
  471.    If GVQ$="error" Then Goto ARERR
  472.    Gosub COMPRESS_SIGNSVQ
  473.    Gosub AD_SUBVQ
  474.    Gosub COMPRESS_SIGNSVQ
  475.    ARERR:
  476.    Return 
  477.    SPACEREMOVEVQ:
  478.    Do 
  479.       IVQ=Instr(GVQ$," ")
  480.       If IVQ=0 Then Exit 
  481.       GVQ$=Left$(GVQ$,IVQ-1)+Right$(GVQ$,Len(GVQ$)-IVQ)
  482.    Loop 
  483.    Return 
  484.    TRIGVQ:
  485.    On Error Goto ERROUTINE
  486.    IVQ=Len(FVQ$) : CVQ#=Val(GVQ$)
  487.    DUMMYVQ$=Right$(FVQ$,1) : If Instr('+-*/^(Y',DUMMYVQ$)<>0 Then Goto NEWFX
  488.    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
  489.    DUMMYVQ$=Right$(FVQ$,4) : If DUMMYVQ$='ACOS' Then CVQ#=Acos(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-4) : Goto NEWFX2
  490.    DUMMYVQ$=Right$(FVQ$,4) : If DUMMYVQ$='ATAN' Then CVQ#=Atan(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-4) : Goto NEWFX2
  491.    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
  492.    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
  493.    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
  494.    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
  495.    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
  496.    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
  497.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='SIN' Then CVQ#=Sin(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  498.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='COS' Then CVQ#=Cos(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  499.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='TAN' Then CVQ#=Tan(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  500.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='LOG' Then CVQ#=Log(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  501.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='EXP' Then CVQ#=Exp(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  502.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='SQR' Then CVQ#=Sqr(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  503.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='ABS' Then CVQ#=Abs(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  504.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='INT' Then CVQ#=Int(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  505.    DUMMYVQ$=Right$(FVQ$,3) : If DUMMYVQ$='SGN' Then CVQ#=Sgn(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-3) : Goto NEWFX2
  506.    DUMMYVQ$=Right$(FVQ$,2) : If DUMMYVQ$='LN' Then CVQ#=Ln(CVQ#) : SVQ$=Str$(CVQ#) : GVQ$=SVQ$ : FVQ$=Left$(FVQ$,IVQ-2) : Goto NEWFX2
  507.    NEWFX2:
  508.    DUMMYVQ$=Right$(FVQ$,1)
  509.    If Instr('+-*/^(Y',DUMMYVQ$)<>0 Then Goto NEWFX
  510.    FVQ$=FVQ$+"*"
  511.    NEWFX:
  512.    FVQ$=FVQ$+GVQ$+HVQ$
  513.    Goto NERR
  514.    ERROUTINE:
  515.    GVQ$="Error"
  516.    Resume NERR
  517.    NERR:
  518.    Return 
  519.    POWERSVQ:
  520.    POWERTEST:
  521.    Gosub SPACEREMOVEVQ
  522.    IVQ=Instr(GVQ$,'^')
  523.    If IVQ=0 Then Goto NPRS
  524.    Rem g$ = lef1vq$ + lefvq$ ^ rigvq$ +rig1vq$  
  525.    Rem first get rid of any first sequences of +'s or -'s after the ^ 
  526.    FULLRVQ$=Right$(GVQ$,Len(GVQ$)-IVQ)
  527.    Do 
  528.       If Left$(FULLRVQ$,1)="+" Then FULLRVQ$=Mid$(FULLRVQ$,2) : Goto RETRY1
  529.       If Len(FULLRVQ$)>1 Then If Left$(FULLRVQ$,2)="--" Then FULLRVQ$=Mid$(FULLRVQ$,3) : Goto RETRY1
  530.       If Len(FULLRVQ$)>1 Then If Left$(FULLRVQ$,2)="-+" Then FULLRVQ$="-"+Mid$(FULLRVQ$,3) : Goto RETRY1
  531.       Exit 
  532.       RETRY1:
  533.    Loop 
  534.    GVQ$=Left$(GVQ$,IVQ)+FULLRVQ$
  535.    Rem ****** 
  536.    Rem get right hand side
  537.    Rem remember ^ is at position ivq
  538.    JVQ=IVQ+1
  539.    RIGVQ$=Mid$(GVQ$,JVQ,1)
  540.    Do 
  541.       If JVQ=Len(GVQ$) Then Exit 
  542.       JVQ=JVQ+1
  543.       DUMMYVQ$=Mid$(GVQ$,JVQ,1) : DUMMY1VQ$=Mid$(GVQ$,JVQ-1,1)
  544.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto RETRY2
  545.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto RETRY2
  546.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto RETRY2
  547.       Exit 
  548.       RETRY2:
  549.    Loop 
  550.    Rem Avoid two .'s or two E's 
  551.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  552.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  553.    'If(Instr(RIGVQ$,"E")>0) and(Instr("123456789",Mid$(RIGVQ$,Instr(RIGVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  554.    If JVQ=Len(GVQ$) Then RIG1VQ$='' : Else RIG1VQ$=Mid$(GVQ$,JVQ)
  555.    '
  556.    Rem Now get the left hand side 
  557.    Rem Remember ^ is still at position ivq
  558.    Rem Use KVQ this time, instead of JVQ
  559.    Rem The left hand side should be easier
  560.    KVQ=IVQ-1
  561.    LEFVQ$=Mid$(GVQ$,KVQ,1)
  562.    Do 
  563.       KVQ=KVQ-1
  564.       Exit If KVQ=0
  565.       DUMMYVQ$=Mid$(GVQ$,KVQ,1)
  566.       DUMMY1VQ$=""
  567.       If KVQ>1 Then DUMMY1VQ$=Mid$(GVQ$,KVQ-1,1)
  568.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto RETRY3
  569.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto RETRY3
  570.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto RETRY3
  571.       If DUMMYVQ$="-" Then If DUMMY1VQ$="+" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : KVQ=KVQ-1 : Exit 
  572.       If DUMMYVQ$="-" Then If DUMMY1VQ$="-" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : KVQ=KVQ-1 : Exit 
  573.       If DUMMYVQ$="-" Then If DUMMY1VQ$="" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : KVQ=KVQ-1 : Exit 
  574.       Exit 
  575.       RETRY3:
  576.    Loop 
  577.    Rem Avoid two .'s or two E's 
  578.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  579.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  580.    'If(Instr(LEFVQ$,"E")>0) and(Instr("123456789",Mid$(LEFVQ$,Instr(LEFVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  581.    If KVQ=0 Then LEF1VQ$='' : Else LEF1VQ$=Mid$(GVQ$,1,KVQ) : 
  582.    Rem *****
  583.    LLVQ#=Val(LEFVQ$) : RRVQ#=Val(RIGVQ$)
  584.    If(Abs(LLVQ#)<>LLVQ#) and(RRVQ#<>Int(RRVQ#)) Then EVAL$="Error" : Goto XITC
  585.    MIVQ#=LLVQ#^RRVQ#
  586.    '
  587.    Rem Try -1^5 in AMOS? Are odd powers of - nos OK? Assumed not! 
  588.    Rem If Left$(LEFVQ$,1)="-" and 2*Int(RRVQ#/2)<>RRVQ# and RRVQ#=Int(RRVQ#) Then MIDDVQ$="-"+Mid$(MIDDVQ$,2)               
  589.    Rem Possible correction for powers that are odd integers. Leave??! Unsure! Making matters worse ?  
  590.    Rem I don't like this. However...?Complex Numbers?... ... ...
  591.    Rem Look at later. See line two from here !  
  592.    '
  593.    MIDDVQ$=Str$(MIVQ#)
  594.    '
  595.    If Left$(LEFVQ$,1)="-" and 2*Int(RRVQ#/2)<>RRVQ# and RRVQ#=Int(RRVQ#) Then MIDDVQ$="-"+Mid$(MIDDVQ$,2)
  596.    '
  597.    If Left$(MIDDVQ$,1)<>"-" Then MIDDVQ$=Mid$(MIDDVQ$,2) : Rem NB Removing a space
  598.    GVQ$=LEF1VQ$+MIDDVQ$+RIG1VQ$
  599.    Goto POWERTEST
  600.    NPRS:
  601.    Return 
  602.    PPREMOVEVQ:
  603.    Do 
  604.       IVQ=Instr(GVQ$,"++")
  605.       If IVQ=0 Then Exit 
  606.       GVQ$=Left$(GVQ$,IVQ-1)+"+"+Mid$(GVQ$,IVQ+2)
  607.       PMVQ$="Y"
  608.    Loop 
  609.    Return 
  610.    PMREMOVEVQ:
  611.    Do 
  612.       IVQ=Instr(GVQ$,"+-")
  613.       If IVQ=0 Then Exit 
  614.       GVQ$=Left$(GVQ$,IVQ-1)+"-"+Mid$(GVQ$,IVQ+2)
  615.       PMVQ$="Y"
  616.    Loop 
  617.    Return 
  618.    MPREMOVEVQ:
  619.    Do 
  620.       IVQ=Instr(GVQ$,"-+")
  621.       If IVQ=0 Then Exit 
  622.       GVQ$=Left$(GVQ$,IVQ-1)+"-"+Mid$(GVQ$,IVQ+2)
  623.       PMVQ$="Y"
  624.    Loop 
  625.    Return 
  626.    MMREMOVEVQ:
  627.    Do 
  628.       IVQ=Instr(GVQ$,"--")
  629.       If IVQ=0 Then Exit 
  630.       GVQ$=Left$(GVQ$,IVQ-1)+"+"+Mid$(GVQ$,IVQ+2)
  631.       PMVQ$="Y"
  632.    Loop 
  633.    Return 
  634.    COMPRESS_SIGNSVQ:
  635.    Do 
  636.       PMVQ$="N"
  637.       Gosub PPREMOVEVQ
  638.       Gosub PMREMOVEVQ
  639.       Gosub MPREMOVEVQ
  640.       Gosub MMREMOVEVQ
  641.       If PMVQ$="N" Then Exit 
  642.    Loop 
  643.    Return 
  644.    MULT_DIVVQ:
  645.    On Error Goto ERROUTINEMD
  646.    LEFTMOSTMD:
  647.    Gosub SPACEREMOVEVQ
  648.    IVQ=Instr(GVQ$,'*')
  649.    IIVQ=Instr(GVQ$,'/')
  650.    If IIVQ>1 and(IIVQ<IVQ or IVQ=0) Then IVQ=IIVQ : LVQ$="/" : Goto WORKOUT1
  651.    If IVQ>1 Then LVQ$="*" : Goto WORKOUT1
  652.    Goto NMRMD
  653.    WORKOUT1:
  654.    Rem gv$ = lef1vq$   lefvq$ # rigvq$   rig1vq$  , where # is * or / 
  655.    Rem find right number
  656.    JVQ=IVQ+1
  657.    RIGVQ$=Mid$(GVQ$,JVQ,1)
  658.    Do 
  659.       If JVQ=Len(GVQ$) Then Exit 
  660.       JVQ=JVQ+1
  661.       DUMMYVQ$=Mid$(GVQ$,JVQ,1) : DUMMY1VQ$=Mid$(GVQ$,JVQ-1,1)
  662.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON
  663.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON
  664.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON
  665.       Exit 
  666.       KEEP_ON:
  667.    Loop 
  668.    Rem Avoid two .'s or two E's 
  669.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  670.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  671.    'If(Instr(RIGVQ$,"E")>0) and(Instr("123456789",Mid$(RIGVQ$,Instr(RIGVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  672.    If JVQ=Len(GVQ$) Then RIG1VQ$='' : Else RIG1VQ$=Mid$(GVQ$,JVQ)
  673.    Rem ********** 
  674.    Rem Find left number 
  675.    KVQ=IVQ-1
  676.    LEFVQ$=Mid$(GVQ$,KVQ,1)
  677.    Do 
  678.       KVQ=KVQ-1
  679.       Exit If KVQ=0
  680.       DUMMYVQ$=Mid$(GVQ$,KVQ,1)
  681.       DUMMY1VQ$=""
  682.       If KVQ-1>0 Then DUMMY1VQ$=Mid$(GVQ$,KVQ-1,1)
  683.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK
  684.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK
  685.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK
  686.       Exit 
  687.       REWORK:
  688.    Loop 
  689.    Rem Avoid two .'s or two E's 
  690.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  691.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  692.    'If(Instr(LEFVQ$,"E")>0) and(Instr("123456789",Mid$(LEFVQ$,Instr(LEFVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  693.    If KVQ=0 Then LEF1VQ$='' : Else LEF1VQ$=Mid$(GVQ$,1,KVQ)
  694.    Rem
  695.    Rem now work out lef1vq$ lefvq$ # rigvq$ rig1vq$ 
  696.    Rem
  697.    LLVQ#=Val(LEFVQ$) : RRVQ#=Val(RIGVQ$)
  698.    If LVQ$="*" Then MIVQ#=LLVQ#*RRVQ#
  699.    If LVQ$="/" Then MIVQ#=LLVQ#/RRVQ#
  700.    MIDDVQ$=Str$(MIVQ#)
  701.    If Left$(MIDDVQ$,1)<>"-" Then MIDDVQ$=Right$(MIDDVQ$,Len(MIDDVQ$)-1) : Rem NB Removing a space  
  702.    GVQ$=LEF1VQ$+MIDDVQ$+RIG1VQ$
  703.    Goto LEFTMOSTMD
  704.    Rem
  705.    NMRMD:
  706.    Goto NERRMD
  707.    ERROUTINEMD:
  708.    GVQ$="Error"
  709.    Resume NERRMD
  710.    NERRMD:
  711.    Return 
  712.    AD_SUBVQ:
  713.    LEFTMOSTADSUB:
  714.    Gosub SPACEREMOVEVQ
  715.    Gosub COMPRESS_SIGNSVQ
  716.    '
  717.    Rem Avoiding E+
  718.    Do 
  719.       I2VQ=Instr(GVQ$,"E+")
  720.       If I2VQ=0 Then Exit 
  721.       GVQ$=Left$(GVQ$,I2VQ-1)+"EE"+Mid$(GVQ$,I2VQ+2)
  722.    Loop 
  723.    '
  724.    Rem Avoid possible initial - sign, starting from 2nd character 
  725.    IVQ=Instr(Mid$(GVQ$,2),'+')
  726.    '
  727.    Rem Now replacing E+ 
  728.    Do 
  729.       I2VQ=Instr(GVQ$,"EE")
  730.       If I2VQ=0 Then Exit 
  731.       GVQ$=Left$(GVQ$,I2VQ-1)+"E+"+Mid$(GVQ$,I2VQ+2)
  732.    Loop 
  733.    Rem Having avoided E+ now continue 
  734.    '
  735.    Rem Avoiding E-
  736.    Do 
  737.       I2VQ=Instr(GVQ$,"E-")
  738.       If I2VQ=0 Then Exit 
  739.       GVQ$=Left$(GVQ$,I2VQ-1)+"EE"+Mid$(GVQ$,I2VQ+2)
  740.    Loop 
  741.    '
  742.    Rem Avoid possible initial - sign, starting from 2nd character 
  743.    IIVQ=Instr(Mid$(GVQ$,2),'-')
  744.    '
  745.    Rem Now replacing E- 
  746.    Do 
  747.       I2VQ=Instr(GVQ$,"EE")
  748.       If I2VQ=0 Then Exit 
  749.       GVQ$=Left$(GVQ$,I2VQ-1)+"E-"+Mid$(GVQ$,I2VQ+2)
  750.    Loop 
  751.    Rem Having avoided E- now continue 
  752.    '
  753.    Rem Find which is leftmost, + or - 
  754.    '
  755.    If IIVQ>0 and(IIVQ<IVQ or IVQ=0) Then IVQ=IIVQ : LVQ$="-" : Goto WORKOUT2
  756.    If IVQ>0 Then LVQ$="+" : Goto WORKOUT2
  757.    Goto NMRADSUB
  758.    '
  759.    WORKOUT2:
  760.    Rem Remember to adjust IVQ since search began with 2nd item  
  761.    IVQ=IVQ+1
  762.    Rem gvq$ = lef1vq$   lefvq$ # rigvq$   rig1vq$  , where # is + or -  
  763.    Rem find right number
  764.    JVQ=IVQ+1
  765.    RIGVQ$=Mid$(GVQ$,JVQ,1)
  766.    Do 
  767.       If JVQ=Len(GVQ$) Then Exit 
  768.       JVQ=JVQ+1
  769.       DUMMYVQ$=Mid$(GVQ$,JVQ,1) : DUMMY1VQ$=Mid$(GVQ$,JVQ-1,1)
  770.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON2
  771.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON2
  772.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then RIGVQ$=RIGVQ$+DUMMYVQ$ : Goto KEEP_ON2
  773.       Exit 
  774.       KEEP_ON2:
  775.    Loop 
  776.    Rem Avoid two .'s or two E's 
  777.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  778.    If Instr(Mid$(RIGVQ$,Instr(RIGVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  779.    'If(Instr(RIGVQ$,"E")>0) and(Instr("123456789",Mid$(RIGVQ$,Instr(RIGVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  780.    If JVQ=Len(GVQ$) Then RIG1VQ$='' : Else RIG1VQ$=Mid$(GVQ$,JVQ)
  781.    Rem ********** 
  782.    Rem Find left number 
  783.    KVQ=IVQ-1
  784.    LEFVQ$=Mid$(GVQ$,KVQ,1)
  785.    Do 
  786.       KVQ=KVQ-1
  787.       Exit If KVQ=0
  788.       DUMMYVQ$=Mid$(GVQ$,KVQ,1)
  789.       DUMMY1VQ$=""
  790.       If KVQ-1>0 Then DUMMY1VQ$=Mid$(GVQ$,KVQ-1,1)
  791.       If Instr("0123456789.E",DUMMYVQ$)<>0 Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK2
  792.       If DUMMYVQ$="-" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK2
  793.       If DUMMYVQ$="+" Then If DUMMY1VQ$="E" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : Goto REWORK2
  794.       Rem Don't forget negative numbers, working left to right 
  795.       If DUMMYVQ$="-" Then LEFVQ$=DUMMYVQ$+LEFVQ$ : KVQ=KVQ-1 : Exit 
  796.       Exit 
  797.       REWORK2:
  798.    Loop 
  799.    Rem Avoid two .'s or two E's 
  800.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,".")+1),".")>0 Then EVAL$="Error" : Goto XITC
  801.    If Instr(Mid$(LEFVQ$,Instr(LEFVQ$,"E")+1),"E")>0 Then EVAL$="Error" : Goto XITC
  802.    'If(Instr(LEFVQ$,"E")>0) and(Instr("123456789",Mid$(LEFVQ$,Instr(LEFVQ$,"E")-1,1))=0) Then EVAL$="Error" : Goto XITC 
  803.    If KVQ=0 Then LEF1VQ$='' : Else LEF1VQ$=Mid$(GVQ$,1,KVQ)
  804.    Rem
  805.    Rem now work out lef1vq$ lefvq$ # rigvq$ rig1vq$ 
  806.    Rem
  807.    LLVQ#=Val(LEFVQ$) : RRVQ#=Val(RIGVQ$)
  808.    If LVQ$="+" Then MIVQ#=LLVQ#+RRVQ#
  809.    If LVQ$="-" Then MIVQ#=LLVQ#-RRVQ#
  810.    MIDDVQ$=Str$(MIVQ#)
  811.    '
  812.    Rem NB Removing a space  
  813.    If Left$(MIDDVQ$,1)<>"-" Then MIDDVQ$=Right$(MIDDVQ$,Len(MIDDVQ$)-1)
  814.    '
  815.    GVQ$=LEF1VQ$+MIDDVQ$+RIG1VQ$
  816.    Goto LEFTMOSTADSUB
  817.    Rem
  818.    NMRADSUB:
  819.    If Left$(GVQ$,1)="+" Then GVQ$=Mid$(GVQ$,2)
  820.    Return 
  821.    XITC:
  822.    EVAL$=EVAL$
  823.    EVAL=Val(EVAL$)
  824.    EVAL#=Val(EVAL$)
  825. End Proc[EVAL$]
  826. Procedure HELPNEW
  827.    On Error Goto ER
  828.    Goto OK
  829.    ER:
  830.    ERR
  831.    Resume XIT
  832.    OK:
  833.    Screen Open 1,640,256,4,Hires
  834.    Curs Off : Flash Off : Colour 3,$FF0
  835.    Cls 0
  836.    Paper 0
  837.    Print 
  838.    Print : Centre "****** HELP ******"
  839.    Print 
  840.    Print : Centre " PAD "
  841.    Print : Print : Print : Print 
  842.    Pen 3
  843.    'Print : Print : Centre "To include PAD in an AMOS program"
  844.    'Print : Print : Centre "merge Pad.AMOS" 
  845.    'Print : Print : Centre "Procedure Pad may then be used" 
  846.    Print : Print : Centre "Pad consists of a NotePad to put in a short reminder,"
  847.    Print : Print : Centre "and a superb Calculator"
  848.    Print : Print : Centre "which can handle arithmetic"
  849.    Print : Print : Centre "and algebraic & trigonometric formulae"
  850.    Print : Print : Centre "using all the letters of the alphabet"
  851.    Wait 50
  852.    Do 
  853.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  854.    Loop 
  855.    Cls 0
  856.    Paper 0
  857.    Home 
  858.    Print 
  859.    Centre "* CALCULATOR HELP *"
  860.    Print 
  861.    Print 
  862.    Pen 3
  863.    Centre " Functions and Trigonometric Expressions Allowed"
  864.    Pen 2
  865.    Print 
  866.    Print 
  867.    Centre "SIN"
  868.    Print 
  869.    Centre "COS"
  870.    Print 
  871.    Centre "TAN"
  872.    Print 
  873.    Centre "ASIN"
  874.    Print 
  875.    Centre "ACOS"
  876.    Print 
  877.    Centre "ATAN"
  878.    Print 
  879.    Centre "HSIN or SINH"
  880.    Print 
  881.    Centre "HCOS or COSH"
  882.    Print 
  883.    Centre "HTAN or TANH"
  884.    Print 
  885.    Centre "LOG for base 10"
  886.    Print 
  887.    Centre "EXP"
  888.    Print 
  889.    Centre "LN Naperian,ie for base e"
  890.    Print 
  891.    Centre "SQR for square roots"
  892.    Print 
  893.    Centre "ABS"
  894.    Print 
  895.    Centre "INT"
  896.    Print 
  897.    Centre "SGN returns +1,-1 or for a zero,0"
  898.    Wait 50
  899.    Do 
  900.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  901.    Loop 
  902.    Cls 0 : Home 
  903.    Pen 3
  904.    Print : Centre "* CALCULATOR HELP *"
  905.    Print 
  906.    Pen 2
  907.    Print : Centre "Calculator Error Reports"
  908.    Print 
  909.    Print : Centre '"Error" is generated for'
  910.    Print 
  911.    Print : Centre "Errors in the input function"
  912.    Print 
  913.    Print : Centre "Division by zero"
  914.    Print 
  915.    Print : Centre "Errors in evaluating functions"
  916.    Print 
  917.    Centre "E.G"
  918.    Print 
  919.    Centre "Tan(90)"
  920.    Print 
  921.    Centre "LOG, -ve nos generate error report"
  922.    Print 
  923.    Centre "LN, -ve nos generate error report"
  924.    Print 
  925.    Centre "SQR, -ve nos generate error report"
  926.    Print 
  927.    Centre "Non-integer powers of -ve nos generate error report"
  928.    Print 
  929.    Pen 3
  930.    Print : Centre "*"
  931.    Pen 2
  932.    Print : Print : Centre "Range -10^18 to 10^18"
  933.    Pen 3
  934.    Print : Print : Centre "*"
  935.    Pen 2
  936.    Wait 50
  937.    Do 
  938.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  939.    Loop 
  940.    Clear Key 
  941.    Screen Close 1
  942.    XIT:
  943. End Proc
  944. '
  945. Rem *************************************************************
  946. '
  947. Rem            ********** MAIN PROGRAM ************
  948. Rem                       ************ 
  949. Rem                         EVALUATOR
  950. Rem            ************************************  
  951. BEGIN:
  952. Screen Open 0,320,256,16,Lowres
  953. Curs Off : Paper 0
  954. '
  955. Rem Eval Globals 
  956. '
  957. Rem Declared by Shared in Eval Procedure.
  958. Rem Declared as Global to avoid checking 'nesting' of procedures.  
  959. Global IDS$,FUNCTION$,SIGFIGS,EVAL,EVAL#,EVAL$
  960. Global 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$
  961. '
  962. Rem Other Globals
  963. '
  964. Global X,N,I,TP,K1$
  965. Global FV$,RETAINFV$,FR,HP,NDIR$
  966. Global F$,G$,FF$,GG$
  967. Global XOGO$
  968. '
  969. FF$=Dir$ : GG$=Dir$
  970. '
  971. EVAL$="" : SIGFIGS=0
  972. Cls 0
  973. Degree 
  974. '
  975. EVALUATOR
  976. Procedure EVALUATOR
  977.    BEGINLARGE:
  978.    XOGO$="L"
  979.    Goto BEG
  980.    BEGINSMALL:
  981.    XOGO$="S"
  982.    BEG:
  983.    OGO[XOGO$]
  984.    THEMENU
  985.    Menu On 
  986.    Do 
  987.       If Key State(95)=True Then HELP : OGO[XOGO$]
  988.       If Choice=0 Then Goto NOCHOICE
  989.       If Choice=-1 Then 
  990.       If Choice(1)=1 and Choice(2)=1 and Choice(3)=1 Then Goto BEGINLARGE
  991.       If Choice(1)=1 and Choice(2)=1 and Choice(3)=2 Then Goto BEGINSMALL
  992.       If Choice(1)=1 and Choice(2)=2 Then HELP : OGO[XOGO$]
  993.       'If Choice(1)=1 and Choice(2)=2 and Choice(3)=1 Then HELP : OGO[XOGO$] 
  994.       'If Choice(1)=1 and Choice(2)=2 and Choice(3)=2 Then HELPEVAL : OGO[XOGO$] 
  995.       If Choice(1)=1 and Choice(2)=3 Then Cls 0 : AMOSC : End 
  996.       If Choice(1)=2 and Choice(2)=1 Then X : OGO[XOGO$]
  997.       If Choice(1)=2 and Choice(2)=2 Then XY : OGO[XOGO$]
  998.       If Choice(1)=2 and Choice(2)=3 Then XYZ : OGO[XOGO$]
  999.       If Choice(1)=2 and Choice(2)=4 Then XYZT : OGO[XOGO$]
  1000.       If Choice(1)=2 and Choice(2)=5 Then QF : OGO[XOGO$]
  1001.       If Choice(1)=2 and Choice(2)=6 Then GTSIGFIGS : OGO[XOGO$]
  1002.       If Choice(1)=3 and Choice(2)=1 Then FLOAD : ANSDIS : N=0 : OGO[XOGO$]
  1003.       Rem For Files Menu 
  1004.       If Choice(1)=3 and Choice(2)=2 Then RUBOUT
  1005.       If Choice(1)=3 and Choice(2)=3 Then RETITLE
  1006.       If Choice(1)=3 and Choice(2)=4 Then CPY
  1007.       If Choice(1)=3 and Choice(2)=5 Then Cls 0 : MDIR : OGO[XOGO$]
  1008.       If Choice(1)=3 and Choice(2)=6 Then Cls 0 : ERASDIR : OGO[XOGO$]
  1009.       If Choice(1)=3 and Choice(2)=8 Then Cls 0 : BYFREE : OGO[XOGO$]
  1010.       NOCHOICE:
  1011.    Loop 
  1012. End Proc
  1013. Procedure THEMENU
  1014.    Menu$(1)=" Options "
  1015.    Menu$(1,1)=" Write "
  1016.    Menu$(1,1,1)=" Large "
  1017.    Menu$(1,1,2)=" Small "
  1018.    Menu$(1,2)=" Help "
  1019.    'Menu$(1,2,1)=" Evaluator "
  1020.    'Menu$(1,2,2)="   EVAL    "
  1021.    Menu$(1,3)=" Quit "
  1022.    Menu$(2)=" Functions "
  1023.    Menu$(2,1)=" f{x}       "
  1024.    Menu$(2,2)=" f{x,y}     "
  1025.    Menu$(2,3)=" f{x,y,z}   "
  1026.    Menu$(2,4)=" f{x,y,z,t} "
  1027.    Menu$(2,5)=" Quick Formula "
  1028.    Menu$(2,6)="(IN1,1)   Sig Figs    (IN1,0)"
  1029.    Menu$(3)=" Files "
  1030.    Menu$(3,1)=" Display "
  1031.    Menu$(3,2)="Delete"
  1032.    Menu$(3,3)="ReName"
  1033.    Menu$(3,4)="Copy"
  1034.    Menu$(3,5)="MakeDir"
  1035.    Menu$(3,6)="EraseDir"
  1036.    Menu$(3,7)="(IN1,1)(SS6)A(SS0)(LO10,0)A><WB(IN1,0)"
  1037.    Menu$(3,8)="Free"
  1038. End Proc
  1039. '
  1040. Procedure OGO[XOGO$]
  1041.    '
  1042.    If XOGO$="S" Then Goto SMALLOGO
  1043.    '
  1044.    LARGOGO:
  1045.    Screen Open 0,320,256,4,Lowres
  1046.    Curs Off : Paper 0 : Cls : FR=1 : HP=1 : Flash Off 
  1047.    Colour 3,$FF0 : Colour 1,$800
  1048.    Goto ALLOGO
  1049.    '
  1050.    SMALLOGO:
  1051.    Screen Open 0,640,256,4,Hires
  1052.    Curs Off : Paper 0 : Cls : FR=2 : HP=1 : Flash Off 
  1053.    Colour 3,$FF0 : Colour 1,$800
  1054.    '
  1055.    ALLOGO:
  1056.    Limit Mouse 128,44 To 768,300
  1057.    Cls 0
  1058.    Locate 0,10
  1059.    Centre Border$("EVALUATOR",1)
  1060.    Ink 1
  1061.    Ellipse 155*FR,84,50*FR,20
  1062.    Ink 3
  1063.    Ellipse 155*FR,84,60*FR,30
  1064.    Rem Zeroise parapeters 
  1065.    For I=1 To 181
  1066.       K$(I)=""
  1067.    Next I
  1068.    K1$=""
  1069.    N=0
  1070. End Proc
  1071. Procedure HELP
  1072.    On Error Goto ER
  1073.    Goto OK
  1074.    ER:
  1075.    ERR
  1076.    Resume XIT
  1077.    OK:
  1078.    Screen Open 1,640,256,4,Hires
  1079.    Curs Off : Flash Off : Colour 3,$FF0
  1080.    Cls 0
  1081.    Paper 0
  1082.    Print 
  1083.    Print : Centre "****** HELP ******"
  1084.    Print 
  1085.    Print : Centre " A program to input and evaluate formulas"
  1086.    Print 
  1087.    Pen 3
  1088.    Print : Centre " Examples of use of Evaluator :"
  1089.    Print 
  1090.    Print : Centre "1.Find VAT of 15%"
  1091.    Print : Centre "QuickFormula"
  1092.    Print : Centre "a*15/100"
  1093.    Print : Centre "Input amounts as a"
  1094.    Print 
  1095.    Print : Centre "2.Add pairs of numbers"
  1096.    Print : Centre "QuickFormula"
  1097.    Print : Centre "a+b"
  1098.    Print 
  1099.    Print : Centre " 3.Distance for a (sinusoidally) accelerating particle  "
  1100.    Print : Centre " f(x,y,z,t)=x*t+(y/2)*sin(z*t)*t^2"
  1101.    Print : Centre " {x=initial velocity,y=acceleration,t=time,z=constant}"
  1102.    Print 
  1103.    Print : Centre "4.Height of a building"
  1104.    Print : Centre "QuickFormula"
  1105.    Print : Centre "d*tan(a)"
  1106.    Print : Centre "where d=distance and a=angle of elevation"
  1107.    Wait 50
  1108.    Do 
  1109.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  1110.    Loop 
  1111.    HELP1A
  1112.    HELP2
  1113.    XIT:
  1114. End Proc
  1115. Procedure HELP1A
  1116.    Cls 0
  1117.    Paper 0
  1118.    Home 
  1119.    Print : Print 
  1120.    Centre "****** HELP ******"
  1121.    Print : Pen 3 : Print : Centre " Files"
  1122.    Print : Print : Pen 2 : Centre "Use menu for"
  1123.    Print : Centre "Display"
  1124.    Print : Centre "Delete"
  1125.    Print : Centre "Rename to same disk"
  1126.    Print : Centre "Copy"
  1127.    Print : Centre "Make Directory"
  1128.    Print : Centre "Delete 'empty' Directory"
  1129.    Print : Centre "Query Free Space"
  1130.    Print 
  1131.    Print : Pen 3 : Print : Centre "WorkBench"
  1132.    Print : Centre "Press Left Amiga A to toggle WorkBench"
  1133.    Print : Pen 2 : Print : Centre "Right Mouse for Menu"
  1134.    Print 
  1135.    Centre "Select Initialise to Format a Disk"
  1136.    Print 
  1137.    Centre "/!\ All data will be IRRETRIEVABLY lost"
  1138.    Print 
  1139.    Print 
  1140.    Centre "To Copy a disk"
  1141.    Print 
  1142.    Centre "/!\ WRITE PROTECT"
  1143.    Print 
  1144.    Centre "Move its Icon onto the new disk"
  1145.    Print : Print : Pen 3 : Centre "Printer"
  1146.    Print : Centre "Press Left Amiga A to toggle WorkBench"
  1147.    Print : Print : Pen 2 : Centre "Select Preferences to alter Printer Settings"
  1148.    Wait 50
  1149.    Do 
  1150.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  1151.    Loop 
  1152.    Clear Key 
  1153. End Proc
  1154. Procedure HELP1B
  1155.    On Error Goto ER
  1156.    Goto OK
  1157.    ER:
  1158.    ERR
  1159.    Resume XIT
  1160.    OK:
  1161.    Screen Open 1,640,256,4,Hires
  1162.    Curs Off : Flash Off : Colour 3,$FF0
  1163.    Cls 0
  1164.    Paper 0
  1165.    Home 
  1166.    Print 
  1167.    Print : Centre "****** HELP ******"
  1168.    Print 
  1169.    Pen 3
  1170.    Print : Centre "use < and > to scroll "
  1171.    Print 
  1172.    Print : Centre 'left and right'
  1173.    Print 
  1174.    Pen 2
  1175.    Print : Centre "TO ALIGN"
  1176.    Print 
  1177.    Print : Centre "(in display mode)"
  1178.    Print 
  1179.    Pen 3
  1180.    Print : Centre "Left mouse key"
  1181.    Print 
  1182.    Print : Centre "inserts one space "
  1183.    Print 
  1184.    Print : Centre "at start of line"
  1185.    Print 
  1186.    Print : Centre "only if a space exists already"
  1187.    Print 
  1188.    Print 
  1189.    Print : Centre "Right mouse key"
  1190.    Print 
  1191.    Print : Centre "removes one space"
  1192.    Print 
  1193.    Print : Centre "from a double space"
  1194.    Print 
  1195.    Print : Centre "at start of line"
  1196.    Print 
  1197.    Print : Print : Centre "************************"
  1198.    Wait 50
  1199.    Do 
  1200.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  1201.    Loop 
  1202.    HP=1
  1203.    HELP2
  1204.    XIT:
  1205. End Proc
  1206. Procedure HELP2
  1207.    On Error Goto ER
  1208.    Goto OK
  1209.    ER:
  1210.    ERR
  1211.    Resume XIT
  1212.    OK:
  1213.    If HP=2 Then Screen Open 1,640,256,4,Hires
  1214.    Curs Off : Flash Off : Colour 3,$FF0
  1215.    Cls 0
  1216.    Paper 0
  1217.    Home 
  1218.    Print 
  1219.    Pen 3
  1220.    Print : Centre "****** HELP ******"
  1221.    Print 
  1222.    Pen 2
  1223.    Print : Centre "Error Reports"
  1224.    Print 
  1225.    Print : Centre '"Error" is generated for'
  1226.    Print 
  1227.    Print : Centre "Errors in the input function"
  1228.    Print 
  1229.    Print : Centre "Division by zero"
  1230.    Print 
  1231.    Print : Centre "Errors in evaluating functions"
  1232.    Print 
  1233.    Centre "E.G"
  1234.    Print 
  1235.    Centre "Tan(90)"
  1236.    Print 
  1237.    Centre "LOG, -ve nos generate error report"
  1238.    Print 
  1239.    Centre "LN, -ve nos generate error report"
  1240.    Print 
  1241.    Centre "SQR, -ve nos generate error report"
  1242.    Print 
  1243.    Centre "Non-integer powers of -ve nos generate error report"
  1244.    Print 
  1245.    Pen 3
  1246.    Print : Centre "*"
  1247.    Pen 2
  1248.    Print 
  1249.    Print : Centre "Maximum number of evaluations per function = 170."
  1250.    Print : Centre "For Display with 170 evaluations:"
  1251.    Print : Centre "No Insert allowed - delete a line first"
  1252.    Pen 3
  1253.    Print : Print : Centre "*"
  1254.    Pen 2
  1255.    Print : Print : Centre "Range -10^18 to 10^18"
  1256.    Wait 50
  1257.    Do 
  1258.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  1259.    Loop 
  1260.    HELP3
  1261.    XIT:
  1262. End Proc
  1263. Procedure HELP3
  1264.    Cls 0
  1265.    Paper 0
  1266.    Home 
  1267.    Print 
  1268.    Centre "****** HELP ******"
  1269.    Print 
  1270.    Print 
  1271.    Pen 3
  1272.    Centre " Functions and Trigonometric Expressions Allowed"
  1273.    Pen 2
  1274.    Print 
  1275.    Print 
  1276.    Centre "SIN"
  1277.    Print 
  1278.    Centre "COS"
  1279.    Print 
  1280.    Centre "TAN"
  1281.    Print 
  1282.    Centre "ASIN"
  1283.    Print 
  1284.    Centre "ACOS"
  1285.    Print 
  1286.    Centre "ATAN"
  1287.    Print 
  1288.    Centre "HSIN or SINH"
  1289.    Print 
  1290.    Centre "HCOS or COSH"
  1291.    Print 
  1292.    Centre "HTAN or TANH"
  1293.    Print 
  1294.    Centre "LOG for base 10"
  1295.    Print 
  1296.    Centre "EXP"
  1297.    Print 
  1298.    Centre "LN Naperian,ie for base e"
  1299.    Print 
  1300.    Centre "SQR for square roots"
  1301.    Print 
  1302.    Centre "ABS"
  1303.    Print 
  1304.    Centre "INT"
  1305.    Print 
  1306.    Centre "SGN returns +1,-1 or for a zero,0"
  1307.    Wait 50
  1308.    Do 
  1309.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  1310.    Loop 
  1311.    Clear Key 
  1312.    Screen Close 1
  1313. End Proc
  1314. Procedure HELPEVAL
  1315.    On Error Goto ER
  1316.    Goto OK
  1317.    ER:
  1318.    ERR
  1319.    Resume XIT
  1320.    OK:
  1321.    Screen Open 1,640,256,4,Hires
  1322.    Curs Off : Flash Off : Colour 3,$FF0
  1323.    Cls 0
  1324.    Paper 0
  1325.    Home 
  1326.    Centre "**** Using EVAL in AMOS Programs ****"
  1327.    Print : Print : Pen 3 : Centre "Merge Eval.AMOS"
  1328.    Print : Centre "from the Evaluator Disk"
  1329.    Print : Centre "to obtain Procedure EVAL[IDS$,FUNCTION$,SIGFIGS]"
  1330.    Print : Print : Pen 2 : Centre "Try the following program"
  1331.    Print : Pen 3 : Centre 'Global X$,Y$,Eval$'
  1332.    Print : Centre "Degree"
  1333.    Print : Centre 'SIGFIGS=0 : IDS$=""'
  1334.    Print : Centre 'Rem IDS$ = "" or "#" or "$"'
  1335.    Print : Centre "Rem for Integer,Decimal or String"
  1336.    Print : Centre 'Do'
  1337.    Print : Centre 'Input "x = {* to exit}";X$'
  1338.    Print : Centre 'If X$="*" then Exit'
  1339.    Print : Centre 'Input "y = ";Y$'
  1340.    Print : Centre 'Input "f(x,y) = ";FUNCTION$'
  1341.    Print : Centre "EVAL[IDS$,FUNCTION$,SIGFIGS]"
  1342.    Print : Centre "Print EVAL$"
  1343.    Print : Centre 'Loop'
  1344.    Print : Centre "End"
  1345.    Print : Centre "Procedure EVAL[IDS$,FUNCTION$,SIGFIGS]"
  1346.    Print : Print : Pen 2 : Centre "Note EVAL Local parameters"
  1347.    Print : Centre 'end in "VQ" to avoid program clashes'
  1348.    Print : Print : Centre "Shared Variables used are"
  1349.    Print : Centre "IDS$,FUNCTION$,SIGFIGS,EVAL,EVAL#,EVAL$"
  1350.    Print : Centre "A-Z or A#-Z# or A$-Z$ as required."
  1351.    Print : Print 
  1352.    Wait 50
  1353.    Do 
  1354.       If(Mouse Key=1) or(Key State(95)=True) or(Key State(37)=True) Then Exit 
  1355.    Loop 
  1356.    Clear Key 
  1357.    Screen Close 1
  1358.    XIT:
  1359. End Proc
  1360. Procedure X
  1361.    N=1
  1362.    Cls 0
  1363.    Border 3,3,0
  1364.    Title Top Space$(17*FR)+"Evaluator"
  1365.    Paper 1 : Pen 2
  1366.    Wind Open 1,20*FR,40,35*FR,1,0
  1367.    Wind Open 2,50*FR,60,25*FR,1,0
  1368.    Wind Open 3,50*FR,80,25*FR,1,0
  1369.    Window 1
  1370.    Input "f(x) = ";FV$; : K1$="f(x)="+FV$
  1371.    RETAINFV$=FV$
  1372.    Do 
  1373.       FV$=RETAINFV$
  1374.       Window 2
  1375.       Input "x = ";X$; : K$(N)=" x="+X$
  1376.       '
  1377.       EVAL["$",FV$,SIGFIGS]
  1378.       '
  1379.       Window 3
  1380.       Print "f(x) = ";EVAL$; : K$(N)=K$(N)+" f(x)="+EVAL$
  1381.       Wait Vbl 
  1382.       Window 0
  1383.       Paper 0
  1384.       Locate 0,22
  1385.       Centre "[space] next number"
  1386.       STPX:
  1387.       Locate 0,24 : Pen 3 : Centre "[S]ave [P]rint [D]isplay [Q]uit"
  1388.       Locate 0,26 : Pen 3 : Centre "[H]elp" : Pen 2
  1389.       Do 
  1390.          A$=Inkey$
  1391.          FRR=26*FR+7*(FR-1)
  1392.          If(A$="S") or(A$="s") Then ANSAVE
  1393.          If(A$="P") or(A$="p") Then ANSPT
  1394.          If(A$="D") or(A$="d") Then Cls 0 : ANSDIS : Exit 
  1395.          If(A$="Q") or(A$="q") Then Exit 
  1396.          If(A$="H") or(A$="h") Then HP=2 : HELP2 : HP=1
  1397.          If A$=" " and N<171 Then Goto NXT
  1398.       Loop 
  1399.       Goto FINA
  1400.       NXT:
  1401.       N=N+1
  1402.       Paper 1
  1403.       Window 2 : Clw 
  1404.       If N=171 Then Centre "170 Evaluations"
  1405.       Window 3 : Clw 
  1406.       If N=171 Then Centre "Restart for more"
  1407.       If N=171 Then Window 0 : Paper 0 : Locate 0,22 : Cline : Goto STPX
  1408.    Loop 
  1409.    FINA:
  1410. End Proc
  1411. Procedure XY
  1412.    N=1
  1413.    Cls 0
  1414.    Border 3,3,0
  1415.    Title Top Space$(17*FR)+"Evaluator"
  1416.    Paper 1 : Pen 2
  1417.    Wind Open 1,20*FR,40,35*FR,1,0
  1418.    Wind Open 2,50*FR,60,25*FR,1,0
  1419.    Wind Open 3,50*FR,80,25*FR,1,0
  1420.    Wind Open 4,50*FR,100,25*FR,1,0
  1421.    Window 1
  1422.    Input "f(x,y) = ";FV$; : K1$="f(x,y)="+FV$
  1423.    RETAINFV$=FV$
  1424.    Do 
  1425.       K$(N)=""
  1426.       FV$=RETAINFV$
  1427.       Window 2
  1428.       Input "x = ";X$; : K$(N)=" x="+X$
  1429.       Window 3
  1430.       Input "y = ";Y$; : K$(N)=K$(N)+" y="+Y$
  1431.       '
  1432.       EVAL["$",FV$,SIGFIGS]
  1433.       '
  1434.       Window 4
  1435.       Print "f(x,y) = ";EVAL$; : K$(N)=K$(N)+" f(x,y)="+EVAL$
  1436.       Wait Vbl 
  1437.       Window 0
  1438.       Paper 0
  1439.       Locate 0,22
  1440.       Centre "[space] next numbers"
  1441.       STPXY:
  1442.       Locate 0,24 : Pen 3 : Centre "[S]ave [P]rint [D]isplay [Q]uit"
  1443.       Locate 0,26 : Pen 3 : Centre "[H]elp" : Pen 2
  1444.       Do 
  1445.          A$=Inkey$
  1446.          FRR=24*FR+9*(FR-1)
  1447.          If A$="S" Then ANSAVE
  1448.          If A$="s" Then ANSAVE
  1449.          If A$="P" Then ANSPT
  1450.          If A$="p" Then ANSPT
  1451.          If A$="D" Then Cls 0 : ANSDIS : Exit 
  1452.          If A$="d" Then Cls 0 : ANSDIS : Exit 
  1453.          If A$="Q" Then Exit 
  1454.          If A$="q" Then Exit 
  1455.          If A$="H" Then HP=2 : HELP2 : HP=1
  1456.          If A$="h" Then HP=2 : HELP2 : HP=1
  1457.          If A$=" " and N<171 Then Goto NXTXY
  1458.       Loop 
  1459.       Goto FINAXY
  1460.       NXTXY:
  1461.       N=N+1
  1462.       Paper 1
  1463.       Window 2 : Clw 
  1464.       Window 3 : Clw 
  1465.       If N=171 Then Centre "170 Evaluations"
  1466.       Window 4 : Clw 
  1467.       If N=171 Then Centre "Restart for more"
  1468.       If N=171 Then Window 0 : Paper 0 : Locate 0,22 : Cline : Goto STPXY
  1469.    Loop 
  1470.    FINAXY:
  1471. End Proc
  1472. Procedure XYZ
  1473.    N=1
  1474.    Cls 0
  1475.    Border 3,3,0
  1476.    Title Top Space$(17*FR)+"Evaluator"
  1477.    Paper 1 : Pen 2
  1478.    Wind Open 1,20*FR,40,35*FR,1,0
  1479.    Wind Open 2,50*FR,60,25*FR,1,0
  1480.    Wind Open 3,50*FR,80,25*FR,1,0
  1481.    Wind Open 4,50*FR,100,25*FR,1,0
  1482.    Wind Open 5,50*FR,120,25*FR,1,0
  1483.    Window 1
  1484.    Input "f(x,y,z) = ";FV$; : K1$="f(x,y,z)="+FV$
  1485.    RETAINFV$=FV$
  1486.    Do 
  1487.       FV$=RETAINFV$
  1488.       Window 2
  1489.       Input "x = ";X$; : K$(N)=" x="+X$
  1490.       Window 3
  1491.       Input "y = ";Y$; : K$(N)=K$(N)+" y="+Y$
  1492.       Window 4
  1493.       Input "z = ";Z$; : K$(N)=K$(N)+" z="+Z$
  1494.       '
  1495.       EVAL["$",FV$,SIGFIGS]
  1496.       '
  1497.       Window 5
  1498.       Print "f(x,y,z) = ";EVAL$; : K$(N)=K$(N)+" f(x,y,z)="+EVAL$
  1499.       Wait Vbl 
  1500.       Window 0
  1501.       Paper 0
  1502.       Locate 0,22
  1503.       Centre "[space] next numbers"
  1504.       STPXYZ:
  1505.       Locate 0,24 : Pen 3 : Centre "[S]ave [P]rint [D]isplay [Q]uit"
  1506.       Locate 0,26 : Pen 3 : Centre "[H]elp" : Pen 2
  1507.       Do 
  1508.          A$=Inkey$
  1509.          FRR=22*FR+11*(FR-1)
  1510.          If A$="S" Then ANSAVE
  1511.          If A$="s" Then ANSAVE
  1512.          If A$="P" Then ANSPT
  1513.          If A$="p" Then ANSPT
  1514.          If A$="D" Then Cls 0 : ANSDIS : Exit 
  1515.          If A$="d" Then Cls 0 : ANSDIS : Exit 
  1516.          If A$="Q" Then Exit 
  1517.          If A$="q" Then Exit 
  1518.          If A$="H" Then HP=2 : HELP2 : HP=1
  1519.          If A$="h" Then HP=2 : HELP2 : HP=1
  1520.          If A$=" " and N<171 Then Goto NXTXYZ
  1521.       Loop 
  1522.       Goto FINAXYZ
  1523.       NXTXYZ:
  1524.       N=N+1
  1525.       Paper 1
  1526.       For I=2 To 4 : Window I : Clw : Next I
  1527.       If N=171 Then Centre "170 Evaluations"
  1528.       Window 5 : Clw 
  1529.       If N=171 Then Centre "Restart for more"
  1530.       If N=171 Then Window 0 : Paper 0 : Locate 0,22 : Cline : Goto STPXYZ
  1531.    Loop 
  1532.    FINAXYZ:
  1533. End Proc
  1534. Procedure XYZT
  1535.    N=1
  1536.    Cls 0
  1537.    Border 3,3,0
  1538.    Title Top Space$(17*FR)+"Evaluator"
  1539.    Paper 1 : Pen 2
  1540.    Wind Open 1,20*FR,40,35*FR,1,0
  1541.    Wind Open 2,50*FR,60,25*FR,1,0
  1542.    Wind Open 3,50*FR,80,25*FR,1,0
  1543.    Wind Open 4,50*FR,100,25*FR,1,0
  1544.    Wind Open 5,50*FR,120,25*FR,1,0
  1545.    Wind Open 6,50*FR,140,25*FR,1,0
  1546.    Window 1
  1547.    Input "f(x,y,z,t) = ";FV$; : K1$="f(x,y,z,t)="+FV$
  1548.    RETAINFV$=FV$
  1549.    Do 
  1550.       FV$=RETAINFV$
  1551.       Window 2
  1552.       Input "x = ";X$; : K$(N)=" x="+X$
  1553.       Window 3
  1554.       Input "y = ";Y$; : K$(N)=K$(N)+" y="+Y$
  1555.       Window 4
  1556.       Input "z = ";Z$; : K$(N)=K$(N)+" z="+Z$
  1557.       Window 5
  1558.       Input "t = ";T$; : K$(N)=K$(N)+" t="+T$
  1559.       '
  1560.       EVAL["$",FV$,SIGFIGS]
  1561.       '
  1562.       Window 6
  1563.       Print "f(x,y,z,t) = ";EVAL$; : K$(N)=K$(N)+" f(x,y,z,t)="+EVAL$
  1564.       Wait Vbl 
  1565.       Window 0
  1566.       Paper 0
  1567.       Locate 0,22
  1568.       Centre "[space] next numbers"
  1569.       STPXYZT:
  1570.       Locate 0,24 : Pen 3 : Centre "[S]ave [P]rint [D]isplay [Q]uit"
  1571.       Locate 0,26 : Pen 3 : Centre "[H]elp" : Pen 2
  1572.       Do 
  1573.          A$=Inkey$
  1574.          FRR=20*FR+13*(FR-1)
  1575.          If A$="S" Then ANSAVE
  1576.          If A$="s" Then ANSAVE
  1577.          If A$="P" Then ANSPT
  1578.          If A$="p" Then ANSPT
  1579.          If A$="D" Then Cls 0 : ANSDIS : Exit 
  1580.          If A$="d" Then Cls 0 : ANSDIS : Exit 
  1581.          If A$="Q" Then CODE$="From input" : Exit 
  1582.          If A$="q" Then CODE$="From input" : Exit 
  1583.          If A$="H" Then HP=2 : HELP2 : HP=1
  1584.          If A$="h" Then HP=2 : HELP2 : HP=1
  1585.          If A$=" " and N<171 Then Goto NXTXYZT
  1586.       Loop 
  1587.       Goto FINAXYZT
  1588.       NXTXYZT:
  1589.       N=N+1
  1590.       Paper 1
  1591.       For I=2 To 5 : Window I : Clw : Next I
  1592.       If N=171 Then Centre "170 Evaluations"
  1593.       Window 6 : Clw 
  1594.       If N=171 Then Centre "Restart for more"
  1595.       If N=171 Then Window 0 : Paper 0 : Locate 0,22 : Cline : Goto STPXYZT
  1596.    Loop 
  1597.    FINAXYZT:
  1598. End Proc
  1599. Procedure GTSIGFIGS
  1600.    On Error Goto ER
  1601.    Goto OK
  1602.    ER:
  1603.    ERR
  1604.    Resume XIT
  1605.    OK:
  1606.    Screen Open 2,320,64,4,Hires
  1607.    Screen Display 2,200,93,320,64
  1608.    Curs Off : Cls 1 : Flash Off 
  1609.    Colour 3,$99
  1610.    Print : Centre "Select Significant figures"
  1611.    Print 
  1612.    Reserve Zone 8
  1613.    Reset Zone 
  1614.    Reserve Zone 8
  1615.    For I=1 To 6
  1616.       Paper 3
  1617.       IG$=" "+Chr$(48+I)+" "
  1618.       Locate 4*I,3 : Print Zone$(IG$,I)
  1619.    Next I
  1620.    Locate 15,5 : Print Zone$("other",7)
  1621.    Locate 29,5 : Print Zone$("none",8)
  1622.    While Mouse Key<>0 : Wend 
  1623.    Do 
  1624.       M=Mouse Zone
  1625.       For I=1 To 6
  1626.          If M=I and Mouse Key=1 Then SIGFIGS=M : Goto XIT
  1627.       Next I
  1628.       If M=7 and Mouse Key Then Paper 1 : Cls 1 : Home : Print : Print : Input " No of Sig Figs ";SIGFIGS : Exit 
  1629.       If M=8 and Mouse Key Then SIGFIGS=0 : Exit 
  1630.    Loop 
  1631.    XIT:
  1632.    While Mouse Key<>0 : Wend 
  1633.    Screen Close 2
  1634. End Proc
  1635. '
  1636. Procedure QF
  1637.    ZEROIZE
  1638.    Cls 0
  1639.    Border 3,3,0
  1640.    Title Top Space$(17*FR)+"Evaluator"
  1641.    Paper 1 : Pen 2
  1642.    Wind Open 1,20*FR,40,35*FR,1,0
  1643.    Wind Open 2,50*FR,60,25*FR,1,0
  1644.    Wind Open 3,50*FR,80,25*FR,1,0
  1645.    Window 1
  1646.    Input "Formula: ";FV$; : FV$=Lower$(FV$) : K1$=FV$
  1647.    Clw 
  1648.    Centre Left$(K1$,35*FR-2)
  1649.    RETAINFV$=K1$
  1650.    N=1
  1651.    Do 
  1652.       FV$=RETAINFV$
  1653.       Window 2
  1654.       '
  1655.       Rem Functions to lower case
  1656.       '
  1657.       FV$=Upper$(FV$)
  1658.       Restore NWDT
  1659.       For J=1 To 20
  1660.          Read AV$
  1661.          BV$=Lower$(AV$)
  1662.          L=Len(AV$)
  1663.          Do 
  1664.             I=Instr(FV$,AV$)
  1665.             If I=0 Then Exit 
  1666.             FV$=Left$(FV$,I-1)+BV$+Mid$(FV$,I+L)
  1667.          Loop 
  1668.       Next J
  1669.       '
  1670.       Rem Replace upper case letters by 'numbers'
  1671.       For J=65 To 90
  1672.          Do 
  1673.             I=Instr(FV$,Chr$(J))
  1674.             If I=0 Then Exit 
  1675.             Clw 
  1676.             If J=65 Then Input "a = ";A$ : Exit 
  1677.             If J=66 Then Input "b = ";B$ : Exit 
  1678.             If J=67 Then Input "c = ";C$ : Exit 
  1679.             If J=68 Then Input "d = ";D$ : Exit 
  1680.             If J=69 Then Input "e = ";E$ : Exit 
  1681.             If J=70 Then Input "f = ";F$ : Exit 
  1682.             If J=71 Then Input "g = ";G$ : Exit 
  1683.             If J=72 Then Input "h = ";H$ : Exit 
  1684.             If J=73 Then Input "i = ";I$ : Exit 
  1685.             If J=74 Then Input "j = ";J$ : Exit 
  1686.             If J=75 Then Input "k = ";K$ : Exit 
  1687.             If J=76 Then Input "l = ";L$ : Exit 
  1688.             If J=77 Then Input "m = ";M$ : Exit 
  1689.             If J=78 Then Input "n = ";N$ : Exit 
  1690.             If J=79 Then Input "o = ";O$ : Exit 
  1691.             If J=80 Then Input "p = ";P$ : Exit 
  1692.             If J=81 Then Input "q = ";Q$ : Exit 
  1693.             If J=82 Then Input "r = ";R$ : Exit 
  1694.             If J=83 Then Input "s = ";S$ : Exit 
  1695.             If J=84 Then Input "t = ";T$ : Exit 
  1696.             If J=85 Then Input "u = ";U$ : Exit 
  1697.             If J=86 Then Input "v = ";V$ : Exit 
  1698.             If J=87 Then Input "w = ";W$ : Exit 
  1699.             If J=88 Then Input "x = ";X$ : Exit 
  1700.             If J=89 Then Input "y = ";Y$ : Exit 
  1701.             If J=90 Then Input "z = ";Z$ : Exit 
  1702.          Loop 
  1703.       Next J
  1704.       Paper 3 : Clw : Paper 1
  1705.       '
  1706.       FV$=Upper$(FV$)
  1707.       '
  1708.       NWDT:
  1709.       Data "ASIN","ACOS","ATAN","HSIN","HCOS","HTAN","SINH","COSH","TANH"
  1710.       Data "SIN","COS","TAN","LOG","EXP","SQR","ABS","INT","SGN","LN","PI"
  1711.       '
  1712.       EVAL["$",FV$,SIGFIGS]
  1713.       '
  1714.       Window 3
  1715.       Centre EVAL$
  1716.       Wait Vbl 
  1717.       Window 0
  1718.       Paper 0
  1719.       Locate 0,22
  1720.       Centre "[space] next number(s)"
  1721.       Locate 0,24 : Pen 3 : Centre "[V]ariables [D]isplay [Q]uit"
  1722.       Locate 0,26 : Pen 3 : Centre "[P]rint [S]ave"
  1723.       Pen 2
  1724.       KAY
  1725.       STPX:
  1726.       Do 
  1727.          AB$=Inkey$
  1728.          If(AB$="V") or(AB$="v") Then VRBLES
  1729.          If(AB$="S") or(AB$="s") Then ANSAVE
  1730.          If(AB$="P") or(AB$="p") Then ANSPT
  1731.          If(AB$="D") or(AB$="d") Then Cls 0 : ANSDIS : Exit 
  1732.          If(AB$="Q") or(AB$="q") Then Exit 
  1733.          If AB$=" " and N<171 Then Goto NXT
  1734.       Loop 
  1735.       Goto FINA
  1736.       NXT:
  1737.       N=N+1
  1738.       Paper 1
  1739.       Window 2 : Clw 
  1740.       If N=171 Then Centre "170 Evaluations"
  1741.       Window 3 : Clw 
  1742.       If N=171 Then Centre "Restart for more"
  1743.       If N=171 Then Window 0 : Paper 0 : Locate 0,22 : Cline : Goto STPX
  1744.    Loop 
  1745.    FINA:
  1746. End Proc
  1747. Procedure ZEROIZE
  1748.    A$="" : B$="" : C$="" : D$="" : E$="" : F$="" : G$="" : H$="" : I$="" : J$="" : K$="" : L$="" : M$=""
  1749.    N$="" : O$="" : P$="" : Q$="" : R$="" : S$="" : T$="" : U$="" : V$="" : W$="" : X$="" : Y$="" : Z$=""
  1750. End Proc
  1751. Procedure VRBLES
  1752.    Screen Open 1,320,256,4,Lowres
  1753.    Flash Off : Curs Off : Colour 1,777 : Colour 3,$FF0 : Paper 1 : Pen 3
  1754.    Print : Print : Centre Left$(Lower$(FV$),40)
  1755.    Print 
  1756.    For I=65 To 90
  1757.       Read AA$
  1758.       If AA$<>"" Then Print : Centre Left$(Chr$(I+32)+" : "+AA$,40)
  1759.    Next I
  1760.    Print : Print : Centre Left$(EVAL$,40)
  1761.    Wait 50
  1762.    Do 
  1763.       If Mouse Key Then Exit 
  1764.       BB$=Inkey$
  1765.       If(BB$="V") or(BB$="v") Then Exit 
  1766.    Loop 
  1767.    Screen Close 1
  1768.    Wait 50
  1769.    Clear Key 
  1770.    Data 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$
  1771. End Proc
  1772. Procedure KAY
  1773.    K$(N)=""
  1774.    For I=65 To 90
  1775.       Read AA$
  1776.       If AA$<>"" Then K$(N)=K$(N)+Chr$(I+32)+" = "+AA$+"  "
  1777.    Next I
  1778.    K$(N)=K$(N)+RETAINFV$+" = "+EVAL$
  1779.    Wait 50
  1780.    Clear Key 
  1781.    Data 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$
  1782. End Proc
  1783. '
  1784. Procedure ANSDIS
  1785.    Cls 0 : Y=1 : XL=1 : TP=0
  1786.    Screen Open 0,640,256,4,Hires
  1787.    Menu Off 
  1788.    Flash Off 
  1789.    Limit Mouse 128,44 To 768,300
  1790.    Curs Off : Paper 0 : Cls : Colour 3,$FF0 : Colour 1,$F00 : Colour 2,$FFF
  1791.    Double Buffer : 
  1792.    REASY:
  1793.    Autoback 1
  1794.    Cls 0
  1795.    Curs Off 
  1796.    Locate 0,28 : Centre "Control slider with the mouse"
  1797.    Pen 3 : Locate 0,1 : Centre "*** "+K1$+" ***" : Pen 2
  1798.    If TP=2 Then Locate 0,29 : Centre "Select line to delete"
  1799.    If TP=1 Then Locate 0,29 : Centre "Select line to insert,after"
  1800.    If TP=0 Then Locate 0,29 : Centre "Display"
  1801.    MAKEZONES
  1802.    Autoback 0
  1803.    Rem main loop
  1804.    Do 
  1805.       X=1+Int((N*Y)/170)
  1806.       Rem Read mouse 
  1807.       If Mouse Zone=1 and Mouse Key Then Y=Y Screen(Y Mouse) : Y=Y-16
  1808.       For I=2 To 11
  1809.          If Mouse Zone=I and Mouse Key=1 and TP=0 Then WHAT$=Mid$(K$(X+I-2),XL,1) : If WHAT$=" " Then K$(X+I-2)=Left$(K$(X+I-2),XL-1)+" "+Mid$(K$(X+I-2),XL)
  1810.          If Mouse Zone=I and Mouse Key=2 and TP=0 Then WHAT$=Mid$(K$(X+I-2),XL,2) : If WHAT$="  " Then K$(X+I-2)=Left$(K$(X+I-2),XL-1)+Mid$(K$(X+I-2),XL+1)
  1811.          If Mouse Zone=I and Mouse Key and TP=2 and X+I-2<N+1 Then DLNE : While Mouse Key<>0 : Wend : Goto REASY
  1812.          If Mouse Zone=I and Mouse Key and TP=1 and X+I-2<N+1 Then ILINE : Goto REASY
  1813.       Next I
  1814.       Rem TP 0-display, 1-insert, 2-delete 
  1815.       If Mouse Zone=12 and Mouse Key and TP=0 Then HELP1B : HP=1
  1816.       If Mouse Zone=12 and Mouse Key and TP<>0 Then HP=2 : HELP2 : HP=1
  1817.       If Mouse Zone=13 and Mouse Key Then ANSAVE
  1818.       If Mouse Zone=14 and Mouse Key Then ANSPT
  1819.       If Mouse Zone=15 and Mouse Key Then TP=0 : Goto REASY
  1820.       If Mouse Zone=16 and Mouse Key Then TP=1 : Goto REASY
  1821.       If Mouse Zone=17 and Mouse Key Then TP=2 : Goto REASY
  1822.       If Mouse Zone=18 and Mouse Key Then Goto FIN
  1823.       If Mouse Zone=19 and Mouse Key Then XL=XL+1
  1824.       If Mouse Zone=20 and Mouse Key and XL>0 Then XL=XL-1
  1825.       If Y>170 Then Y=170
  1826.       If Y<0 Then Y=0
  1827.       Rem If slider has moved change it  
  1828.       If Y<>YM and Mouse Key=1 : YM=Y : End If 
  1829.       Rem Update display 
  1830.       For I=1 To 10
  1831.          Locate 5,2*I+1 : Cline 
  1832.          Print Mid$(K$(X+I-1),XL,70);
  1833.       Next I
  1834.       VSLIDE[Y]
  1835.       Rem Double buffering smooths the effect  
  1836.       Screen Swap : Wait Vbl 
  1837.       For I=1 To 10
  1838.          Locate 5,2*I+1
  1839.          Print Mid$(K$(X+I-1),XL,70);
  1840.       Next I
  1841.       VSLIDE[Y]
  1842.    Loop 
  1843.    FIN:
  1844.    Screen Close 0
  1845.    Menu On 
  1846. End Proc
  1847. Procedure MAKEZONES
  1848.    Reserve Zone 20
  1849.    Set Zone 1,0,16 To 10,186
  1850.    For I=2 To 11
  1851.       Locate 5,(I-1)*2+1
  1852.       Print Zone$("     ",I)
  1853.    Next I
  1854.    Pen 3
  1855.    Locate 5,26 : Print Zone$(Border$("Help",1),12)
  1856.    Locate 15,26 : Print Zone$(Border$("Save",1),13)
  1857.    Locate 25,26 : Print Zone$(Border$("Print",1),14)
  1858.    Locate 35,26 : Print Zone$(Border$("Display",1),15)
  1859.    Locate 45,26 : Print Zone$(Border$("Insert",1),16)
  1860.    Locate 55,26 : Print Zone$(Border$("Delete",1),17)
  1861.    Locate 65,26 : Print Zone$(Border$("Finish",1),18)
  1862.    Locate 2,28 : Print Zone$(Border$("<",1),19)
  1863.    Locate 73,28 : Print Zone$(Border$(">",1),20)
  1864.    Pen 2
  1865. End Proc
  1866. Procedure VSLIDE[Y]
  1867.    Set Slider 1,1,3,1,3,3,3,1
  1868.    Rem Display a slider bar using the Vslider command 
  1869.    Vslider 0,16 To 10,186,170,Y,5
  1870. End Proc
  1871. Procedure ANSAVE
  1872.    On Error Goto ERRTRAP
  1873.    AA$="{Use | for /}   Save as ..."
  1874.    IX=Instr(K1$,"=")
  1875.    RETAINFV$=Mid$(K1$,IX+1)
  1876.    BB$=Lower$(RETAINFV$)
  1877.    L=Len(BB$)
  1878.    Do 
  1879.       C=Instr(BB$,"/")
  1880.       If C=0 Then Exit 
  1881.       BB$=Left$(BB$,C-1)+"|"+Right$(BB$,L-C)
  1882.    Loop 
  1883.    BB$=Left$(BB$,38)
  1884.    RETRYSAVE:
  1885.    FILESELECTQZ[Dir$,"SWITCH",BB$,AA$]
  1886.    If F$="" Then Goto NSV
  1887.    EXCLUDE_FROM_SAVE[F$]
  1888.    If TRY$="not ok"
  1889.       AA$="Disallowed ! Try Again ! Save as ..." : Goto RETRYSAVE
  1890.    End If 
  1891.    If Exist(F$) Then OVERWRITE
  1892.    If TRY$="not ok"
  1893.       AA$="Already Exists ! Try Again !" : Goto RETRYSAVE
  1894.    End If 
  1895.    Open Out 1,F$
  1896.    Print #1,K1$
  1897.    For IR=1 To N
  1898.       Print #1,K$(IR)
  1899.    Next IR
  1900.    Close 1
  1901.    Goto NSV
  1902.    ERRTRAP:
  1903.    AA$="Save Error: Quit|Retry "
  1904.    Resume RETRYSAVE
  1905.    NSV:
  1906. End Proc
  1907. Procedure EXCLUDE_FROM_SAVE[F$]
  1908.    IX=Instr(F$,":")
  1909.    If IX=0 Then TRY$="not ok" : Goto XIT
  1910.    FX$=Mid$(F$,IX+1)
  1911.    Restore NEWDATA
  1912.    Read NX
  1913.    IX=0
  1914.    Do 
  1915.       IX=IX+1
  1916.       Read A$
  1917.       If FX$=A$ Then TRY$="not ok" : Exit 
  1918.       If IX=NX Then TRY$="ok" : Exit 
  1919.    Loop 
  1920.    NEWDATA:
  1921.    Data 53
  1922.    Data ".info","Disk.info","CLI","CLI.info"
  1923.    Data "Prefs.info","PrReadMe","PrReadMe.info"
  1924.    Data "Evaluator","Evaluator.info","Evaluator.AMOS","EvReadMe","EvReadMe.info"
  1925.    Data "Selector","Selector.info","Selector.AMOS","SeReadMe","SeReadMe.info"
  1926.    Data "c/endcli","c/LoadWB","c/path","c/ppmore","c/Run"
  1927.    Data "devs/clipboard.device","devs/Mountlist","devs/narrator.device"
  1928.    Data "devs/parallel.device","devs/printer.device","devs/ramdrive.device"
  1929.    Data "devs/serial.device","devs/system-configuration"
  1930.    Data "devs/printers/custom","devs/printers/generic"
  1931.    Data "l/Disk-Validator","l/FastFileSystem","l/Port-Handler"
  1932.    Data "l/ram-handler","l/Speak-Handler"
  1933.    Data "libs/diskfont.library","libs/icon.library","libs/info.library"
  1934.    Data "libs/mathieeedoubbas.library","mathtrans.library","translator.library"
  1935.    Data "Prefs/.info","Prefs/Pointer.info","Prefs/Preferences"
  1936.    Data "Prefs/Preferences.info","Prefs/Printer.info","Prefs/Serial.info"
  1937.    Data "s/startup-sequence"
  1938.    Data "System/DiskCopy","System/FastMemFirst","System/Format"
  1939.    XIT:
  1940. End Proc
  1941. Procedure OVERWRITE
  1942.    On Error Goto ER
  1943.    Goto OK
  1944.    ER:
  1945.    ERR
  1946.    Resume XIT
  1947.    OK:
  1948.    Screen Open 2,320,56,4,Hires
  1949.    Screen Display 2,200,100,320,56
  1950.    Curs Off : Cls 1 : Colour 0,$A5
  1951.    If Len(F$)>43 Then Locate 0,1 : Centre "..."+Right$(F$,40)
  1952.    If Len(F$)<=43 Then Locate 0,1 : Centre F$
  1953.    Print : Print : Centre "/!\ file already exits /!\"
  1954.    Reserve Zone 
  1955.    Reserve Zone 2
  1956.    Paper 0
  1957.    Locate 5,5 : Print Zone$("Overwrite",1)
  1958.    Locate 25,5 : Print Zone$("  Retry  ",2)
  1959.    Do 
  1960.       If Mouse Zone=1 and Mouse Key Then TRY$="ok" : Exit 
  1961.       If Mouse Zone=2 and Mouse Key Then TRY$="not ok" : Exit 
  1962.    Loop 
  1963.    Screen Close 2
  1964.    XIT:
  1965. End Proc
  1966. Procedure ANSPT
  1967.    On Error Goto ER
  1968.    Goto OK
  1969.    ER:
  1970.    ERR
  1971.    Resume XIT
  1972.    OK:
  1973.    Lprint 
  1974.    Lprint K1$
  1975.    Lprint 
  1976.    For IR=1 To N
  1977.       Lprint K$(IR)
  1978.    Next IR
  1979.    Lprint 
  1980.    XIT:
  1981. End Proc
  1982. Procedure FLOAD
  1983.    On Error Goto ERTRAP
  1984.    A$="Select file" : B$="to display"
  1985.    RETRYLOAD:
  1986.    FILESELECTQZ[Dir$,"SWITCH",A$,B$]
  1987.    If F$="" Then Goto NSL
  1988.    Open In 1,F$
  1989.    Line Input #1,K1$
  1990.    I=0
  1991.    Do 
  1992.       If Eof(1) Then Exit 
  1993.       I=I+1
  1994.       Line Input #1,K$(I)
  1995.       If I=170 Then Exit 
  1996.    Loop 
  1997.    N=I
  1998.    Close 1
  1999.    Goto NSL
  2000.    ERTRAP:
  2001.    A$="Select Error!" : B$="Retry, or Quit"
  2002.    Close 1
  2003.    Resume RETRYLOAD
  2004.    NSL:
  2005. End Proc
  2006. Procedure DLNE
  2007.    On Error Goto ER
  2008.    Goto OK
  2009.    ER:
  2010.    ERR
  2011.    Rem Cannot stop deleting lines if ilack of memory for Screen 3 
  2012.    Resume XIT2
  2013.    OK:
  2014.    Screen Open 3,320,48,4,Hires
  2015.    Screen Display 3,200,100,320,48
  2016.    Curs Off : Cls 1 : Flash Off : Colour 3,$73
  2017.    Print : Centre "Confirm Delete"
  2018.    Print 
  2019.    Reserve Zone 2
  2020.    Reset Zone 
  2021.    Reserve Zone 2
  2022.    Paper 3
  2023.    Locate 15,3 : Print Zone$("Yes",1)
  2024.    Locate 23,3 : Print Zone$("No",2)
  2025.    Wait 50
  2026.    While Mouse Key<>0 : Wend 
  2027.    Do 
  2028.       If Mouse Key=1 and Mouse Zone=1 Then Exit 
  2029.       If Mouse Key=1 and Mouse Zone=2 Then Screen Close 3 : Goto XIT
  2030.    Loop 
  2031.    Screen Close 3
  2032.    XIT2:
  2033.    LINMBR=X+I-2
  2034.    If N=1 Then Goto SPECCASE
  2035.    If LINMER=N Then Goto SPECCASE
  2036.    For IR=LINMBR To N-1
  2037.       K$(IR)=K$(IR+1)
  2038.    Next IR
  2039.    SPECCASE:
  2040.    K$(N)=""
  2041.    N=N-1
  2042.    XIT:
  2043. End Proc
  2044. Procedure ILINE
  2045.    Rem If N>169 Then Goto XIT 
  2046.    If N<170 Then Goto OK
  2047.    Autoback 1
  2048.    Locate 0,26 : Cline : Centre "No more lines - 170 max....     RIGHT mouse key to continue"
  2049.    While Mouse Key<>2 : Wend 
  2050.    Wait 50
  2051.    Autoback 0
  2052.    Goto XIT
  2053.    OK:
  2054.    FDL=Instr(K1$,"=")
  2055.    If FDL=0 Then FRMULA : Goto XIT
  2056.    K11$=Left$(K1$,FDL)
  2057.    LINMER=X+I-2
  2058.    If LINMER=N Then Goto SPECIALCASE
  2059.    If N=1 Then Goto SPECIALCASE
  2060.    For IR=N+1 To LINMER+2 Step -1
  2061.       K$(IR)=K$(IR-1)
  2062.    Next IR
  2063.    SPECIALCASE:
  2064.    K$(LINMER+1)=""
  2065.    Autoback 1
  2066.    Locate 0,26 : Cline 
  2067.    Locate 10,26
  2068.    If Instr(K11$,"x")<>0 Then Input "x = ";X$ : K$(LINMER+1)=" x="+X$
  2069.    Locate 0,26 : Cline 
  2070.    Locate 10,26
  2071.    If Instr(K11$,"y")<>0 Then Input "y = ";Y$ : K$(LINMER+1)=K$(LINMER+1)+" y="+Y$
  2072.    Locate 0,26 : Cline 
  2073.    Locate 10,26
  2074.    If Instr(K11$,"z")<>0 Then Input "z = ";Z$ : K$(LINMER+1)=K$(LINMER+1)+" z="+Z$
  2075.    Locate 0,26 : Cline 
  2076.    Locate 10,26
  2077.    If Instr(K11$,"t")<>0 Then Input "t = ";T$ : K$(LINMER+1)=K$(LINMER+1)+" t="+T$
  2078.    Locate 0,26 : Cline 
  2079.    FV$=Mid$(K1$,6)
  2080.    If Instr(K11$,"y")<>0 Then FV$=Mid$(K1$,8)
  2081.    If Instr(K11$,"z")<>0 Then FV$=Mid$(K1$,10)
  2082.    If Instr(K11$,"t")<>0 Then FV$=Mid$(K1$,12)
  2083.    '
  2084.    EVAL["$",FV$,SIGFIGS]
  2085.    '
  2086.    If Instr(K11$,"t")<>0 Then K$(LINMER+1)=K$(LINMER+1)+" f(x,y,z,t)="+EVAL$ : Goto XXXX
  2087.    If Instr(K11$,"z")<>0 Then K$(LINMER+1)=K$(LINMER+1)+" f(x,y,z)="+EVAL$ : Goto XXXX
  2088.    If Instr(K11$,"y")<>0 Then K$(LINMER+1)=K$(LINMER+1)+" f(x,y)="+EVAL$ : Goto XXXX
  2089.    If Instr(K11$,"x")<>0 Then K$(LINMER+1)=K$(LINMER+1)+" f(x)="+EVAL$
  2090.    XXXX:
  2091.    N=N+1
  2092.    Autoback 0
  2093.    XIT:
  2094. End Proc
  2095. Procedure FRMULA
  2096.    LINMER=X+I-2
  2097.    If LINMER=N Then Goto SPECIALCASE
  2098.    If N=1 Then Goto SPECIALCASE
  2099.    For IR=N+1 To LINMER+2 Step -1
  2100.       K$(IR)=K$(IR-1)
  2101.    Next IR
  2102.    SPECIALCASE:
  2103.    K$(LINMER+1)=""
  2104.    FV$=Upper$(K1$)
  2105.    Autoback 1
  2106.    RETAINFV$=FV$
  2107.    '
  2108.    Rem Functions to lower case
  2109.    '
  2110.    Restore NWDT
  2111.    For J=1 To 26
  2112.       Read AV$
  2113.       BV$=Lower$(AV$)
  2114.       L=Len(AV$)
  2115.       Do 
  2116.          I=Instr(FV$,AV$)
  2117.          If I=0 Then Exit 
  2118.          FV$=Left$(FV$,I-1)+BV$+Mid$(FV$,I+L)
  2119.       Loop 
  2120.    Next J
  2121.    '
  2122.    Rem Replace upper case letters by 'numbers'
  2123.    For J=65 To 90
  2124.       Do 
  2125.          I=Instr(FV$,Chr$(J))
  2126.          If I=0 Then Exit 
  2127.          Locate 0,26 : Cline 
  2128.          Locate 10,26
  2129.          If J=65 Then Input "a = ";A$ : K$(LINMER+1)=K$(LINMER+1)+"a = "+A$+"  " : Exit 
  2130.          If J=66 Then Input "b = ";B$ : K$(LINMER+1)=K$(LINMER+1)+"b = "+B$+"  " : Exit 
  2131.          If J=67 Then Input "c = ";C$ : K$(LINMER+1)=K$(LINMER+1)+"c = "+C$+"  " : Exit 
  2132.          If J=68 Then Input "d = ";D$ : K$(LINMER+1)=K$(LINMER+1)+"d = "+D$+"  " : Exit 
  2133.          If J=69 Then Input "e = ";E$ : K$(LINMER+1)=K$(LINMER+1)+"e = "+E$+"  " : Exit 
  2134.          If J=70 Then Input "f = ";F$ : K$(LINMER+1)=K$(LINMER+1)+"f = "+F$+"  " : Exit 
  2135.          If J=71 Then Input "g = ";G$ : K$(LINMER+1)=K$(LINMER+1)+"g = "+G$+"  " : Exit 
  2136.          If J=72 Then Input "h = ";H$ : K$(LINMER+1)=K$(LINMER+1)+"h = "+H$+"  " : Exit 
  2137.          If J=73 Then Input "i = ";I$ : K$(LINMER+1)=K$(LINMER+1)+"i = "+I$+"  " : Exit 
  2138.          If J=74 Then Input "j = ";J$ : K$(LINMER+1)=K$(LINMER+1)+"j = "+J$+"  " : Exit 
  2139.          If J=75 Then Input "k = ";K$ : K$(LINMER+1)=K$(LINMER+1)+"k = "+K$+"  " : Exit 
  2140.          If J=76 Then Input "l = ";L$ : K$(LINMER+1)=K$(LINMER+1)+"l = "+L$+"  " : Exit 
  2141.          If J=77 Then Input "m = ";M$ : K$(LINMER+1)=K$(LINMER+1)+"m = "+M$+"  " : Exit 
  2142.          If J=78 Then Input "n = ";N$ : K$(LINMER+1)=K$(LINMER+1)+"n = "+N$+"  " : Exit 
  2143.          If J=79 Then Input "o = ";O$ : K$(LINMER+1)=K$(LINMER+1)+"o = "+O$+"  " : Exit 
  2144.          If J=80 Then Input "p = ";P$ : K$(LINMER+1)=K$(LINMER+1)+"p = "+P$+"  " : Exit 
  2145.          If J=81 Then Input "q = ";Q$ : K$(LINMER+1)=K$(LINMER+1)+"q = "+Q$+"  " : Exit 
  2146.          If J=82 Then Input "r = ";R$ : K$(LINMER+1)=K$(LINMER+1)+"r = "+R$+"  " : Exit 
  2147.          If J=83 Then Input "s = ";S$ : K$(LINMER+1)=K$(LINMER+1)+"s = "+S$+"  " : Exit 
  2148.          If J=84 Then Input "t = ";T$ : K$(LINMER+1)=K$(LINMER+1)+"t = "+T$+"  " : Exit 
  2149.          If J=85 Then Input "u = ";U$ : K$(LINMER+1)=K$(LINMER+1)+"u = "+U$+"  " : Exit 
  2150.          If J=86 Then Input "v = ";V$ : K$(LINMER+1)=K$(LINMER+1)+"v = "+V$+"  " : Exit 
  2151.          If J=87 Then Input "w = ";W$ : K$(LINMER+1)=K$(LINMER+1)+"w = "+W$+"  " : Exit 
  2152.          If J=88 Then Input "x = ";X$ : K$(LINMER+1)=K$(LINMER+1)+"x = "+X$+"  " : Exit 
  2153.          If J=89 Then Input "y = ";Y$ : K$(LINMER+1)=K$(LINMER+1)+"y = "+Y$+"  " : Exit 
  2154.          If J=90 Then Input "z = ";Z$ : K$(LINMER+1)=K$(LINMER+1)+"z = "+Z$+"  " : Exit 
  2155.       Loop 
  2156.    Next J
  2157.    '
  2158.    FV$=Upper$(FV$)
  2159.    '
  2160.    NWDT:
  2161.    Data "ACOS","ATAN","HSIN","HCOS","HTAN","SIN","COS","TAN","LOG","EXP","SQR","ABS","INT","SGN","LN"
  2162.    Data "0E","1E","2E","3E","4E","5E","6E","7E","8E","9E","PI"
  2163.    '
  2164.    EVAL["$",FV$,SIGFIGS]
  2165.    '
  2166.    K$(LINMER+1)=K$(LINMER+1)+K1$+" = "+EVAL$
  2167.    XXXX:
  2168.    N=N+1
  2169.    Autoback 0
  2170.    XIT:
  2171. End Proc
  2172. '
  2173. Rem Files
  2174. '
  2175. Procedure RUBOUT
  2176.    RBOUT:
  2177.    A$="Delete a File" : B$="IRREVERSIBLE - Quit to leave"
  2178.    On Error Goto ER
  2179.    Goto OK
  2180.    ER:
  2181.    A$="/!\Error! Delete a File"
  2182.    Resume OK
  2183.    OK:
  2184.    Do 
  2185.       FILESELECTQZ[FF$,"SWITCH","Delete a File","IRREVERSIBLE - Quit to leave"] : SD
  2186.       If F$="" Then Goto XIT
  2187.       Kill F$
  2188.    Loop 
  2189.    Goto RBOUT
  2190.    XIT:
  2191. End Proc
  2192. Procedure RETITLE
  2193.    On Error Goto ER
  2194.    Goto OK
  2195.    ER:
  2196.    ERR
  2197.    Resume XIT
  2198.    OK:
  2199.    FG$=FF$
  2200.    Dir$=FF$
  2201.    RETIT:
  2202.    FILESELECTQZ[FG$,"SWITCH"," Select File to Retitle"," Quit to Leave "]
  2203.    If F$="" Then Goto XIT
  2204.    '
  2205.    Rem Temp Dir Change
  2206.    FG$=Flip$(Dir$)
  2207.    If Instr(FG$,"/")<>0
  2208.       FG$=Mid$(FG$,Instr(FG$,"/")) : FG$=Flip$(FG$) : Goto OK2
  2209.    End If 
  2210.    If Instr(FG$,":")<>0
  2211.       FG$=Mid$(FG$,Instr(FG$,":")) : FG$=Flip$(FG$) : Goto OK2
  2212.    End If 
  2213.    OK2:
  2214.    '
  2215.    L=Len(F$)
  2216.    If L<=28 Then A$=" ReName: "+F$
  2217.    If L>28 Then A$=" ReName: ... "+Right$(F$,25)
  2218.    KEEPKEEPF$=F$
  2219.    FILESELECTQZ[FG$,"SWITCH",A$," as . . ."]
  2220.    G$=F$
  2221.    F$=KEEPKEEPF$
  2222.    If G$="" Then Goto XIT
  2223.    Rename F$ To G$
  2224.    Goto RETIT
  2225.    XIT:
  2226.    Curs Off 
  2227. End Proc
  2228. Procedure CPY
  2229.    Clear Key 
  2230.    On Error Goto ER
  2231.    Goto OK
  2232.    ER:
  2233.    ERR
  2234.    Resume XIT
  2235.    OK:
  2236.    Do 
  2237.       Erase 6
  2238.       FILESELECTQZ[FF$,"SWITCH","Select File to Copy",""] : SD
  2239.       If F$="" Then Goto XIT
  2240.       KEEPKEEPF$=F$
  2241.       FILESELECTQZ[GG$,"SWITCH",Right$(F$,38),"Copy to"]
  2242.       G$=F$
  2243.       F$=KEEPKEEPF$
  2244.       SDG
  2245.       If G$="" Then Goto XIT
  2246.       Open In 1,F$ : LFILE=Lof(1) : Close 1
  2247.       Reserve As Work 6,LFILE
  2248.       Bload F$,Start(6)
  2249.       Bsave G$,Start(6) To Start(6)+LFILE
  2250.    Loop 
  2251.    XIT:
  2252.    Erase 6
  2253. End Proc
  2254. Procedure MDIR
  2255.    Clear Key 
  2256.    On Error Goto ER
  2257.    Goto OK
  2258.    ER:
  2259.    ERR
  2260.    Resume XIT
  2261.    OK:
  2262.    Screen Open 1,320,56,4,Hires
  2263.    Screen Display 1,200,100,320,56
  2264.    Curs Off : Cls 1
  2265.    Print : Centre "Make Directory"
  2266.    Print : Print : Centre "Enter new directory {eg df0:new}"
  2267.    Print : Print 
  2268.    Input " ";NDIR$
  2269.    Curs Off 
  2270.    On Error Goto ER2
  2271.    Goto OK2
  2272.    ER2:
  2273.    Screen Close 1
  2274.    ERR
  2275.    Resume XIT
  2276.    OK2:
  2277.    Mkdir NDIR$
  2278.    Screen Close 1
  2279.    XIT:
  2280. End Proc
  2281. Procedure ERASDIR
  2282.    Clear Key 
  2283.    On Error Goto ER
  2284.    Goto OK
  2285.    ER:
  2286.    ERR
  2287.    Resume XIT
  2288.    OK:
  2289.    Screen Open 1,320,48,4,Hires
  2290.    Screen Display 1,200,100,320,48
  2291.    Curs Off : Cls 1
  2292.    Print : Centre "Enter EMPTY directory {eg df0:new}"
  2293.    Print : Print 
  2294.    Input " Erase ";NDIR$
  2295.    Curs Off 
  2296.    Dreg(1)=Varptr(NDIR$)
  2297.    H=Doscall(-72)
  2298.    If H<>0 Then Goto XIT2
  2299.    If H=0 Then Centre "Not Done."
  2300.    Do : Exit If Mouse Key=1 : Loop 
  2301.    XIT2:
  2302.    Wait 50
  2303.    Screen Close 1
  2304.    XIT:
  2305. End Proc
  2306. Procedure BYFREE
  2307.    Clear Key 
  2308.    On Error Goto ER
  2309.    Goto OK
  2310.    ER:
  2311.    ERR
  2312.    Resume XIT
  2313.    OK:
  2314.    Screen Open 1,320,64,4,Hires
  2315.    Screen Display 1,200,100,320,64
  2316.    Curs Off : Cls 1
  2317.    Print : Centre " Free Memory (bytes) "
  2318.    Print 
  2319.    Print : Centre " Disk "+Str$(Dfree)
  2320.    Print : Centre "{"+"Chip:"+Str$(Chip Free)+"   "+"Fast:"+Str$(Fast Free)+"}"
  2321.    Print 
  2322.    Print : Centre "Press Left Mouse Key"
  2323.    Wait 50
  2324.    Do : Exit If Mouse Key=1 : Loop 
  2325.    Screen Close 1
  2326.    XIT:
  2327. End Proc
  2328. Procedure SD
  2329.    Rem Automatic Directory Setter 
  2330.    Rem Global FF$ : FF$=Dir$ needed at start    
  2331.    Rem After file selector {using Fsel$...} append : SD 
  2332.    If F$="" Then Goto XIT
  2333.    KEEPFF$=FF$
  2334.    FF$=F$
  2335.    I10=Instr(FF$,":")
  2336.    FF2$=Right$(FF$,Len(FF$)-I10)
  2337.    If Instr(FF2$,":")<>0 Then FF$=KEEPFF$ : Goto XIT
  2338.    FF$=Flip$(FF$)
  2339.    I11=Instr(FF$,"/")
  2340.    If I11=0 Then FF$=Left$(Flip$(FF$),I10) : Goto XIT
  2341.    FF$=Left$(Flip$(FF$),(Len(FF$)-I11+1))
  2342.    XIT:
  2343. End Proc
  2344. Procedure SDG
  2345.    If G$="" Then Goto XIT
  2346.    KEEPGG$=GG$
  2347.    GG$=G$
  2348.    I10=Instr(GG$,":")
  2349.    GG2$=Right$(GG$,Len(GG$)-I10)
  2350.    If Instr(GG2$,":")<>0 Then GG$=KEEPGG$ : Goto XIT
  2351.    GG$=Flip$(GG$)
  2352.    I11=Instr(GG$,"/")
  2353.    If I11=0 Then GG$=Left$(Flip$(GG$),I10) : Goto XIT
  2354.    GG$=Left$(Flip$(GG$),(Len(GG$)-I11+1))
  2355.    XIT:
  2356. End Proc
  2357. '
  2358. Rem
  2359. Procedure ERRING
  2360.    On Error Goto ER
  2361.    Goto OK
  2362.    ER:
  2363.    ERR
  2364.    Resume XIT
  2365.    OK:
  2366.    XIT:
  2367. End Proc
  2368. Rem
  2369. Procedure ERR
  2370.    On Error Goto ER
  2371.    Goto OK
  2372.    ER:
  2373.    Resume XIT
  2374.    OK:
  2375.    Screen Open 3,320,48,4,Hires
  2376.    Screen Display 3,200,100,320,48
  2377.    Curs Off : Cls 1
  2378.    Print : Centre "Error - Out of Memory/Range?"
  2379.    Print 
  2380.    Print : Centre "Press Left Mouse Key"
  2381.    Wait 50
  2382.    Do : Exit If Mouse Key=1 : Loop 
  2383.    Screen Close 3
  2384.    XIT:
  2385. End Proc
  2386. Rem
  2387. '
  2388. '
  2389. Rem Own File Selector
  2390. '
  2391. 'Global F$ 
  2392. '
  2393. 'Dim LQZ$(200),MITQZ$(70)
  2394. 'Global LQZ$(),FLEQZ$,MITQZ$(),LLQZ$ 
  2395. 'Global DRECTORYQZ$,MESSAGE1QZ$,MESSAGE2QZ$
  2396. 'Global NQZ,XQZ,IQZ
  2397. '
  2398. 'FILESELECTQZ[Dir$,"SWITCH","Please Select","a File"]  
  2399. Procedure FILESELECTQZ[DRECTORYQZ$,SWITCH$,MESSAGE1QZ$,MESSAGE2QZ$]
  2400.    '''''''''''''''''''''''''''''''''''''''''''''' 
  2401.    If Not Exist(DRECTORYQZ$) Then ERR : Goto XIT5
  2402.    If SWITCH$="-AMOS-"
  2403.       F$=Fsel$(DRECTORYQZ$,"",MESSAGE1QZ$,MESSAGE2QZ$) : Goto XIT5
  2404.    End If 
  2405.    If SWITCH$="CUSTOM"
  2406.       Goto FRESH
  2407.    End If 
  2408.    MARKQZ$=""
  2409.    On Error Goto ER3
  2410.    Goto OK3
  2411.    ER3:
  2412.    ERR
  2413.    MARKQZ$="SP"
  2414.    Resume XIT4
  2415.    OK3:
  2416.    Screen Open 1,320,56,4,Hires
  2417.    Screen Display 1,200,100,320,56
  2418.    Curs Off : Cls 1 : Colour 0,$70
  2419.    Locate 0,1 : Centre "Single File Selector"
  2420.    Locate 0,5 : Centre "Choose Preferred"
  2421.    Reserve Zone 
  2422.    Reserve Zone 2
  2423.    Paper 0
  2424.    Locate 12,3 : Print Zone$("-AMOS-",1);
  2425.    Locate 22,3 : Print Zone$("CUSTOM",2)
  2426.    Do 
  2427.       If Mouse Zone=1 and Mouse Key Then Screen Close 1 : F$=Fsel$(DRECTORYQZ$,"",MESSAGE1QZ$,MESSAGE2QZ$) : Goto XIT5
  2428.       If Mouse Zone=2 and Mouse Key Then Exit 
  2429.    Loop 
  2430.    Screen Close 1
  2431.    '''''''''''''''''''''''''''''''''''''''''''''''''''''
  2432.    FRESH:
  2433.    If Right$(DRECTORYQZ$,1)="/" Then DRECTORYQZ$=Left$(DRECTORYQZ$,Len(DRECTORYQZ$)-1)
  2434.    NQZ=0
  2435.    On Error Goto ER
  2436.    Goto OK
  2437.    ER:
  2438.    ERR
  2439.    Resume XIT
  2440.    OK:
  2441.    FLEQZ$=""
  2442.    Gosub WN1DIR
  2443.    Screen Open 2,640,192,4,Hires
  2444.    Flash Off : Curs Off 
  2445.    If CRQZ=0 : Colour 0,$7A : End If 
  2446.    If CRQZ=1 : Colour 0,$390 : End If 
  2447.    If CRQZ=2 : Colour 0,$A77 : End If 
  2448.    If CRQZ=3 : Colour 0,$BB5 : End If 
  2449.    Colour 1,$700 : Paper 0 : Cls 0 : Colour 3,$FF0
  2450.    Screen Display 2,140,65,320,192
  2451.    Wind Open 1,0,0,40,24 : Paper 0 : Curs Off 
  2452.    '   Wind Open 2,320,0,40,24 : Paper 0 : Curs Off 
  2453.    Wind Open 2,320,0,40,24 : Paper 0 : Curs Off 
  2454.    Gosub SELECTOR_WINDOWS
  2455.    WN1DIR:
  2456.    Gosub RESET
  2457.    NQZ=1
  2458.    FFQZ$=DRECTORYQZ$
  2459.    LQZ$(1)=Dir First$(DRECTORYQZ$)
  2460.    Do 
  2461.       NQZ=NQZ+1
  2462.       LQZ$(NQZ)=Dir Next$
  2463.       If LQZ$(NQZ)="" Then NQZ=NQZ-1 : Exit 
  2464.    Loop 
  2465.    Return 
  2466.    SELECTOR_WINDOWS:
  2467.    RESTART:
  2468.    Y Mouse=Y Hard(0)
  2469.    WN1:
  2470.    XQZ=1
  2471.    REASYLOOK:
  2472.    Window 2 : Pen 1
  2473.    Locate 0,0 : Cline : Pen 1 : Centre "Single File Selector"
  2474.    Locate 0,2 : Cline : Centre MESSAGE1QZ$
  2475.    Locate 0,3 : Cline : Centre MESSAGE2QZ$
  2476.    Window 1 : Pen 1
  2477.    Locate 0,0 : Cline : Centre "Source" : Ink 3 : Box 1,1 To 30,3
  2478.    WN12:
  2479.    XQZ=1
  2480.    MESSAGEQZ$=Left$(DRECTORYQZ$,30)+"..."
  2481.    Locate 0,22 : Cline : Pen 1 : Centre MESSAGEQZ$
  2482.    REASYLOOK2:
  2483.    XKQZ=0
  2484.    PLQZ=0 : Gosub MAKEFSZONES
  2485.    Pen 2
  2486.    Rem main loop
  2487.    Do 
  2488.       For IQZ=2 To 21
  2489.          '
  2490.          If Mouse Zone=IQZ and Mouse Key and Instr(LQZ$(XQZ+IQZ-2)," ")=1 Then Gosub GTFILE : Gosub SEEFILE : Goto REASYLOOK2
  2491.          If Mouse Zone=IQZ and Mouse Key and Instr(LQZ$(XQZ+IQZ-2),"*")=1 Then Gosub GTDIREC : Gosub RESET : Gosub SEEFILE : Gosub WN1DIR : Y Mouse=Y Hard(0) : Goto WN12
  2492.       Next IQZ
  2493.       If Mouse Zone=22 and Mouse Key Then While Mouse Key<>0 : Screen Display 2,140,Y Mouse,320,192 : Wend 
  2494.       If Mouse Zone=23 and Mouse Key
  2495.          CRQZ=(CRQZ+1) mod 4
  2496.          If CRQZ=0 : Colour 0,$7A : End If 
  2497.          If CRQZ=1 : Colour 0,$390 : End If 
  2498.          If CRQZ=2 : Colour 0,$A77 : End If 
  2499.          If CRQZ=3 : Colour 0,$BB5 : End If 
  2500.          While Mouse Key<>0 : Wend 
  2501.       End If 
  2502.       If Mouse Zone=24 and Mouse Key Then PLQZ=24 : Gosub MAKEFSZONES : Gosub GTPAR : Gosub RESET : Gosub SEEFILE : Gosub WN1DIR : Goto WN12
  2503.       If Mouse Zone=25 and Mouse Key Then PLQZ=25 : Gosub MAKEFSZONES : GTNEWDRECTORYQZ : Gosub RESET : Gosub SEEFILE : Gosub WN1DIR : Y Mouse=Y Hard(0) : Goto WN12
  2504.       If Mouse Zone=26 and Mouse Key Then PLQZ=26 : Gosub MAKEFSZONES : GTANOTHERFILEQZ : PLQZ=0 : Gosub MAKEFSZONES : Gosub SEEFILE : Goto REASYLOOK2
  2505.       If Mouse Zone=27 and Mouse Key Then F$=FLEQZ$ : Goto XIT
  2506.       If Mouse Zone=28 and Mouse Key Then F$="" : Goto XIT
  2507.       If Mouse Zone=29 and Mouse Key and XQZ<NQZ-15 Then XQZ=XQZ+1
  2508.       If Mouse Zone=30 and Mouse Key and XQZ>1 Then XQZ=XQZ-1
  2509.       Rem Update display 
  2510.       If XQZ<>XKQZ
  2511.          XKQZ=XQZ
  2512.          For IQZ=1 To 20
  2513.             Locate 2,IQZ : Cline 
  2514.             If Mouse Zone=IQZ+1
  2515.                Inverse On 
  2516.             End If 
  2517.             Print Left$(LQZ$(XQZ+IQZ-1),38);
  2518.             Inverse Off 
  2519.          Next IQZ
  2520.       End If 
  2521.    Loop 
  2522.    Return 
  2523.    MAKEFSZONES:
  2524.    MITQZ$(24)="    Parent   "
  2525.    MITQZ$(25)="New Directory"
  2526.    MITQZ$(26)="   New File  "
  2527.    MITQZ$(27)="     Ok      "
  2528.    MITQZ$(28)="     Quit    "
  2529.    Reserve Zone 
  2530.    Reserve Zone 30
  2531.    Set Zone 22,0,0 To 25,5
  2532.    Writing 1
  2533.    For IQZ=2 To 21
  2534.       Locate 3,IQZ-1
  2535.       Print Zone$("           ",IQZ)
  2536.    Next IQZ
  2537.    Writing 0
  2538.    Window 2
  2539.    For IIQZ=24 To 28
  2540.       Pen 3 : Ink 3
  2541.       If IIQZ=PLQZ Then Pen 1 : Ink 1
  2542.       Locate 14,(IIQZ-24)*2+6 : Print Zone$(MITQZ$(IIQZ),IIQZ);
  2543.       L=Len(MITQZ$(IIQZ))
  2544.       XB1QZ=X Graphic(X Curs-L) : YB1QZ=Y Graphic(Y Curs)
  2545.       XB2QZ=X Graphic(X Curs) : YB2QZ=Y Graphic(Y Curs+1)-1
  2546.       Box XB1QZ-2,YB1QZ To XB2QZ+2,YB2QZ
  2547.    Next IIQZ
  2548.    Window 1
  2549.    Pen 3
  2550.    Locate 5,0 : Print Zone$(Chr$(147)+Chr$(148),29);
  2551.    Locate 8,0 : Print Zone$(Chr$(149)+Chr$(150),30);
  2552.    Locate 12,0 : Print Zone$("*",23);
  2553.    Pen 2
  2554.    Return 
  2555.    RESET:
  2556.    For IQZ=1 To 200 : LQZ$(IQZ)="" : Next IQZ
  2557.    FLEQZ$="" : LLQZ$=""
  2558.    Return 
  2559.    SEEFILE:
  2560.    Window 2
  2561.    Pen 2
  2562.    Locate 0,22 : Autoback 1 : Cline 
  2563.    Centre LLQZ$ : F$=FLEQZ$
  2564.    Pen 3
  2565.    Window 1
  2566.    Return 
  2567.    GTFILE:
  2568.    Rem Assuming file {lqz$(xqz+iqz-2)} has no 'double-space' !  
  2569.    POSN=Instr(LQZ$(XQZ+IQZ-2),"  ")
  2570.    LLQZ$=Left$(LQZ$(XQZ+IQZ-2),POSN-1)
  2571.    POSN=Instr(LLQZ$," ") : LLQZ$=Mid$(LLQZ$,POSN+1)
  2572.    If(Right$(DRECTORYQZ$,1)=":") Then FLEQZ$=DRECTORYQZ$+LLQZ$ : Goto XITGTFILE
  2573.    If(Right$(DRECTORYQZ$,1)="/") Then FLEQZ$=DRECTORYQZ$+LLQZ$ : Goto XITGTFILE
  2574.    If(Right$(DRECTORYQZ$,1)<>":") Then FLEQZ$=DRECTORYQZ$+"/"+LLQZ$ : Goto XITGTFILE
  2575.    XITGTFILE:
  2576.    Return 
  2577.    GTPAR:
  2578.    If Right$(DRECTORYQZ$,1)=":" Then Goto XITGTPAR
  2579.    POSIONQZ=Instr(Flip$(DRECTORYQZ$),"/")
  2580.    POSION2QZ=Instr(Flip$(DRECTORYQZ$),":")
  2581.    If POSIONQZ<>0 Then DRECTORYQZ$=Left$(DRECTORYQZ$,Len(DRECTORYQZ$)-POSIONQZ)
  2582.    If POSIONQZ=0 Then DRECTORYQZ$=Left$(DRECTORYQZ$,Len(DRECTORYQZ$)-POSION2QZ+1)
  2583.    XITGTPAR:
  2584.    Return 
  2585.    GTDIREC:
  2586.    Rem Assuming directory has no 'double space' ! 
  2587.    POSN=Instr(LQZ$(XQZ+IQZ-2),"  ")
  2588.    If Right$(DRECTORYQZ$,1)=":" Then DRECTORYQZ$=DRECTORYQZ$+Mid$(LQZ$(XQZ+IQZ-2),2,POSN-2) : Goto XITGTDIREC
  2589.    If Right$(DRECTORYQZ$,1)<>":" Then DRECTORYQZ$=DRECTORYQZ$+"/"+Mid$(LQZ$(XQZ+IQZ-2),2,POSN-2)
  2590.    XITGTDIREC:
  2591.    Return 
  2592.    XIT:
  2593.    If Not Exist(DRECTORYQZ$) Then ERR : Goto RESTART
  2594.    While Mouse Key<>0 : Wend 
  2595.    Screen Close 2
  2596.    XIT4:
  2597.    If MARKQZ$="SP"
  2598.       On Error Goto ER5
  2599.       Goto OK5
  2600.       ER5:
  2601.       ERR
  2602.       Resume XIT5
  2603.       OK5:
  2604.       F$=Fsel$(DRECTORYQZ$,"",MESSAGE1QZ$,MESSAGE2QZ$)
  2605.    End If 
  2606.    XIT5:
  2607.    While Mouse Key<>0 : Wend 
  2608. End Proc
  2609. Procedure GTANOTHERFILEQZ
  2610.    Clear Key 
  2611.    On Error Goto ER
  2612.    Goto OK
  2613.    ER:
  2614.    ERR
  2615.    Resume XIT
  2616.    OK:
  2617.    Screen Open 1,320,48,4,Hires
  2618.    Screen Display 1,200,100,320,48
  2619.    Curs Off : Cls 1 : Colour 0,$70
  2620.    Print : Centre "Enter file name required"
  2621.    Print : Print 
  2622.    Wind Open 1,32,32,30,1 : Paper 2 : Pen 1 : Clw 
  2623.    Input " ";LLQZ$
  2624.    Curs Off 
  2625.    '   Wait 50
  2626.    If LLQZ$="" Then Goto XIT2
  2627.    If(Right$(DRECTORYQZ$,1)=":") Then FLEQZ$=DRECTORYQZ$+LLQZ$ : Goto XIT2
  2628.    If(Right$(DRECTORYQZ$,1)<>":") Then FLEQZ$=DRECTORYQZ$+"/"+LLQZ$ : Goto XIT2
  2629.    XIT2:
  2630.    Screen Close 1
  2631.    XIT:
  2632. End Proc
  2633. Procedure GTNEWDRECTORYQZ
  2634.    Dim DITQZ$(11)
  2635.    On Error Goto ER
  2636.    Goto OK
  2637.    ER:
  2638.    ERR
  2639.    Resume XIT
  2640.    OK:
  2641.    Screen Open 1,320,56,4,Hires
  2642.    Screen Display 1,200,100,320,56
  2643.    Curs Off : Cls 1 : Colour 0,$70
  2644.    Print : Centre "Select New Directory"
  2645.    DITQZ$(1)="DF0:"
  2646.    DITQZ$(2)="DF1:"
  2647.    DITQZ$(3)="DH0:"
  2648.    DITQZ$(4)="DH1:"
  2649.    DITQZ$(5)="DH2:"
  2650.    DITQZ$(6)="DH3:"
  2651.    DITQZ$(7)="DH4:"
  2652.    DITQZ$(8)="DH5:"
  2653.    DITQZ$(9)="DH6:"
  2654.    DITQZ$(10)="DH7:"
  2655.    DITQZ$(11)="Other"
  2656.    Reserve Zone 
  2657.    Reserve Zone 11
  2658.    Paper 0 : Locate 0,3
  2659.    For IIQZ=1 To 6
  2660.       If Exist(DITQZ$(IIQZ)) Then Cright : Print Zone$(DITQZ$(IIQZ),IIQZ);
  2661.    Next IIQZ
  2662.    Locate 0,5
  2663.    For IIQZ=7 To 10
  2664.       If Exist(DITQZ$(IIQZ)) Then Cright : Print Zone$(DITQZ$(IIQZ),IIQZ);
  2665.    Next IIQZ
  2666.    Locate 30,5
  2667.    Print Zone$(DITQZ$(11),11)
  2668.    Do 
  2669.       For IQZ=1 To 10
  2670.          If Mouse Zone=IQZ and Mouse Key
  2671.             If Exist(DITQZ$(IQZ))
  2672.                DRECTORYQZ$=DITQZ$(IQZ) : Dir$=DITQZ$(IQZ) : Goto XIT
  2673.             End If 
  2674.          End If 
  2675.       Next IQZ
  2676.       If Mouse Zone=11 and Mouse Key Then Exit 
  2677.    Loop 
  2678.    Cls 1 : Paper 1 : Home 
  2679.    Locate 0,2 : Centre "Directory Change"
  2680.    RETRY:
  2681.    Locate 0,4 : Input " Enter New Directory ";DRECTORY3QZ$
  2682.    If(DRECTORY3QZ$="") or(DRECTORY3QZ$=":") Then Goto XIT
  2683.    If Instr(DRECTORY3QZ$,":")=0 Then Cls : Locate 0,1 : Centre "Error - No ':' detected" : Goto RETRY
  2684.    If Right$(DRECTORY3QZ$,1)="/" Then DRECTORY3QZ$=Left$(DRECTORY3QZ$,Len(DRECTORY3QZ$)-1)
  2685.    If Not Exist(DRECTORY3QZ$) Then Cls : Locate 0,1 : Centre "Directory Not Found" : Goto RETRY
  2686.    DRECTORYQZ$=DRECTORY3QZ$
  2687.    XIT:
  2688.    Screen Close 1
  2689. End Proc
  2690. '
  2691. Rem                         ***********  
  2692. Rem                        **** End ****   
  2693. Rem      ***************************************************