Moved old turbobasic files to directory 1998 and added new directory for new files

[mirrors/Programs.git] / turbobasic / 1998 / 3RD-PA.RTY / REMLINE.BAS

'\r
'   Microsoft RemLine - Line Number Removal Utility\r
'   Copyright (C) Microsoft Corporation 1985-1990\r
'\r
'   REMLINE.BAS is a program to remove line numbers from Microsoft Basic\r
'   Programs. It removes only those line numbers that are not the object\r
'   of one of the following statements: GOSUB, RETURN, GOTO, THEN, ELSE,\r
'   RESUME, RESTORE, or RUN.\r
'\r
'   When REMLINE is run, it will ask for the name of the file to be\r
'   processed and the name of the file or device to receive the\r
'   reformatted output. If no extension is given, .BAS is assumed (except\r
'   for output devices). If filenames are not given, REMLINE prompts for\r
'   file names. If both filenames are the same, REMLINE saves the original\r
'   file with the extension .BAK.\r
'\r
'   REMLINE makes several assumptions about the program:\r
'\r
'     1. It must be correct syntactically, and must run in BASICA or\r
'        GW-BASIC interpreter.\r
'     2. There is a 400 line limit. To process larger files, change\r
'        MaxLines constant.\r
'     3. The first number encountered on a line is considered a line\r
'        number; thus some continuation lines (in a compiler-specific\r
'        construction) may not be handled correctly.\r
'     4. REMLINE can handle simple statements that test the ERL function\r
'        using  relational operators such as =, <, and >. For example,\r
'        the following statement is handled correctly:\r
'\r
'             IF ERL = 100 THEN END\r
'\r
'        Line 100 is not removed from the source code. However, more\r
'        complex expressions that contain the +, -, AND, OR, XOR, EQV,\r
'        MOD, or IMP operators may not be handled correctly. For example,\r
'        in the following statement REMLINE does not recognize line 105\r
'        as a referenced line number and removes it from the source code:\r
'\r
'             IF ERL + 5 = 105 THEN END\r
'\r
'   If you do not like the way REMLINE formats its output, you can modify\r
'   the output lines in SUB GenOutFile. An example is shown in comments.\r
DEFINT A-Z\r
\r
' Function and Subprocedure declarations\r
DECLARE FUNCTION GetToken$ (Search$, Delim$)\r
DECLARE FUNCTION StrSpn% (InString$, Separator$)\r
DECLARE FUNCTION StrBrk% (InString$, Separator$)\r
DECLARE FUNCTION IsDigit% (Char$)\r
DECLARE SUB GetFileNames ()\r
DECLARE SUB BuildTable ()\r
DECLARE SUB GenOutFile ()\r
DECLARE SUB InitKeyTable ()\r
\r
' Global and constant data\r
CONST TRUE = -1\r
CONST false = 0\r
CONST MaxLines = 400\r
\r
DIM SHARED LineTable!(MaxLines)\r
DIM SHARED LineCount\r
DIM SHARED Seps$, InputFile$, OutputFile$, TmpFile$\r
\r
' Keyword search data\r
CONST KeyWordCount = 9\r
DIM SHARED KeyWordTable$(KeyWordCount)\r
\r
KeyData:\r
   DATA THEN, ELSE, GOSUB, GOTO, RESUME, RETURN, RESTORE, RUN, ERL, ""\r
\r
' Start of module-level program code\r
   Seps$ = " ,:=<>()" + CHR$(9)\r
   InitKeyTable\r
   GetFileNames\r
   ON ERROR GOTO FileErr1\r
   OPEN InputFile$ FOR INPUT AS 1\r
   ON ERROR GOTO 0\r
   COLOR 7: PRINT "Working"; : COLOR 23: PRINT " . . .": COLOR 7: PRINT\r
   BuildTable\r
   CLOSE #1\r
   OPEN InputFile$ FOR INPUT AS 1\r
   ON ERROR GOTO FileErr2\r
   OPEN OutputFile$ FOR OUTPUT AS 2\r
   ON ERROR GOTO 0\r
   GenOutFile\r
   CLOSE #1, #2\r
   IF OutputFile$ <> "CON" THEN CLS\r
