Borland TurboBASIC & TurboPASCAL stuff from 1998 when i started with programming...
[mirrors/Programs.git] / turbobasic / 3RD-PA.RTY / REMLINE.BAS
diff --git a/turbobasic/3RD-PA.RTY/REMLINE.BAS b/turbobasic/3RD-PA.RTY/REMLINE.BAS
new file mode 100755 (executable)
index 0000000..959604b
--- /dev/null
@@ -0,0 +1,395 @@
+'\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
This page took 0.18382 seconds and 4 git commands to generate.