home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / batutl / bed11.arc / BED.BAS next >
BASIC Source File  |  1985-12-02  |  11KB  |  411 lines
  1. REM DRIVER PROGRAM FOR BATCH EDITOR (BED)
  2.  
  3. DEFINT A-Z
  4. NUMFLDS% = 32
  5. MAXCALLS = 8
  6. DIM YNVAL$(NUMFLDS%),ROW%(NUMFLDS%),COL%(NUMFLDS%),PROMPT$(NUMFLDS%),_
  7.     FLDSIZE%(NUMFLDS%),FLDTYPE$(NUMFLDS%),FLDVAL$(NUMFLDS%),HLP$(NUMFLDS%),_
  8.     INITYN$(NUMFLDS%),INITVAL$(NUMFLDS%),CORDER(MAXCALLS),DEFORD(MAXCALLS)    
  9.  
  10. CALL INITIALIZE (NUMFLDS%,INITYN$(),ROW%(),COL%(),PROMPT$(),FLDSIZE%(),_
  11.                 FLDTYPE$(),INITVAL$(),HLP$()) 
  12. DIM WRDS$(12),INLEN%(3),OUTORD%(3),SPINLEN%(3),SPOUTORD%(3)
  13.  
  14. DEFORD(1)=13
  15. DEFORD(2)=11
  16. DEFORD(3)=12
  17. DEFORD(4)=14
  18. DEFORD(5)=20
  19. DEFORD(6)=19
  20. DEFORD(7)=27
  21. DEFORD(8)=30
  22.  
  23. YSPELLED = -1
  24. NSPELLED = 0
  25. ONESPACE$ = " "
  26. AGRO = 23
  27. AGCO = 14
  28. AGPRO$ = "E)dit a file, Q)uit to DOS (E,Q): "
  29. AGVAL$ = "EQ"
  30. AGFLDSIZE = 15
  31. YAG.RO = AGRO
  32. YAG.CO = 5
  33. YAG.PRO$ = "Use what editing specifications (<rtn>=new):"
  34. VLDANS$="YN"
  35. EDPR$ = "R)un, E)dit, S)ave, Q)uit (R,E,S,Q): "
  36. EDRO% = 24
  37. EDCO% = 13
  38. EDVAL$="RESQ"
  39.  
  40. CALL BRKWORDS (COMMAND$,WRDS$())
  41. NON.OPT = 1
  42. WHILE INSTR(WRDS$(NON.OPT),"/")
  43.    NON.OPT = NON.OPT + 1
  44. WEND
  45. RUN.BATCH = (INSTR(COMMAND$,"/B"))
  46. SPEC.IN.FILE = (INSTR(COMMAND$,"/F"))
  47. ON ERROR GOTO ERRINF
  48. FFF$ = WRDS$(NON.OPT)
  49. IF SPEC.IN.FILE THEN OPEN "I",#1,FFF$
  50. ON ERROR GOTO 0
  51. MORE.QUEUED = (WRDS$(NON.OPT)<>"")
  52. MORE.SPECS = -1
  53. NPASSES = 0
  54.  
  55. IF WRDS$(1)="" THEN CALL CREDITS
  56. GOSUB GETSPEC
  57. WHILE MORE.SPECS
  58.    NPASSES = NPASSES + 1
  59.  
  60.    CALL PRTSCRN (NUMFLDS%,YNVAL$(),ROW%(),COL%(),PROMPT$(),FLDSIZE%(),_
  61.                 FLDTYPE$(),FLDVAL$(),HLP$())
  62.    ASKAGN:
  63.      IF RUN.BATCH THEN_
  64.         ANS$ = "R"_
  65.      ELSE_
  66.         CO=1:CALL QPRINT (SPACE$(79),EDRO%,CO):_
  67.         ANS$="E":CALL GETCHAR (EDRO%,EDCO%,EDPR$,EDVAL$,ANS$):_
  68.         WHILE ANS$ = "E":_
  69.           CALL GETSCRN (NUMFLDS%,YNVAL$(),ROW%(),COL%(),PROMPT$(),FLDSIZE%(),_
  70.                      FLDTYPE$(),FLDVAL$(),HLP$()):_
  71.           LOCATE EDRO%,1:PRINT SPACE$(79);:_
  72.           ANS$="":CALL GETCHAR (EDRO%,EDCO%,EDPR$,EDVAL$,ANS$):_
  73.         WEND
  74.      IF ANS$ = "R" THEN GOTO DOEDITS
  75.    IF ANS$ = "S" THEN_
  76.        SPEC.FILE$ = FLDVAL$(4):_
  77.        GOSUB SAVESPEC:_
  78.        GOTO ASKAGN
  79.    SKIPEDITS:
  80.  
  81.    GOSUB GETSPEC
  82. WEND
  83. CLOSE
  84.  
  85. END
  86.  
  87. REM ********   GOSUB SUBROUTINES    **********
  88.  
  89. GETSPEC:
  90.  
  91.   FFF$ = ""
  92.   IF MORE.QUEUED THEN_
  93.     GOSUB GETFILE
  94.   IF NOT MORE.QUEUED THEN_
  95.     IF RUN.BATCH THEN_
  96.        MORE.SPECS = 0_
  97.     ELSE_
  98.        ANS$="E":_
  99.        LOCATE AGRO,1:PRINT SPACE$(79);:_
  100.        CALL GETCHAR (AGRO,AGCO,AGPRO$,AGVAL$,ANS$):_
  101.        IF ANS$ = "Q" THEN_
  102.           MORE.SPECS = 0_
  103.        ELSE_
  104.           CALL GETSTR (YAG.RO,YAG.CO,YAG.PRO$,AGFLDSIZE,FFF$)
  105.   IF FFF$ = "" THEN_
  106.        FOR I = 1 TO NUMFLDS%:_
  107.          YNVAL$(I)=INITYN$(I):_
  108.          FLDVAL$(I)=INITVAL$(I):_
  109.        NEXT I:_
  110.        RETURN
  111.     ON ERROR GOTO ERRINF
  112.     OPEN "I",#2,FFF$
  113.     FOR I=1 TO NUMFLDS%
  114.       IF FLDTYPE$(I) <> "L" THEN_
  115.         LINE INPUT #2,YNVAL$(I):_
  116.         LINE INPUT #2,FLDVAL$(I)
  117.     NEXT I
  118.     CLOSE #2
  119.     ON ERROR GOTO 0
  120.  
  121. RETURN
  122.  
  123. GETFILE:
  124.  
  125.     IF SPEC.IN.FILE THEN_
  126.       IF EOF(1) THEN_
  127.         MORE.QUEUED = 0_
  128.       ELSE_
  129.         LINE INPUT #1,FFF$_
  130.     ELSE_
  131.       IF WRDS$(NON.OPT)="" THEN_
  132.         MORE.QUEUED = 0_
  133.       ELSE_
  134.         FFF$ = WRDS$(NON.OPT):_
  135.         NON.OPT = NON.OPT + 1
  136. RETURN
  137.  
  138. SAVESPEC:
  139.   ON ERROR GOTO ERROUT
  140.   FFF$ = SPEC.FILE$
  141.   OPEN "O",#2,FFF$
  142.   FLDVAL$(4) = FFF$
  143.   FOR I=1 TO NUMFLDS%
  144.     IF FLDTYPE$(I)<>"L" THEN_
  145.       PRINT #2,YNVAL$(I):_
  146.       PRINT #2,FLDVAL$(I)
  147.   NEXT I
  148.   CLOSE #2
  149.   ON ERROR GOTO 0
  150. RETURN
  151.  
  152. DOEDITS:
  153.  
  154.    GOSUB DECODE
  155.    IF REP.NUMDATE THEN_
  156.        CALL INITDATE (NSPELLED,INFMT$,OUTFMT$,INYRLEN%,OUTYRLEN%,INLEN%(),_
  157.               OUTORD%(),YPOS%,MONPOS%,TOUTLEN%,TINLEN%):_
  158.        NINFLDS% = LEN(INFMT$):_
  159.        NOUTFLDS% = LEN(OUTFMT$):_
  160.        NFIL = (TOUTLEN% - TINLEN%)*(TINLEN% > TOUTLEN%):_
  161.        FILLER$ = STRING$(NFIL,ONESPACE$):_
  162.        TOUTLEN% = TOUTLEN% + NFIL
  163.     IF REP.SPDATE THEN_
  164.        CALL INITDATE (YSPELLED,SPINFMT$,SPOUTFMT$,INYRLEN%,OUTYRLEN%,_
  165.               SPINLEN%(),SPOUTORD%(),SPYPOS%,SPMONPOS%,SPTOUTLEN%,SPTINLEN%):_
  166.        SPNINFLDS% = LEN(SPINFMT$):_
  167.        SPNOUTFLDS% = LEN(SPOUTFMT$):_
  168.        NFIL = (SPTOUTLEN% - SPTINLEN%)*(SPTINLEN% > SPTOUTLEN%):_
  169.        SPFILLER$ = STRING$(NFIL,ONESPACE$):_
  170.        SPTOUTLEN% = SPTOUTLEN% + NFIL:_
  171. REM       FOR I=1 TO 3:PRINT "SPINLEN-";I;"=";SPINLEN%(i);:next:print:input xxx$
  172. REM       YROUTPOS% = INSTR(SPOUTFMT$,"Y"):_
  173. REM       IF OUTYRLEN% < INYRLEN% THEN_
  174. REM          SPFILLER$ = SPACE$(2+INYRLEN%-OUTYRLEN%)_
  175. REM       ELSE_
  176. REM          SPFILLER$ = "  "
  177.  
  178.    ON ERROR GOTO CHECKAUX
  179.    NUMBADWORDS = 0
  180.    IF BAD.WORDS THEN_
  181.       FFF$ = BADWORDS.FILE$:_
  182.       OPEN "I",#3,FFF$:_
  183.       FLDVAL$(7) = FFF$:_
  184.       NUMBADWORDS = 0:_
  185.       WHILE NOT EOF(3):_
  186.         LINE INPUT #3,X$:_
  187.         NUMBADWORDS = NUMBADWORDS+1:_
  188.       WEND:_
  189.       REDIM BADWORD$(NUMBADWORDS):_
  190.       CLOSE #3:_
  191.       OPEN "I",#3,FFF$:_
  192.       FOR I=1 TO NUMBADWORDS:_
  193.         LINE INPUT #3,BADWORD$(I):_
  194.       NEXT I:_
  195.       CLOSE #3
  196.    NUMLINES% = 0
  197.    IF GLO.SANDR THEN_
  198.       FFF$ = GSANDR.FILE$:_
  199.       OPEN "I",#3,FFF$:_
  200.       FLDVAL$(12) = FFF$:_
  201.       NUMLINES% = 0:_
  202.       WHILE NOT EOF(3):_
  203.         LINE INPUT #3,X$:_
  204.         NUMLINES% = NUMLINES%+1:_
  205.       WEND:_
  206.       REDIM GOT$(NUMLINES%),WANT$(NUMLINES%):_
  207.       CLOSE #3:_
  208.       OPEN "I",#3,FFF$:_
  209.       FOR I=1 TO NUMLINES%:_
  210.         INPUT #3,GOT$(I),WANT$(I):_
  211.       NEXT I:_
  212.       CLOSE #3
  213.  
  214.    NWRITE! = 0
  215.    NSKIP!  = 0
  216.    NREAD!  = 0
  217.  
  218.    ON ERROR GOTO ERRINF
  219.    FFF$ = INFILE$
  220.    OPEN "I",#3,FFF$
  221.    FLDVAL$(2) = FFF$
  222.    ON ERROR GOTO ERROUT
  223.    FFF$ = OUTFILE$
  224.    OPEN "O",#4,FFF$
  225.    FLDVAL$(3) = FFF$
  226.    FFF$ = EXC.FILE$
  227.    IF SAVE.EXC THEN OPEN "O",#5,FFF$
  228.    FLDVAL$(9) = FFF$
  229.  
  230.    IF RUN.BATCH=0 AND SPEC.FILE$ <> "" THEN_
  231.        GOSUB SAVESPEC
  232.  
  233.    COLOR 0,7
  234.    LOCATE 24,1:PRINT SPACE$(70);
  235.    LOCATE 24,10:PRINT "READS:";
  236.    LOCATE 24,30:PRINT "WRITES:";
  237.    LOCATE 24,50:PRINT "SKIPS:";
  238.  
  239.    GOSUB SETCORDER
  240.    ON ERROR GOTO ERRMAINLOOP
  241.    WHILE NOT EOF(3)
  242.      LINE INPUT #3,LL$
  243.      NREAD! = NREAD!+1
  244.      LOCATE 24,17:PRINT NREAD!;
  245.      IF LEN(LL$) < MINLEN THEN GOTO SKIP
  246.      IF MAXLEN > 0 THEN IF LEN(LL$) > MAXLEN THEN GOTO SKIP
  247.      I=1
  248.      CHK: IF I > NUMBADWORDS THEN GOTO NOSKIP
  249.           IF INSTR(LL$,BADWORD$(I)) THEN GOTO SKIP ELSE I=I+1:GOTO CHK
  250.      NOSKIP:
  251.        FOR I = 1 TO NUMCALLS
  252.          ON CORDER(I) GOTO DOREMOVE,DOUPCASE,DOGLOBAL,DOTRANS,DOCOMMAS,_
  253.                            DOPARENS,DOSPELL,DONUMDATE
  254.          GOTO NXTCALL
  255.             DOREMOVE:  CALL REMOVE (LL$,BAD.CHARS$):GOTO NXTCALL
  256.             DOUPCASE:  CALL UPCASE (LL$):GOTO NXTCALL
  257.             DOGLOBAL:  CALL GLOBAL (LL$,GOT$(),WANT$()):GOTO NXTCALL
  258.             DOTRANS:   CALL TRANSLATE (LL$,TRANS.FROM$,TRANS.TO$):GOTO NXTCALL
  259.             DOCOMMAS:  CALL DELCOMMAS (LL$,RIGHT.JUS,MAXDEC):GOTO NXTCALL
  260.             DOPARENS:  CALL REPPARENS (LL$):GOTO NXTCALL
  261.             DOSPELL:   CALL SPELLDATE (LL$,DSEP$,SPINLEN%(),OUTYRLEN%,_
  262.                           SPTINLEN%,SPTOUTLEN%,SPNINFLDS%,SPNOUTFLDS%,_
  263.                           SPYPOS%,SPMONPOS%,SPOUTORD%(),SPFILLER$):GOTO NXTCALL
  264.             DONUMDATE: CALL NUMDATE (LL$,DSEP$,INLEN%(),OUTYRLEN%,_
  265.                           TINLEN%,TOUTLEN%,NINFLDS%,_
  266.                           NOUTFLDS%,YPOS%,OUTORD%(),FILLER$):GOTO NXTCALL
  267.             NXTCALL:
  268.         NEXT I
  269.      IF PAD.LEN     THEN CALL FIXLEN (LL$,PAD.LEN,SP$)
  270.      PRINT #4,LL$
  271.      NWRITE! = NWRITE!+1
  272.      LOCATE 24,38:PRINT NWRITE!;
  273.  
  274.      GOTO GOODREC
  275.      SKIP:
  276.        NSKIP! = NSKIP! + 1
  277.        LOCATE 24,57:PRINT NSKIP!;
  278.        IF SAVE.EXC THEN PRINT #5,LL$
  279.  
  280.      GOODREC:
  281.    WEND
  282.    CLOSE #3
  283.    CLOSE #4
  284.    IF SAVE.EXC THEN CLOSE #5
  285.    ON ERROR GOTO 0
  286.    COLOR 7,0
  287. GOTO SKIPEDITS
  288.  
  289. DECODE:
  290.   INFILE$ = FLDVAL$(2)
  291.   OUTFILE$ = FLDVAL$(3)
  292.   SPEC.FILE$ = FLDVAL$(4)
  293.   IF YNVAL$(6)="Y" THEN_
  294.      MINLEN = VAL(FLDVAL$(6))_
  295.   ELSE_
  296.      MINLEN = 0
  297.   BAD.WORDS = (YNVAL$(7)="Y")
  298.   BADWORDS.FILE$ = FLDVAL$(7)
  299.   IF YNVAL$(8)="Y" THEN_
  300.      MAXLEN = VAL(FLDVAL$(8))_
  301.   ELSE_
  302.      MAXLEN = 0
  303.   SAVE.EXC = (YNVAL$(9) = "Y")
  304.   EXC.FILE$ = FLDVAL$(9)
  305.   
  306.   UPPER.CASE = (YNVAL$(11) <> "" AND YNVAL$(11) <> "N")
  307.   
  308.   GLO.SANDR = (YNVAL$(12)<>"" AND YNVAL$(12)<>"N")
  309.   GSANDR.FILE$ = FLDVAL$(12)
  310.   
  311.   DEL.CHARS = (YNVAL$(13)<>"" AND YNVAL$(13)<>"N")
  312.   BAD.CHARS$ = FLDVAL$(13)
  313.   TRANS.CHARS = (YNVAL$(14) <> "" AND YNVAL$(14) <> "N")
  314.   TRANS.FROM$ = FLDVAL$(14)
  315.   TRANS.TO$   = FLDVAL$(15)
  316.   PAD.LEN   = VAL(FLDVAL$(17))
  317.   SP$ = " "
  318.   FIX.PARENS  = (YNVAL$(19) <> "" AND YNVAL$(19) <> "N")
  319.   OMIT.COMMAS = (YNVAL$(20) <> "" AND YNVAL$(20) <> "N")
  320.   RIGHT.JUS   = (YNVAL$(21) = "Y")
  321.   MAXDEC      = VAL(FLDVAL$(22))
  322.     
  323.   INYRLEN% = VAL(FLDVAL$(24))
  324.   OUTYRLEN% = VAL(FLDVAL$(25))
  325.   DSEP$ = FLDVAL$(26)
  326.   REP.SPDATE = (YNVAL$(27) <> "" AND YNVAL$(27) <> "N")
  327.   SPINFMT$  = FLDVAL$(28)
  328.   SPOUTFMT$ = FLDVAL$(29)
  329.   REP.NUMDATE = (YNVAL$(30) <> "" AND YNVAL$(30) <> "N")
  330.   INFMT$ = FLDVAL$(31)
  331.   OUTFMT$ = FLDVAL$(32)
  332.  
  333. RETURN
  334.  
  335. SETCORDER:
  336.    REM 0 CALLS
  337.    FOR I = 1 TO MAXCALLS
  338.      CORDER(I) = 0
  339.    NEXT I
  340.  
  341.    REM LOAD ORDER SPECIFIED (OVERLOAD DUPS)
  342.    FOR I = 1 TO MAXCALLS
  343.       X = INSTR("123456789",YNVAL$(DEFORD(I)))
  344.       IF X THEN CORDER(X) = I
  345.    NEXT
  346.  
  347.    REM COMPRESS IF SKIPPED ANY NUMBERS
  348.    NUMCALLS = 0
  349.    FOR I = 1 TO MAXCALLS
  350.       IF CORDER(I)>0 THEN_
  351.         NUMCALLS = NUMCALLS + 1:_
  352.         CORDER(NUMCALLS)=CORDER(I)
  353.    NEXT I
  354.  
  355.    REM ADD ANY Y's
  356.    FOR I = 1 TO MAXCALLS
  357.       IF YNVAL$(DEFORD(I))="Y" THEN_
  358.          NUMCALLS = NUMCALLS + 1:_
  359.          CORDER(NUMCALLS)=I
  360.    NEXT I
  361.  
  362. RETURN
  363.  
  364. ERRINF:
  365.    X$ = " while reading "
  366.    GOTO GETINFILE
  367.  
  368. ERROUT:
  369.    X$ = " while writing "
  370.    GOTO GETOUTFILE
  371.  
  372. ERRMAINLOOP:
  373.    IF ERR = 61 OR ERR = 57 THEN_
  374.       X$ = "  Possible full disk."_
  375.    ELSE X$=""
  376.    X$ = "Error"+STR$(ERR)+" in main loop."+X$+"  Terminating."
  377.    LOCATE 24,1:PRINT " "
  378.    CALL EXPLAIN (X$)
  379.    END
  380.  
  381. CHECKAUX:
  382.    X$ = "near aux file "
  383.    GOTO GETINFILE
  384.  
  385. GETINFILE:
  386.       IF ERR = 53 THEN_
  387.          X$="File "+FFF$+" does not exist!":_
  388.          GOTO ASKFILE
  389. GETOUTFILE:
  390.       IF ERR = 64 OR ERR = 75 OR ERR = 76 OR ERR = 67 THEN GOTO ASKFILE
  391.       IF ERR = 62 THEN X$ = ".  Check format.  Not enough data in "
  392.       X$="Error"+STR$(ERR)+" "+X$+FFF$+".  Aborting.":_
  393.       CALL EXPLAIN (X$):_
  394.       END
  395. ASKFILE:
  396.       IF ERR = 64 THEN_
  397.          X$ = FFF$+" is a bad or illegal file name."_
  398.       ELSE IF ERR = 75 THEN_
  399.          X$ = "Bad or illegal path in "+FFF$+"."_
  400.       ELSE IF ERR = 76 THEN_
  401.          X$ = "Path in "+FFF$+" does not exist."_
  402.       ELSE_
  403.          X$ = "Error 67.  "+FFF$+" is probably a bad file name."
  404.       CALL EXPERR (X$)
  405.       RO=23:CO=1:CALL QPRINT (SPACE$(79),RO,CO)
  406.       CO=15:PROMPT$="Enter file name (<rtn> quits):":FLDSIZ=30
  407.       FFF$=""
  408.       CALL GETSTR (RO,CO,PROMPT$,FLDSIZ,FFF$)
  409.       IF FFF$="" THEN END ELSE RESUME
  410.  
  411.