\r
END\r
\r
FileErr1:\r
   CLS\r
   PRINT "      Invalid file name": PRINT\r
   INPUT "      New input file name (ENTER to terminate): ", InputFile$\r
   IF InputFile$ = "" THEN END\r
FileErr2:\r
   INPUT "      Output file name (ENTER to print to screen) :", OutputFile$\r
   PRINT\r
   IF (OutputFile$ = "") THEN OutputFile$ = "CON"\r
   IF TmpFile$ = "" THEN\r
      RESUME\r
   ELSE\r
      TmpFile$ = ""\r
      RESUME NEXT\r
   END IF\r
\r
'\r
' BuildTable:\r
'   Examines the entire text file looking for line numbers that are\r
'   the object of GOTO, GOSUB, etc. As each is found, it is entered\r
'   into a table of line numbers. The table is used during a second\r
'   pass (see GenOutFile), when all line numbers not in the list\r
'   are removed.\r
' Input:\r
'   Uses globals KeyWordTable$, KeyWordCount, and Seps$\r
' Output:\r
'   Modifies LineTable! and LineCount\r
'\r
SUB BuildTable STATIC\r
\r
   DO WHILE NOT EOF(1)\r
      ' Get line and first token\r
      LINE INPUT #1, InLin$\r
      Token$ = GetToken$(InLin$, Seps$)\r
      DO WHILE (Token$ <> "")\r
         FOR KeyIndex = 1 TO KeyWordCount\r
            ' See if token is keyword\r
            IF (KeyWordTable$(KeyIndex) = UCASE$(Token$)) THEN\r
               ' Get possible line number after keyword\r
               Token$ = GetToken$("", Seps$)\r
               ' Check each token to see if it is a line number\r
               ' (the LOOP is necessary for the multiple numbers\r
               ' of ON GOSUB or ON GOTO). A non-numeric token will\r
               ' terminate search.\r
               DO WHILE (IsDigit(LEFT$(Token$, 1)))\r
                  LineCount = LineCount + 1\r
                  LineTable!(LineCount) = VAL(Token$)\r
                  Token$ = GetToken$("", Seps$)\r
                  IF Token$ <> "" THEN KeyIndex = 0\r
               LOOP\r
            END IF\r
         NEXT KeyIndex\r
         ' Get next token\r
         Token$ = GetToken$("", Seps$)\r
      LOOP\r
   LOOP\r
\r
END SUB\r
\r
'\r
' GenOutFile:\r
'  Generates an output file with unreferenced line numbers removed.\r
' Input:\r
'  Uses globals LineTable!, LineCount, and Seps$\r
' Output:\r
'  Processed file\r
'\r
SUB GenOutFile STATIC\r
\r
   ' Speed up by eliminating comma and colon (can't separate first token)\r
   Sep$ = " " + CHR$(9)\r
   DO WHILE NOT EOF(1)\r
      LINE INPUT #1, InLin$\r
      IF (InLin$ <> "") THEN\r
         ' Get first token and process if it is a line number\r
         Token$ = GetToken$(InLin$, Sep$)\r
         IF IsDigit(LEFT$(Token$, 1)) THEN\r
            LineNumber! = VAL(Token$)\r
            FoundNumber = false\r
            ' See if line number is in table of referenced line numbers\r
            FOR index = 1 TO LineCount\r
               IF (LineNumber! = LineTable!(index)) THEN\r
                  FoundNumber = TRUE\r
               END IF\r
            NEXT index\r
            ' Modify line strings\r
            IF (NOT FoundNumber) THEN\r
               Token$ = SPACE$(LEN(Token$))\r
               MID$(InLin$, StrSpn(InLin$, Sep$), LEN(Token$)) = Token$\r
            END IF\r
              \r
            ' You can replace the previous lines with your own\r
            ' code to reformat output. For example, try these lines:\r
               \r
            'TmpPos1 = StrSpn(InLin$, Sep$) + LEN(Token$)\r
            'TmpPos2 = TmpPos1 + StrSpn(MID$(InLin$, TmpPos1), Sep$)\r
            '\r
            'IF FoundNumber THEN\r
            '   InLin$ = LEFT$(InLin$, TmpPos1 - 1) + CHR$(9) + MID$(InLin$, TmpPos2)\r
            'ELSE\r
            '   InLin$ = CHR$(9) + MID$(InLin$, TmpPos2)\r
            'END IF\r
