home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / batutl / bed11.arc / BEDLIB.BAS < prev    next >
BASIC Source File  |  1985-12-08  |  23KB  |  768 lines
  1. SUB CREDITS STATIC
  2.  
  3. REM PUTS UP CREDITS WHEN PROGRAM INVOKED
  4.  
  5. DEFINT A-Z
  6. SEC = 3
  7. CLS
  8. KEY OFF
  9.  
  10. RO=01:CO=30:X$="BATCH EDIT"
  11. CALL QPRINT (X$,RO,CO)
  12. RO=02:CO=23:X$="ver 1.1  December 7, 1985"
  13. CALL QPRINT (X$,RO,CO)
  14. RO=04:CO=03:X$="Copyright (c) 1985  Ken Goosens, 5020 Portsmouth Road, Fairfax, VA 22032"
  15. CALL QPRINT (X$,RO,CO)
  16. RO=07:CO=02:X$="You are granted a limited license to use and distribute this program provided"
  17. CALL QPRINT (X$,RO,CO)
  18. RO=09:CO=15:X$="1.  you do not alter or remove this notice"
  19. CALL QPRINT (X$,RO,CO)
  20. RO=11:CO=15:X$="2.  you receive no fee or charge for this program"
  21. CALL QPRINT (X$,RO,CO)
  22. RO=13:CO=15:X$="3.  you assume all liability for using this program"
  23. CALL QPRINT (X$,RO,CO)
  24. CALL WAITSECORKEY (SEC)
  25.  
  26. END SUB
  27.  
  28. SUB INITIALIZE (NUMFLDS%,YNVAL$(1),ROW%(1),COL%(1),PROMPT$(1),_
  29.                 FLDSIZE%(1),FLDTYPE$(1),FLDVAL$(1),HLP$(1)) STATIC
  30.  
  31. REM READS IN A TABLE DEFINING SCREEN AND FIELDS 
  32. REM PASS NUMFLD% - Number of fields to print on screen
  33. REM YNVAL$    - Whether field preceded by Y/N field
  34. REM ROW%      - Row where field prompt is on screen
  35. REM COL%      - Column on screen where field prompt begins
  36. REM PROMPT$   - Field prompt
  37. REM FLDSIZE%  - Size of input field to right of prompt
  38. REM FLDTYPE$  - Type of field - L = LABEL, no field inputted
  39. REM                           - N = natural number (0,1,2,3,...)
  40. REM                           - S = variable length string
  41. REM FLDVAL$   - Default field value - displayed, retained if press <rtn>
  42. REM HLP$      - Explanation of field displayed on bottom of screen
  43.  
  44. DEFINT A-Z
  45. FOR I=1 TO NUMFLDS%
  46.   READ YNVAL$(I),ROW%(I),COL%(I),PROMPT$(I),FLDSIZE%(I),_
  47.                 FLDTYPE$(I),FLDVAL$(I),HLP$(I)
  48. NEXT
  49.  
  50. DATA  ,01,23,B A T C H   E D I T O R       Ver 1.1,00,L,   ,
  51. DATA  ,03,02,"READ:"                              ,33,S,   ,"Name of file that is to be changed (e.g. TEST.DAT)"
  52. DATA  ,03,42,"WRITE:"                             ,30,S,   ,"Name of file to write changed lines to (e.g. TEST.EDI)"
  53. DATA  ,04,02,"Save specs in:"                     ,24,S,   ,"File to save these editing specifications in (e.g. TEST.SPC)"
  54. DATA  ,05,48,EXCLUDE LINES                        ,00,L,   ,
  55. DATA N,07,44,With a length less than              ,10,N,1  ,"Drop lines shorter than a minimum (e.g. empty lines)"
  56. DATA N,08,44,"With a word in:"                    ,20,S,   ,"Drop lines containing any line in file (e.g. headers with 'PAGE')"
  57. DATA N,09,44,With a length greater than           ,05,N,999,"Drop lines longer than a maximum"
  58. DATA N,10,44,"Save lines in:"                     ,21,S,   ,"Put excluded lines in a file so can review (e.g. TEST.EXC)"
  59. DATA  ,06,08,REPLACE                              ,00,L,   ,
  60. DATA N,08,04,Convert to upper case                ,00, ,   ,"Change all characters to upper case [abc...z -> ABC...Z]"
  61. DATA N,09,04,"Global srch/rep in:"                ,15,S,   ,"File of words with substitutes: <old>,<new>  e.g. 'Dec 85' -> 'Jan 86' "
  62. DATA N,10,04,"Delete these chars:"                ,16,S,   ,"Omit all instances of all these characters"
  63. DATA N,11,04,"Translate from:"                    ,17,S,$  ,"Characters to be individually replaced (e.g. $ %)"
  64. DATA  ,12,04,"            to:"                    ,17,S," ","Replacement characters for above (e.g. blank for $,%)"
  65. DATA  ,14,08,FIX LINE LENGTH                      ,00,L,   ,
  66. DATA N,16,04,Pad/blanks lines shorter than        ,05,N,1  ,"Set minimum length for output, right fill blanks"
  67. DATA  ,18,08,"EDIT NUMBERS [commas, () ]"         ,00,L,   ,
  68. DATA N,20,04,Convert parentheses to minus sign    ,00, ,   ,"Convert # in parentheses to negative (e.g. '(378.56)' -> '-378.56 ')"
  69. DATA N,21,04,Omit commas                          ,00, ,   ,"Remove commas inside numbers (e.g. 1,800,412.5 -> 1800412.5)"
  70. DATA N,22,04,"..right delimited?"                 ,00, ,   ,"Do numbers end on right with a non-numeric character? (e.g. 12 285.4VA)"
  71. DATA  ,23,04,"..Maximum # decimals:"              ,02,N,0  ,"Maximum # digits after decimal point (e.g. 17.125 has 3)"
  72. DATA  ,12,48,"EDIT DATES (omit sep,reorder)"      ,00,L,   ,
  73. DATA  ,14,44,"# digits in input year:"            ,01,N,2  ,"In data to edit, # digits in year (e.g. 86 is 2, 1986 is 4)"
  74. DATA  ,15,44,"# digits in output year:"           ,01,N,2  ,"# digits you want written out for a year (1986 is all 4, 86 is last 2)"
  75. DATA  ,16,44,"Separator btw Day,Month,Year:"      ,01,S,-  ,"In data to edit, what is btw M,D,Y (e.g. for '12/24/86' is '/')"
  76. DATA N,17,44,Edit date with spelled month         ,00, ,   ,"Edit date where month is first 3 letters (e.g. '11-Oct-86')"
  77. DATA  ,18,44,"..Input date format:"               ,03,S,DMY,"In incoming data to edit, order of Day,Month,Year (e.g. 11-Feb-86 is DMY)"
  78. DATA  ,19,44,"..Output date format:"              ,03,S,YMD,"Desired order of output (e.g. YMD takes '11-Feb-86' to 860211)"
  79. DATA N,20,44,Edit numeric dates                   ,00, ,   ,"Edit dates where numbers used for D,M,Y (e.g. 10-24-86)"
  80. DATA  ,21,44,"..Input date format:"               ,03,S,MDY,"In incoming data to edit, order of Day,Month,Year (e.g. 10-24-86 is MDY)"
  81. DATA  ,22,44,"..Output date format:"              ,03,S,YMD,"Desired order of date in output (e.g. YMD is 861024)"
  82.  
  83. END SUB
  84.  
  85. SUB PRTSCRN (NUMFLDS%,YNVAL$(1),ROW%(1),COL%(1),PROMPT$(1),FLDSIZE%(1),_
  86.                 FLDTYPE$(1),FLDVAL$(1),HLP$(1)) STATIC
  87.  
  88. REM PRINTS TABLE DRIVEN SCREEN
  89.  
  90. DEFINT A-Z
  91. CLS
  92. FOR I=1 TO NUMFLDS%
  93.   IF YNVAL$(I)<>"" THEN_
  94.       CO% = COL%(I)-3:_
  95.       CALL QPRINT (YNVAL$(I),ROW%(I),CO%)
  96.   CALL QPRINT (PROMPT$(I),ROW%(I),COL%(I))
  97.   X% = COL%(I)+LEN(PROMPT$(I))+1
  98.   CALL ECHO (FLDVAL$(I),ROW%(I),X%,FLDSIZE%(I))
  99. NEXT I
  100.  
  101. END SUB
  102.  
  103. SUB GETSCRN (NUMFLDS%,YNVAL$(1),ROW%(1),COL%(1),PROMPT$(1),FLDSIZE%(1),_
  104.                 FLDTYPE$(1),FLDVAL$(1),HLP$(1)) STATIC
  105.  
  106. REM DOES FULL SCREEN DATA ENTRY FOR TABLE DRIVEN SCREEN
  107.  
  108. NUL$ = ""
  109. TOPGETSCRN:
  110.   FOR I=1 TO NUMFLDS%
  111.     C% = COL%(I) - 3
  112.     CALL EXPLAIN (HLP$(I))
  113.     IF YNVAL$(I) <> "" THEN CALL GETCHAR (ROW%(I),C%,NUL$,VLDANS$,YNVAL$(I))
  114.     X = INSTR("LSN",FLDTYPE$(I))
  115.     IF X > 1 AND YNVAL$(I)<>"N" THEN_
  116.       IF X = 2 THEN_
  117.          CALL GETSTR (ROW%(I),COL%(I),PROMPT$(I),FLDSIZE%(I),FLDVAL$(I))_
  118.       ELSE_
  119.          CALL GETNATNUM (ROW%(I),COL%(I),PROMPT$(I),FLDSIZE%(I),FLDVAL$(I))
  120.   NEXT I
  121.   CALL UPCASE (FLDVAL$(2))
  122.   CALL UPCASE (FLDVAL$(3))
  123.   IF FLDVAL$(3)=FLDVAL$(2) AND FLDVAL$(2) <> "" THEN_
  124.      X$ = "Cannot WRITE to same file READING!":_
  125.      CALL EXPERR (X$):_
  126.      GOTO TOPGETSCRN
  127.   CALL UPCASE (FLDVAL$(28))
  128.   CALL UPCASE (FLDVAL$(29))
  129.   CALL UPCASE (FLDVAL$(31))
  130.   CALL UPCASE (FLDVAL$(32))
  131. END SUB
  132.  
  133.  
  134. SUB FIXLEN (L$,MINLEN%,FILLER$) STATIC
  135.  
  136. REM FILLS STRNG$ WITH FILLER$ UP TO LENGTH OF MINLEN%
  137.  
  138. DEFINT A-Z
  139. X = LEN(L$)
  140. IF X < MINLEN% THEN L$ = L$+ STRING$(MINLEN%-X,FILLER$)
  141.  
  142. END SUB
  143.  
  144. SUB SPELLDATE (L$,DSEP$,INLEN%(1),OUTYRLEN%,TINLEN%,TOUTLEN%,NINFLDS%,_
  145.              NOUTFLDS%,YPOS%,MONPOS%,OUTORD%(1),FILLER$) STATIC
  146.  
  147. REM CONVERTS DATES WHERE MONTH IS SPELLED BY FIRST THREE LETTERS
  148. REM OF MONTH.  REMOVES SEPARATOR BETWEEN DATE FIELDS
  149. REM   (DAY,MONTH,YEAR).  REARRANGES OR OMITS DATE FIELDS.  ALTERS
  150. REM   LENGTH OF YEAR FIELD.  PRESERVES ORIGINAL LENGTH OF DATE 
  151. REM   FIELD BY PADDING TO RIGHT UNLESS MUST EXTEND FIELD SIZE
  152.  
  153. REM PASS L$        - LINE TO EDIT
  154. REM      DSEP$     - SEPARATOR BETWEEN DATE FIELDS
  155. REM      INLEN%    - LENGTH OF EACH INPUT FIELD IN DATE
  156. REM      OUTYRLEN% - LENGTH OF YEAR OUTPUT FIELD
  157. REM      TINLEN%   - TOTAL LENGTH OF INPUT DATE
  158. REM      TOUTLEN%  - TOTAL LENGTH OF OUTPUT DATE
  159. REM      NINFLDS%  - NUMBER OF INPUT FIELDS IN DATE
  160. REM      NOUTFLDS% - NUMBER OF OUTPUT FIELDS (PARTS OF DATE)
  161. REM      YPOS%     - WHICH INPUT POSITION IS YEAR
  162. REM      MONPOS%   - WHICH INPUT POSITION IS MONTH
  163. REM      OUTORD%   - ORDER OF OUTPUT (WHAT INPUT POS IS 1ST,2ND,...)
  164. REM      FILLER$   - CHARACTERS TO PAD DATE FIELD TO RIGHT IF OUTPUT IS
  165. REM                     SHORTER THAN INPUT
  166. REM GET  L$        - EDITED LINE
  167.  
  168. DEFINT A-Z
  169. DIM D.FIELD$(3)
  170.  
  171. INCOLD = TINLEN%  - INLEN%(1)
  172. INCREP = TOUTLEN% - INLEN%(1)
  173.  
  174. BS = INSTR (L$,DSEP$)
  175. WHILE BS > 0
  176.    INC = 1
  177.    BPOS = BS - INLEN(1)
  178.    IF BPOS < 1 THEN GOTO GETOUTSPDATE
  179.    I = 1
  180.    SPCHKFLD:
  181.      D.FIELD$(I) = MID$(L$,BPOS,INLEN%(I))
  182.      IF LEN(D.FIELD$(I)) < INLEN%(I) THEN GOTO GETOUTSPDATE
  183.      IF I<>MONPOS% THEN_
  184.         CALL NUMERIC (D.FIELD$(I),CHKNUM%)_
  185.      ELSE_
  186.         CALL UPCASE (D.FIELD$(I)):_
  187.         CHKNUM% = INSTR(",JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC," , ","+D.FIELD$(I)+","):_
  188.         IF CHKNUM% THEN_
  189.             CHKNUM% = (CHKNUM%+4)/5:_
  190.             D.FIELD$(I)=MID$(STR$(CHKNUM%),2):_
  191.             IF  CHKNUM% < 10 THEN D.FIELD$(I)="0"+D.FIELD$(I)
  192.      IF CHKNUM%=0 THEN GOTO GETOUTSPDATE
  193.    I = I+1: IF I<=NINFLDS% THEN BPOS=BPOS+INLEN%(I-1)+1:GOTO SPCHKFLD
  194.    IF NINFLDS% < 3 THEN_
  195.       D.FIELD$(3)=""_
  196.    ELSE_
  197.       IF MID$(L$,BS+1+INLEN%(2),1) <> DSEP$ THEN_
  198.          GOTO GETOUTSPDATE
  199.    IF YPOS% THEN D.FIELD$(YPOS%) = RIGHT$("19"+D.FIELD$(YPOS%),OUTYRLEN%)
  200.  
  201.    X$ = ""
  202.    FOR I=1 TO NOUTFLDS%
  203.      X$ = X$ + D.FIELD$(OUTORD%(I))
  204.    NEXT
  205.    INC = INCREP
  206.    L$ = MID$(L$,1,BS-INLEN%(1)-1)+X$+FILLER$+MID$(L$,BS+INCOLD)
  207.  
  208. GETOUTSPDATE:
  209.    BS = BS + INC
  210.    BS = INSTR(BS,L$,DSEP$)
  211. WEND
  212.  
  213. END SUB
  214.  
  215. SUB NUMDATE (L$,DSEP$,INLEN%(1),OUTYRLEN%,TINLEN%,TOUTLEN%,NINFLDS%,_
  216.              NOUTFLDS%,YPOS%,OUTORD%(1),FILLER$) STATIC
  217.  
  218. REM CONVERTS NUMERIC DATES.  REMOVES SEPARATOR BETWEEN DATE FIELDS
  219. REM   (DAY,MONTH,YEAR).  REARRANGES OR OMITS DATE FIELDS.  ALTERS
  220. REM   LENGTH OF YEAR FIELD.  PRESERVES ORIGINAL LENGTH OF DATE 
  221. REM   FIELD BY PADDING TO RIGHT UNLESS MUST EXTEND FIELD SIZE
  222.  
  223. REM PASS L$        - LINE TO EDIT
  224. REM      DSEP$     - SEPARATOR BETWEEN DATE FIELDS
  225. REM      INLEN%    - LENGTH OF EACH INPUT FIELD IN DATE
  226. REM      OUTYRLEN% - LENGTH OF YEAR OUTPUT FIELD
  227. REM      TINLEN%   - TOTAL LENGTH OF INPUT DATE
  228. REM      TOUTLEN%  - TOTAL LENGTH OF OUTPUT DATE
  229. REM      NINFLDS%  - NUMBER OF INPUT FIELDS IN DATE
  230. REM      NOUTFLDS% - NUMBER OF OUTPUT FIELDS (PARTS OF DATE)
  231. REM      YPOS%     - WHICH INPUT POSITION IS YEAR
  232. REM      OUTORD%   - ORDER OF OUTPUT (WHAT INPUT POS IS 1ST,2ND,...)
  233. REM      FILLER$   - CHARACTERS TO PAD DATE FIELD TO RIGHT IF OUTPUT IS
  234. REM                     SHORTER THAN INPUT
  235. REM GET  L$        - EDITED LINE
  236.  
  237. DEFINT A-Z
  238. DIM D.FIELD$(3)
  239.  
  240. INCOLD = TINLEN%  - INLEN%(1)
  241. INCREP = TOUTLEN% - INLEN%(1)
  242.  
  243. BS = INSTR (L$,DSEP$)
  244. WHILE BS > 0
  245.    INC = 1
  246.    BPOS = BS - INLEN(1)
  247.    IF BPOS < 1 THEN GOTO GETOUTNUMDATE
  248.    I = 1
  249.    CHKFLD:
  250.      D.FIELD$(I) = MID$(L$,BPOS,INLEN%(I))
  251.      IF LEN(D.FIELD$(I)) < INLEN%(I) THEN GOTO GETOUTNUMDATE
  252.      CALL NUMERIC (D.FIELD$(I),NATNUM%)
  253.      IF NOT NATNUM% THEN GOTO GETOUTNUMDATE
  254.    I = I+1: IF I<=NINFLDS% THEN BPOS=BPOS+INLEN%(I-1)+1:GOTO CHKFLD
  255.    IF NINFLDS% < 3 THEN_
  256.       D.FIELD$(3)=""_
  257.    ELSE_
  258.       IF MID$(L$,BS+1+INLEN%(2),1) <> DSEP$ THEN_
  259.          GOTO GETOUTNUMDATE
  260.    IF YPOS% THEN D.FIELD$(YPOS%) = RIGHT$("19"+D.FIELD$(YPOS%),OUTYRLEN%)
  261.    X$ = ""
  262.    FOR I=1 TO NOUTFLDS%
  263.      X$ = X$ + D.FIELD$(OUTORD%(I))
  264.    NEXT
  265.    INC = INCREP
  266.    L$ = MID$(L$,1,BS-INLEN%(1)-1)+X$+FILLER$+MID$(L$,BS+INCOLD)
  267.  
  268. GETOUTNUMDATE:
  269.    BS = BS + INC
  270.    BS = INSTR(BS,L$,DSEP$)
  271. WEND
  272.  
  273. END SUB
  274.  
  275. SUB INITDATE (SPELLED%,INFMT$,OUTFMT$,INYRLEN%,OUTYRLEN%,INLEN%(1),_
  276.               OUTORD%(1),YPOS%,MONPOS%,TOUTLEN%,TINLEN%) STATIC
  277.  
  278. REM INITIALIZES DATE PROCESSING PARAMETERS BASED ON DATE SPECIFICIATIONS
  279.  
  280. REM PASS INFMT$    - FORMAT OF INPUT
  281. REM      OUTFMT$   - FORMAT OF OUTPUT
  282. REM      INYRLEN%  - LENGTH OF INPUT YEAR
  283. REM      OUTYRLEN% - LENGTH OF OUTPUT YEAR
  284. REM GET  INLEN%    - LENGTH OF EACH FIELD IN INPUT DATE
  285. REM      OUTORD%   - OUTPUT ORDER (WHAT FIELD IN INPUT IS 1ST,2ND,...)
  286. REM      YPOS%     - POSITION IN INPUT OF YEAR FIELD
  287. REM      TOUTLEN%  - TOTAL LENGTH OF DATE OUTPUT FIELD
  288. REM      TINLEN%   - TOTAL LENGTH OF  DATE INPUT FIELD
  289.  
  290. DEFINT A-Z
  291.  
  292. YPOS% = 0
  293. TINLEN% = 0
  294. TOUTLEN% = 0
  295. FOR I=1 TO 3
  296.   INLEN%(I) = 0
  297. NEXT I
  298.  
  299. FOR I=1 TO LEN(INFMT$)
  300.   D2D = INSTR(OUTFMT$,MID$(INFMT$,I,1))
  301.   IF MID$(INFMT$,I,1)="Y" THEN_
  302.      YPOS% = I:_
  303.      INLEN%(I) = INYRLEN%_
  304.   ELSE_
  305.      IF MID$(INFMT$,I,1)="M" THEN_
  306.          MONPOS% = I:_
  307.          INLEN%(I) = 2 - SPELLED_
  308.      ELSE_
  309.          INLEN%(I) = 2
  310.  
  311.   OUTLEN = 0
  312.   IF D2D > 0 THEN_
  313.      OUTORD%(D2D) = I:_
  314.      IF MID$(OUTFMT$,D2D,1)="Y" THEN_
  315.        OUTLEN = OUTYRLEN%_
  316.      ELSE_
  317.        OUTLEN = 2
  318.   TOUTLEN% = TOUTLEN% + OUTLEN
  319.   TINLEN%  = TINLEN%  + INLEN%(I)
  320. NEXT I
  321. TINLEN% = TINLEN% + LEN(INFMT$) - 1
  322.  
  323. END SUB
  324.  
  325. SUB DELCOMMAS (L$,RIGHT.DELIMITED%,MAXDEC%) STATIC
  326.  
  327. REM DELETES COMMAS INSIDE A NUMBER
  328.  
  329. REM SEND L$               - STRING TO BE EDITED
  330. REM      RIGHT.DELIMITED% - WHETHER NUMBER HAS NON-NUMERIC CHAR
  331. REM                           TO ITS RIGHT (E.G. SPACE)
  332. REM      MAXDEC%          - MAXIMUM NUMBER OF DECIMAL PLACES
  333. REM GET  L$
  334.  
  335. DEFINT A-Z
  336.  
  337. COM$ = ","
  338. PREV.BS = 0
  339. BS = INSTR(L$,COM$)
  340. WHILE BS > 0
  341.    IF BS < 1 THEN_
  342.       Y$="!"_
  343.    ELSE_
  344.       Y$ = MID$(L$,BS-1,1)
  345.    CALL NUMERIC (Y$,FRONT%)
  346.    IF NOT FRONT% THEN_
  347.       BS=BS + 1:_
  348.       GOTO NXTPRT 
  349.    STARTPOS = BS-1
  350.    STOPPOS = BS-4
  351.    IF STOPPOS < PREV.BS THEN STOPPOS = PREV.BS
  352.    IF STARTPOS > 1 THEN_
  353.      X$ = MID$(L$,STARTPOS-1,1):_
  354.      WHILE X$ <> "" AND X$ <> "-" AND X$ <> "+" AND INSTR("0123456789",X$) AND STARTPOS > STOPPOS AND STARTPOS > 1:_
  355.         STARTPOS = STARTPOS - 1:_
  356.         X$ = MID$(L$,STARTPOS-1,1):_
  357.      WEND
  358.    IF X$ = "-" OR X$ = "+" THEN_
  359.       STARTPOS = STARTPOS - 1
  360.    BACK%=-1
  361.    WHILE  MID$(L$,BS,1) = COM$ AND BACK%
  362.      X$=MID$(L$,BS+1,3)
  363.      IF LEN(X$)<3 THEN_
  364.          BACK%=0_
  365.      ELSE_
  366.          CALL NUMERIC(X$,BACK%)
  367.      IF STARTPOS < 1 THEN STARTPOS = 1
  368.      BS = BS + 1 - (BACK% * 3)
  369.    WEND
  370.    IF BS-STARTPOS < 5 THEN GOTO NXTPRT
  371.    IF MID$(L$,BS,1) = "." THEN_
  372.       BS = BS+1:_
  373.       NDEC = 0:_
  374.       WHILE INSTR("0123456789",MID$(L$,BS,1)) AND NDEC < MAXDEC%:_
  375.         BS = BS + 1:_
  376.         NDEC = NDEC + 1:_
  377.       WEND
  378.    X$ = MID$(L$,STARTPOS,BS-STARTPOS)
  379.    L = LEN(X$)
  380.  
  381.    IF L < 5 THEN GOTO NXTPRT
  382.    CALL REMOVE (X$,COM$)
  383.    FIL$ = SPACE$(L-LEN(X$))
  384.    IF RIGHT.DELIMITED% OR MAXDEC% < 1 THEN_
  385.       X$ = X$ + FIL$_
  386.    ELSE_
  387.       X$ = FIL$ + X$
  388.    MID$(L$,STARTPOS,L) = X$
  389. NXTPRT:
  390.    PREV.BS = BS
  391.    BS=INSTR(BS,L$,COM$)
  392. WEND
  393.  
  394. END SUB
  395.  
  396. SUB GETSTR (ROW%,COL%,PROMPT$,FLDSIZE%,RESULT$) STATIC
  397.  
  398. REM INPUT ROUTINE TO GET A STRING
  399. REM LOCATE 24,70:PRINT "GETSTR  ";
  400.  
  401. X% = FLDSIZE%+1:IF X%<8 THEN X%=8
  402. CALL QPRINT (PROMPT$+SPACE$(X%),ROW%,COL%)
  403. X% = COL% + LEN(PROMPT$) + 1
  404. CALL ECHO (RESULT$,ROW%,X%,FLDSIZE%)
  405. LOCATE ROW%,X%
  406. INPUT "",X$
  407. IF X$ <> "" THEN RESULT$ = X$:CALL ECHO (RESULT$,ROW%,X%,FLDSIZE%)
  408.  
  409. END SUB
  410.  
  411. SUB GETCHAR (ROW%,COL%,PROMPT$,VLDANS$,RESULT$) STATIC
  412.  
  413. REM ROUTINE TO GET SINGLE CHARACTER
  414.  
  415. DEFINT A-Z
  416. CR$ = CHR$(13)
  417. FLDSIZE% = 1
  418. CALL QPRINT (PROMPT$+RESULT$,ROW%,COL%)
  419. X% = COL% + LEN(PROMPT$)
  420. LOCATE ROW%,X%,1,6,7
  421. X$ = INPUT$(1)
  422. IF X$ = CR$ THEN X$ = RESULT$:IF X$="" THEN X$=CHR$(0)
  423. CALL UPCASE (X$)
  424. IF VLDANS$ <> "" THEN_
  425.     WHILE INSTR(VLDANS$,X$)=0:_
  426.       BEEP:_
  427.       X$ = INPUT$(1):CALL UPCASE (X$):_
  428.     WEND
  429. RESULT$ = X$:PRINT RESULT$;
  430.  
  431. END SUB
  432.  
  433. SUB GETNATNUM (ROW%,COL%,PROMPT$,FLDSIZE%,RESULT$) STATIC
  434.  
  435. REM ROUTINE TO INPUT ONLY NATURAL NUMBER (> OR = 0)
  436. REM LOCATE 24,70:PRINT "GETNATNUM ";
  437.  
  438. DEFINT A-Z
  439. RESTART:
  440.   CALL GETSTR (ROW%,COL%,PROMPT$,FLDSIZE%,RESULT$)
  441.   CALL NUMERIC (RESULT$,NONNEG%)
  442. IF NOT NONNEG% THEN BEEP:GOTO RESTART
  443.  
  444. END SUB
  445.  
  446. SUB ECHO (STRNG$,ROW%,COL%,FLDSIZE%) STATIC
  447.  
  448. REM ROUTINE FOR CLEARING A SPACE AND PRINTING MESSAGE
  449.  
  450. CALL QPRINT (SPACE$(FLDSIZE%),ROW%,COL%)
  451. CALL QPRINT (STRNG$,ROW%,COL%)
  452.  
  453. END SUB
  454.  
  455. SUB TRIM (STRNG$) STATIC
  456.  
  457. REM REMOVES LEADING AND TRAILING BLANKS FROM STRNG$
  458.  
  459. DEFINT A-Z
  460. ONE = 1
  461. CALL FIRSTNB (STRNG$,ONE,STRT)
  462. IF STRT < 1 THEN_
  463.    STRT = 1:LST = 0_
  464. ELSE_
  465.    X$ = "!"+STRNG$:_
  466.    LST = LEN(X$):_
  467.    WHILE MID$(X$,LST,1)=" ":_
  468.      LST = LST-1:_
  469.    WEND:_
  470.    LST = LST - 1
  471. STRNG$ = MID$(STRNG$,STRT,LST-STRT+1)
  472.  
  473. END SUB
  474.  
  475. SUB BRKWORDS (STRNG$,WORDS$(1)) STATIC
  476.  
  477. REM PASS STRNG$  - A STRING TO BE BROKEN INTO WORDS (SPACE
  478. REM                 DELIMITED STRINGS)
  479. REM      WORDS$  - AN ARRAY TO PUT WORDS IN
  480.  
  481. DEFINT A-Z
  482. ONE = 1
  483. LST = LEN(STRNG$)
  484. X$ = STRNG$ + " !"
  485. CALL FIRSTNB(X$,ONE,BS)
  486. NPARMS = 0
  487. MAXPARMS = UBOUND(WORDS$)
  488. WHILE BS <= LST
  489.   NPARMS = NPARMS + 1
  490.   CALL LASTNB (X$,BS,ES)
  491.   IF NPARMS > MAXPARMS THEN _
  492.      BS = LST+1_
  493.   ELSE_
  494.      WORDS$(NPARMS) = MID$(X$,BS,ES-BS+1):_
  495.      BS = ES+1:_
  496.      CALL FIRSTNB(X$,BS,BS)
  497. WEND
  498. END SUB
  499.  
  500. SUB FIRSTNB (STRNG$,BEG%,WHEREIS%) STATIC
  501.  
  502. REM PASS STRNG$  - A STRING TO BE SEARCHED
  503. REM      BEG%     - POSITION TO BEGIN SEARCH
  504. REM GET  WHEREIS% - POSITION IN STRNG$ OF FIRST NON-BLANK AT
  505. REM                  BEG% OR LATER.  RETURNS 0 IF NO NON-BLANK.
  506.  
  507. DEFINT A-Z
  508. REM LOCATE 24,70:PRINT "FIRSTNB  ";
  509. X$ = STRNG$+"!"
  510. WHEREIS% = BEG%
  511. IF WHEREIS% < 1 THEN WHEREIS% = 1
  512. WHILE MID$(X$,WHEREIS%,1) = " "
  513.    WHEREIS% = WHEREIS% + 1
  514. WEND
  515. IF WHEREIS% > LEN(STRNG$) THEN WHEREIS% = 0
  516.  
  517. END SUB
  518.  
  519. SUB LASTNB (STRNG$,BEG%,WHEREIS%) STATIC
  520.  
  521. REM PASS STRNG$   - A STRING TO BE SEARCHED
  522. REM      BEG%      - POSITION TO BEGIN SEARCH
  523. REM GET  WHEREIS%  - LAST POSITION IN STRNG$ OF ANY WORD BEGINNING AT
  524. REM                   BEG% OR LATER.  RETURNS BEG%-1 IF NO WORD AT BEG%.
  525.  
  526. DEFINT A-Z
  527. REM LOCATE 24,70:PRINT "LASTNB  ";
  528. B = BEG
  529. IF B < 1 THEN B = 1
  530. IF B > LEN(STRNG$) THEN_
  531.    X$ = " " _
  532. ELSE_
  533.    X$ = MID$(STRNG$,B)+" "
  534. WHEREIS% = INSTR(X$," ") - 1 + B - 1
  535.  
  536. END SUB
  537.  
  538. SUB REPPARENS(L$) STATIC
  539.  
  540. REM MAKES NUMBERS ENCLOSED IN PARENTHESES NEGATIVE.
  541. REM   ADDS NEGATIVE SIGN TO FRONT, REMOVES TRAILING AND LEADING
  542. REM BLANKS, LEFT JUSTIFIES NUMBER, PRESERVES FIELD LENGTH BY
  543. REM FILLING WITH BLANKS TO RIGHT.
  544.  
  545. BS=1
  546. BLNK$=" "
  547. LPAREN$="("
  548. RPAREN$=")"
  549. BS=INSTR(BS,L$,LPAREN$)
  550. ES=INSTR(BS + 1,L$,RPAREN$)
  551. WHILE ES > BS
  552.    L = ES-BS-1
  553.    X$=MID$(L$,BS + 1,L)
  554.    CALL REALNUM (X$,NONNEG%)
  555.    IF NONNEG% THEN_
  556.       CALL REMOVE (X$,BLNK$):_
  557.       L = L+2:_
  558.       MID$(L$,BS,L) = "-" + X$ + SPACE$(L-1-LEN(X$))
  559.    BS=ES + 1
  560.    BS=INSTR(BS,L$,LPAREN$)
  561.    IF BS > 0 THEN_
  562.      ES=INSTR(BS + 1,L$,RPAREN$)_
  563.    ELSE_
  564.      ES=0   
  565. WEND
  566. END SUB
  567.  
  568. SUB REALNUM (STRNG$,RESULT%) STATIC
  569.  
  570. REM CHECKS WHETHER STRNG$ IS A VALID REAL NUMBER
  571. REM PASS STRNG$  - STRING TO BE CHECKED
  572. REM GET  RESULT% - TRUE IF REAL
  573.  
  574. DEFINT A-Z
  575. X$ = STRNG$+"."
  576. LENGTH = LEN(STRNG$)
  577. J=1
  578. WHILE INSTR("+- ",MID$(X$,J,1))
  579.   J=J+1
  580. WEND
  581. IF J > LENGTH THEN RESULT% = 0:EXIT SUB
  582.  
  583. X = INSTR(X$,".")
  584. FRONT$ = MID$(STRNG$,J,X-J)
  585. IF X > LENGTH THEN_
  586.    BACK$=""_
  587. ELSE_
  588.    BACK$  = MID$(STRNG$,X+1)
  589.  
  590. CALL NUMERIC (FRONT$,FRNNAT%)
  591. CALL NUMERIC (BACK$,BNNAT%)
  592. RESULT% = (FRNNAT% AND BNNAT%)
  593.  
  594. END SUB
  595.  
  596. SUB NUMERIC (STRNG$,RESULT%) STATIC
  597.  
  598. REM PASS STRNG$  - A STRING TO BE SEARCHED
  599. REM GET  RESULT%  - TRUE IF STRNG$ CONTAINS ONLY NON-NEGATIVE DIGITS 
  600. REM                  OR LEADING OR TRAILING BLANKS
  601.  
  602. DEFINT A-Z
  603. IF STRNG$=SPACE$(LEN(STRNG$)) THEN RESULT%=0:GOTO GETOUTNUMERIC
  604. NUM$="0123456789"
  605. CALL NOOTHER (STRNG$,NUM$,RESULT%)
  606. GETOUTNUMERIC:
  607. END SUB
  608.  
  609. SUB NOOTHER (STRNG$,ONLY$,RESULT%) STATIC
  610.  
  611. REM PASS STRNG$  - A STRING TO BE SEARCHED
  612. REM      ONLY$   - A LIST OF THE ONLY CHARACTERS TO BE IN STRNG$
  613. REM GET  RESULT%  - TRUE OF ONLY CHARACTERS IN STRNG$ ARE THOSE IN ONLY$
  614. REM                   OR ARE LEADING OR TRAILING BLANKS
  615.  
  616. DEFINT A-Z
  617.  
  618. RESULT% = -1
  619. IF LEN(STRNG$) < 1 THEN GOTO GETOUTNOOTHER
  620. ONE = 1
  621. CALL FIRSTNB(STRNG$,ONE,BS)
  622. CALL LASTNB(STRNG$,BS,ES)
  623.  
  624. FOR I=BS TO ES
  625.    IF INSTR(ONLY$,MID$(STRNG$,I,1)) = 0 THEN_
  626.       RESULT% = 0:_
  627.       I=ES+1
  628. NEXT I
  629.  
  630. IF STRNG$ <> MID$(STRNG$,1,ES)+SPACE$(LEN(STRNG$)-ES) THEN RESULT% = 0
  631.  
  632. GETOUTNOOTHER:
  633. END SUB
  634.  
  635. SUB GLOBAL(L$,OLDS$(1),NEWS$(1)) STATIC
  636.  
  637. REM GLOBAL SEARCH AND REPLACE
  638. REM PASS L$     - STRING TO SEARCH AND REPLACE
  639. REM      OLDS$  - WHAT SEARCHING FOR AND REPLACING
  640. REM      NEWS$  - WHAT REPLACING BY
  641. REM NOTE: ASSUME OLD AND NEW ARE ARRAYS FULL OF WHAT LOOKING FOR
  642.  
  643. DEFINT A-Z
  644. FOR I=1 TO UBOUND(OLDS$)
  645.    CALL REPLACE(L$,OLDS$(I),NEWS$(I))
  646. NEXT I
  647. END SUB
  648.  
  649. SUB REPLACE (L$,OLD$,NEW$) STATIC
  650.  
  651. REM GLOBAL SEARCH FOR OLD$, REPLACE BY NEW$, IN L$
  652.  
  653. DEFINT A-Z
  654. OLDLEN=LEN(OLD$)
  655. IF OLDLEN <1 THEN GOTO GETOUTREPLACE
  656. NEWLEN=LEN(NEW$)
  657. BS=1
  658. ES=INSTR(BS,L$,OLD$)
  659. WHILE ES <> 0
  660.    BS=ES + OLDLEN
  661.    L$=MID$(L$,1,ES-1) + NEW$ + MID$(L$,BS)
  662.    BS=ES + NEWLEN
  663.    ES=INSTR(BS,L$,OLD$)
  664. WEND
  665. GETOUTREPLACE:
  666. END SUB
  667.  
  668. SUB REMOVE (L$,BADSTRNG$) STATIC
  669.  
  670. REM REMOVES FROM L$ ALL INSTANCES OF CHARACTERS IN BADSTRNG$
  671.  
  672. REM PASS L$        - STRING TO BE ALTERED
  673. REM      BADSTRNG$ - LIST OF CHARACTERS TO REMOVE
  674. REM GET  L$        - ORIGINAL MINUS BADSTRNG$
  675.  
  676. DEFINT A-Z
  677. J = 0
  678. FOR I=1 TO LEN(L$)
  679.   IF INSTR(BADSTRNG$,MID$(L$,I,1)) = 0 THEN_
  680.      J = J+1:_
  681.      MID$(L$,J,1) = MID$(L$,I,1)
  682. NEXT I
  683. L$ = LEFT$(L$,J)
  684.  
  685. END SUB
  686.  
  687. SUB KEEPONLY (L$,GOODSTRNG$) STATIC
  688.  
  689. REM KEEPS IN L$ ONLY THOSE CHARACTERS IN GOODSTRNG$, I.E.
  690. REM     REMOVES FROM L$ ALL INSTANCES OF CHARACTERS NOT IN GOODSTRNG$
  691.  
  692. REM PASS L$         - STRING TO BE ALTERED
  693. REM      GOODSTRNG$ - LIST OF CHARACTERS TO KEEP
  694. REM GET  L$         - ORIGINAL MINUS CHARS NOT IN GOODSTRNG$
  695.  
  696. DEFINT A-Z
  697. J = 0
  698. FOR I=1 TO LEN(L$)
  699.   IF INSTR(GOODSTRNG$,MID$(L$,I,1)) THEN_
  700.      J = J+1:_
  701.      MID$(L$,J,1) = MID$(L$,I,1)
  702. NEXT I
  703. L$ = LEFT$(L$,J)
  704.  
  705. END SUB
  706.  
  707. SUB TRANSLATE (L$,GOT$,WANT$) STATIC
  708.  
  709. REM REPLACES IN L$ ALL INSTANCES OF CHARACTER IN GOT$ BY CORRESPONDING
  710. REM   CHARACTER IN WANT$
  711.  
  712. REM PASS L$     - STRING TO BE ALTERED
  713. REM      GOT$   - LIST OF CHARACTERS WANTED REPLACED
  714. REM      WANT$  - WHAT REPLACE BY
  715. REM GET  L$     - ALTERED STRING
  716.  
  717. DEFINT A-Z
  718. FOR I=1 TO LEN(L$)
  719.   PO = INSTR(GOT$,MID$(L$,I,1))
  720.   IF PO THEN MID$(L$,I,1) = MID$(WANT$,PO,1)
  721. NEXT I
  722.  
  723. END SUB
  724.  
  725. SUB EXPERR (STRNG$) STATIC
  726.  
  727. REM EXPLAIN AN ERROR
  728.  
  729. DEFINT A-Z
  730. BEEP
  731.  
  732. CALL EXPLAIN (STRNG$)
  733. SEC = 3
  734. CALL WAITSECORKEY (SEC)
  735. BEEP
  736.  
  737. END SUB
  738.  
  739. SUB EXPLAIN (STRNG$) STATIC
  740.  
  741. REM CONTROLS MESSAGE IN INVERSE VIDEO ON LINE 24
  742.  
  743. DEFINT A-Z
  744. RO = 24
  745. CO = 3
  746. PGE = 0
  747. ATTR = (7 AND 7)*16
  748. X$ = LEFT$(STRNG$,75)
  749. CALL XQPRINT (" "+X$+SPACE$(75-LEN(X$)),RO,CO,ATTR,PGE)
  750. COLOR 7,0
  751.  
  752. END SUB
  753.  
  754. SUB WAITSECORKEY (SECONDS%) STATIC
  755.  
  756. REM PAUSE ROUTINE BASED ON CLOCK
  757. REM SEND SECONDS% - MAXIMUM # SECONDS TO WAIT
  758. REM WILL QUIT IF ANY KEY PRESSED
  759.  
  760. CURSEC! = (val(mid$(time$,4,2))*60+val(mid$(time$,7,2)))
  761. DONE!   = CURSEC! + SECONDS%
  762. WHILE CURSEC! < DONE! AND INKEY$ = ""
  763.    CURSEC! = (val(mid$(time$,4,2))*60+val(mid$(time$,7,2)))
  764. WEND
  765.  
  766. END SUB
  767.  
  768.