\r
         END IF\r
      END IF\r
      ' Print line to file or console (PRINT is faster than console device)\r
      IF OutputFile$ = "CON" THEN\r
         PRINT InLin$\r
      ELSE\r
         PRINT #2, InLin$\r
      END IF\r
   LOOP\r
\r
END SUB\r
\r
'\r
' GetFileNames:\r
'  Gets a file name by prompting the user.\r
' Input:\r
'  User input\r
' Output:\r
'  Defines InputFiles$ and OutputFiles$\r
'\r
SUB GetFileNames STATIC\r
\r
    CLS\r
    PRINT " Microsoft RemLine: Line Number Removal Utility"\r
    PRINT "       (.BAS assumed if no extension given)"\r
    PRINT\r
    INPUT "      Input file name (ENTER to terminate): ", InputFile$\r
    IF InputFile$ = "" THEN END\r
    INPUT "      Output file name (ENTER to print to screen): ", OutputFile$\r
    PRINT\r
    IF (OutputFile$ = "") THEN OutputFile$ = "CON"\r
\r
   IF INSTR(InputFile$, ".") = 0 THEN\r
      InputFile$ = InputFile$ + ".BAS"\r
   END IF\r
\r
   IF INSTR(OutputFile$, ".") = 0 THEN\r
      SELECT CASE OutputFile$\r
         CASE "CON", "SCRN", "PRN", "COM1", "COM2", "LPT1", "LPT2", "LPT3"\r
            EXIT SUB\r
         CASE ELSE\r
            OutputFile$ = OutputFile$ + ".BAS"\r
      END SELECT\r
   END IF\r
\r
   DO WHILE InputFile$ = OutputFile$\r
      TmpFile$ = LEFT$(InputFile$, INSTR(InputFile$, ".")) + "BAK"\r
      ON ERROR GOTO FileErr1\r
      NAME InputFile$ AS TmpFile$\r
      ON ERROR GOTO 0\r
      IF TmpFile$ <> "" THEN InputFile$ = TmpFile$\r
   LOOP\r
\r
END SUB\r
\r
'\r
' GetToken$:\r
'  Extracts tokens from a string. A token is a word that is surrounded\r
'  by separators, such as spaces or commas. Tokens are extracted and\r
'  analyzed when parsing sentences or commands. To use the GetToken$\r
'  function, pass the string to be parsed on the first call, then pass\r
'  a null string on subsequent calls until the function returns a null\r
'  to indicate that the entire string has been parsed.\r
' Input:\r
'  Search$ = string to search\r
'  Delim$  = String of separators\r
' Output:\r
'  GetToken$ = next token\r
'\r
FUNCTION GetToken$ (Search$, Delim$) STATIC\r
\r
   ' Note that SaveStr$ and BegPos must be static from call to call\r
   ' (other variables are only static for efficiency).\r
   ' If first call, make a copy of the string\r
   IF (Search$ <> "") THEN\r
      BegPos = 1\r
      SaveStr$ = Search$\r
   END IF\r
  \r
   ' Find the start of the next token\r
   NewPos = StrSpn(MID$(SaveStr$, BegPos, LEN(SaveStr$)), Delim$)\r
   IF NewPos THEN\r
      ' Set position to start of token\r
      BegPos = NewPos + BegPos - 1\r
   ELSE\r
      ' If no new token, quit and return null\r
      GetToken$ = ""\r
      EXIT FUNCTION\r
   END IF\r
\r
   ' Find end of token\r
   NewPos = StrBrk(MID$(SaveStr$, BegPos, LEN(SaveStr$)), Delim$)\r
   IF NewPos THEN\r
      ' Set position to end of token\r
      NewPos = BegPos + NewPos - 1\r
   ELSE\r
      ' If no end of token, return set to end a value\r
      NewPos = LEN(SaveStr$) + 1\r
   END IF\r
   ' Cut token out of search string\r
   GetToken$ = MID$(SaveStr$, BegPos, NewPos - BegPos)\r
   ' Set new starting position\r
   BegPos = NewPos\r
\r
END FUNCTION\r
\r
'\r
' InitKeyTable:\r
'  Initializes a keyword table. Keywords must be recognized so that\r
'  line numbers can be distinguished from numeric constants.\r
' Input:\r
'  Uses KeyData\r
' Output:\r
'  Modifies global array KeyWordTable$\r
'\r
SUB InitKeyTable STATIC\r
\r
   RESTORE KeyData\r
   FOR Count = 1 TO KeyWordCount\r
      READ KeyWord$\r
      KeyWordTable$(Count) = KeyWord$\r
   NEXT\r
\r
END SUB\r
\r
'\r
' IsDigit:\r
'  Returns true if character passed is a decimal digit. Since any\r
'  Basic token starting with a digit is a number, the function only\r
'  needs to check the first digit. Doesn't check for negative numbers,\r
'  but that's not needed here.\r
' Input:\r
'  Char$ - initial character of string to check\r
' Output:\r
'  IsDigit - true if within 0 - 9\r
'\r
FUNCTION IsDigit (Char$) STATIC\r
\r
   IF (Char$ = "") THEN\r
      IsDigit = false\r
   ELSE\r
      CharAsc = ASC(Char$)\r
      IsDigit = (CharAsc >= ASC("0")) AND (CharAsc <= ASC("9"))\r
   END IF\r
\r
END FUNCTION\r
\r
'\r
' StrBrk:\r
'  Searches InString$ to find the first character from among those in\r
'  Separator$. Returns the index of that character. This function can\r
'  be used to find the end of a token.\r
' Input:\r
'  InString$ = string to search\r
'  Separator$ = characters to search for\r
' Output:\r
'  StrBrk = index to first match in InString$ or 0 if none match\r
'\r
FUNCTION StrBrk (InString$, Separator$) STATIC\r
\r
   Ln = LEN(InString$)\r
   BegPos = 1\r
   ' Look for end of token (first character that is a delimiter).\r
   DO WHILE INSTR(Separator$, MID$(InString$, BegPos, 1)) = 0\r
      IF BegPos > Ln THEN\r
         StrBrk = 0\r
         EXIT FUNCTION\r
      ELSE\r
         BegPos = BegPos + 1\r
      END IF\r
   LOOP\r
   StrBrk = BegPos\r
  \r
END FUNCTION\r
\r
'\r
' StrSpn:\r
'  Searches InString$ to find the first character that is not one of\r
'  those in Separator$. Returns the index of that character. This\r
'  function can be used to find the start of a token.\r
' Input:\r
'  InString$ = string to search\r
'  Separator$ = characters to search for\r
' Output:\r
'  StrSpn = index to first nonmatch in InString$ or 0 if all match\r
'\r
FUNCTION StrSpn% (InString$, Separator$) STATIC\r
\r
   Ln = LEN(InString$)\r
   BegPos = 1\r
   ' Look for start of a token (character that isn't a delimiter).\r
   DO WHILE INSTR(Separator$, MID$(InString$, BegPos, 1))\r
      IF BegPos > Ln THEN\r
         StrSpn = 0\r
         EXIT FUNCTION\r
      ELSE\r
         BegPos = BegPos + 1\r
      END IF\r
   LOOP\r
   StrSpn = BegPos\r
\r
END FUNCTION\r
\r