REM Program Findcode v1.6a for Dndbbs Version v5.0a Release r2.0
REM $INCLUDE: 'io9.inc'

' declare functions
FUNCTION Form$(Var#)
 Form$=Format$(Var#,"#,##0;;"+Chr$(34)+"zero"+Chr$(34))
END FUNCTION

Function Timeit!
 t1$ = Format$(Now, "hh:mm:ss") ' seconds past midnight
 t1! = CSNG(INT(VAL(MID$(t1$, 1, 2)))) * 3600! + CSNG(INT(VAL(MID$(t1$, 4, 2)))) * 60! + CSNG(INT(VAL(MID$(t1$, 7, 2))))
 Timeit!=t1!
End Function

Max.Routines=1024

On Error Goto Error.Routine
Call Stdin(Var)

REDIM Routines(Max.Routines) AS STRING
COLOR 15, 0
PRINT "Subroutine finder v1.6a:"

' read command line from PSP
CommandLine$ = Nul
InregsX.AX=&H6200
Call InterruptX(&H21,InregsX,OutregsX)
PSPsegment = OutregsX.BX
PSPoffset = 128
DEF SEG = PSPsegment
FOR Count = 1 TO 127
   Command.Char = PEEK(PSPoffset + Count)
   SELECT CASE Command.Char
   CASE 0, 10, 13
      EXIT FOR
   CASE ELSE
      CommandLine$ = CommandLine$ + CHR$(Command.Char)
   END SELECT
NEXT
DEF SEG

CommandLine$ = LTRIM$(CommandLine$)
IF CommandLine$ = "/?" OR CommandLine$ = "-?" THEN
   COLOR 14, 0
   PRINT "Finds subroutines in dndbbs basic source files:"
   Color 15,0
   Print "Where:"
   Color 14,0
   Print "Command line switches(preceded):"
   Color 15,0
   Print " /D  -  write to disk."
   Print " /P  -  force percent display"
   Color 14,0
   Print "Command line(remaining):"
   Color 15,0
   Print " Filename override enclosed in quotes(optional)."
   Print " Specify subroutine to find after filename."
   Print " Also use ? for wildcard character replacement,"
   Print " and use & character for boolean 'and' split."
   COLOR 7, 0
   END
END IF
Do
   CommandLine$ = LTRIM$(CommandLine$)
   If Left$(CommandLine$,1)="/" Then
      If Mid$(Ucase$(CommandLine$),2,1)="D" Then
         Write.Data.File=True
         CommandLine$=Mid$(CommandLine$,3)
      Else
         If Mid$(Ucase$(CommandLine$),2,1)="P" Then
            Percent.Display=True
            CommandLine$=Mid$(CommandLine$,3)
         Else
            Exit Do
         Endif
      Endif
   Else
      Exit Do
   Endif
Loop
CommandLine$=Rtrim$(CommandLine$)
CommandLine$=Ltrim$(CommandLine$)
If Left$(CommandLine$,1)=Chr$(34) Then
   Var=Instr(2,CommandLine$,Chr$(34))
   If Var Then
      Var2$=Left$(CommandLine$,Var)
      Print "Search filename ";Var2$;"(y/n)? ";
      Locate ,,1
      Do
         Var$=Inkey$
         If Len(Var$) Then
            Select Case Lcase$(Var$)
            Case "y"
               Print "y"
               FileSpec2$=Left$(CommandLine$,Var)
               CommandLine$=Mid$(CommandLine$,Var+1)
               FileSpec2$=Mid$(FileSpec2$,2)
               FileSpec2$=Left$(FileSpec2$,Len(FileSpec2$)-1)
               Exit Do
            Case "n"
               Print "n"
               Exit Do
            End Select
         Endif
         Gosub TimeSlice
      Loop
   Endif
Endif
CommandLine$=Rtrim$(CommandLine$)
CommandLine$=Ltrim$(CommandLine$)
CommandLine$=Ucase$(CommandLine$)
IF CommandLine$ = Nul THEN
   COLOR 15, 0
   PRINT "Enter subroutine name? ";
   Do
      X$=Inkey$
      Locate ,,1
      If Len(X$)=1 Then
         If X$=Chr$(13) Then
            Exit Do
         Endif
         If X$=Chr$(8) Then
            If Len(CommandLine$) Then
               Print Chr$(29);" ";Chr$(29);
               CommandLine$=Left$(CommandLine$,Len(CommandLine$)-1)
            Endif
         Else
            CommandLine$=CommandLine$+X$
            Print X$;
         Endif
      Endif
      Gosub TimeSlice
   Loop
   Print
   If CommandLine$ = "" Then
      End
   Endif
END IF
IF LEFT$(LCASE$(CommandLine$), 4) = "sub " THEN
   COLOR 14, 0
   PRINT "Do not prefix 'sub ' for search."
   COLOR 7, 0
   END
END IF
IF INSTR(CommandLine$, "?") THEN
   PRINT "Use wildcards(y/n)? ";
   LOCATE , , 1
   DO
      Var$ = INKEY$
      IF LEN(Var$) THEN
         SELECT CASE LCASE$(Var$)
         CASE "y"
            PRINT "y"
            Wildcard = True
            EXIT DO
         CASE "n"
            PRINT "n"
            Wildcard = False
            EXIT DO
         END SELECT
      END IF
      Gosub TimeSlice
   LOOP
END IF
Search$ = "Sub " + CommandLine$
COLOR 15, 0
PRINT "Finding: "; CHR$(34);
COLOR 14, 0
PRINT Search$;
COLOR 15, 0
PRINT CHR$(34); " ";
IF Wildcard Or Percent.Display THEN
   PRINT "    ";
END IF
VarF! = TIMEIT!
CommandLine$ = LTRIM$(CommandLine$)
CommandLine$ = RTRIM$(CommandLine$)
CommandLine$ = "sub " + CommandLine$
CommandLine$ = LCASE$(CommandLine$)
Length = LEN(CommandLine$)
If Len(FileSpec2$) Then
   FileSpec$=FileSpec2$
Else
   FileSpec$="*.bas"
Endif
Filename$ = DIR$(FileSpec$)
WHILE LEN(Filename$)
   Total.Files = Total.Files + 1
   Filename$ = DIR$
WEND
If Total.Files = 0 Then
   Color 14, 0
   Print "No search files found."
   Color 7, 0
   PRINT
   PRINT "Exiting to system:"
   End
Endif
If Len(FileSpec2$) Then
   FileSpec$=FileSpec2$
Else
   FileSpec$="*.bas"
Endif
Filename$ = DIR$(FileSpec$)
WHILE LEN(Filename$)
   IF INKEY$ = CHR$(27) THEN
      COLOR 7, 0
      PRINT
      PRINT "Exiting to system:"
      END
   END IF
   CLOSE #1
   OPEN Filename$ FOR INPUT AS #1
   Current.File = Current.File + 1
   GOSUB Dot.Display
   DO WHILE NOT EOF(1)
      LINE INPUT #1, InputLine$
      If Instr(InputLine$, "'") Then
         InputLine$ = RTRIM$(LEFT$(InputLine$, INSTR(InputLine$, "'") - 1))
      Endif
      IF INSTR(InputLine$, "(") THEN
         InputLine$ = RTRIM$(LEFT$(InputLine$, INSTR(InputLine$, "(") - 1))
      END IF
      InputLine$ = LTRIM$(LCASE$(InputLine$))
      VarX = False
      IF LEFT$(InputLine$, 4) = "sub " THEN
         IF WildCard THEN
            GOSUB CheckWildcard
            IF Match THEN
               VarX = True
            END IF
         ELSE
            IF InputLine$ = CommandLine$ THEN
               VarX = True
            END IF
         END IF
      END IF
      IF VarX THEN
         Routine1 = Routine1 + 1
         IF Routine1 > Max.Routines THEN
            Max.Routines = Max.Routines + 64
            REDIM PRESERVE Routines(Max.Routines) AS STRING
         END IF
         Routines(Routine1) = Filename$
         EXIT DO
      END IF
   LOOP
   Filename$ = DIR$
WEND
PRINT
IF Routine1 > 1 THEN
   FOR Sort1 = 1 TO Routine1
      FOR Sort2 = Sort1 + 1 TO Routine1
         IF Routines(Sort1) > Routines(Sort2) THEN
            SWAP Routines(Sort1), Routines(Sort2)
         END IF
      NEXT
   NEXT
END IF
COLOR 15, 0
SELECT CASE Routine1
CASE 0
   PRINT "No Subroutines found."
   Color 7, 0
   PRINT
   PRINT "Exiting to system:"
   End
CASE 1
   PRINT "Total of 1 subroutine found."
CASE ELSE
   PRINT "Total of "+FOrm$(Cdbl(Routine1))+" subroutines found."
END SELECT
Page = 1
COLOR 14, 0
IF Routine1 > False THEN
   IF Write.Data.File THEN
      CLOSE #1
      OPEN "TODO.LST" FOR APPEND AS #1
      PRINT #1, "Results for: " + CommandLine$ + " " + Format$(Now,"mm-dd-yyyy")
   END IF
   FOR Var = 1 TO Routine1
      Filename$ = Routines(Var)
      Filename$ = Filename$ + SPACE$(15 - LEN(Filename$))
      IF Write.Data.File THEN
         PRINT #1, Filename$;
      ELSE
         PRINT Filename$;
      END IF
      Line1 = Line1 + 1
      IF Line1 = 5 THEN
         IF Write.Data.File THEN
            PRINT #1, ""
         ELSE
            PRINT
            Page = Page + 1
            IF Page = 23 THEN
               Page = False
               COLOR 15, 0
               PRINT "More:";
               WHILE INKEY$ = Nul
                  Gosub TimeSlice
               WEND
               PRINT
               COLOR 14, 0
            END IF
         END IF
         Line1 = False
      END IF
   NEXT
   IF Write.Data.File THEN
      Print #1,Chr$(13)+Chr$(10)
      PRINT "Data appended to 'todo.lst'"
   END IF
END IF
IF Write.Data.File=False THEN
   If Page Then
      If Line1>0 Then
         Print
      Endif
      Color 15, 0
      Print "More:";
      While Inkey$=Nul
         Gosub TimeSlice
      Wend
   Endif
Endif
COLOR 7, 0
PRINT
PRINT "Exiting to system:"
END

CheckWildcard:
 Match = False
 Length1 = LEN(CommandLine$)
 FOR I1 = 1 TO LEN(InputLine$)
    S$ = MID$(InputLine$, I1)
    S$ = LEFT$(S$, Length1)
    IF LEN(S$) <> Length1 THEN
       EXIT FOR
    END IF
    ' compare search string to wildcard
    VarQ = True
    FOR I2 = 1 TO Length1
       IF MID$(CommandLine$, I2, 1) <> "?" THEN
          IF MID$(CommandLine$, I2, 1) <> MID$(S$, I2, 1) THEN
             VarQ = False
             EXIT FOR
          END IF
       END IF
    NEXT
    IF VarQ THEN
       Match = True
       EXIT FOR
    END IF
 NEXT
 RETURN

Dot.Display:
 IF Wildcard OR Percent.Display THEN
    Percent! = (Current.File / Total.Files) * 100!
    Percent! = INT(Percent!)
    FOR Imbedded = 1 TO 4
       PRINT CHR$(29); " "; CHR$(29);
    NEXT
    PRINT RIGHT$(STR$(Percent! + 1000!), 3) + "%";
    RETURN
 END IF
 VarG! = TIMEIT! - VarE!
 IF VarG! < SFalse THEN
    VarG! = Elapsed.Time! + 86400!
 END IF
 IF VarG! >= 1! THEN
    VarE! = TIMEIT!
    IF VarD = False THEN
       VarC = VarC + 1
       PRINT ".";
       IF VarC = 5 THEN
          VarD = True
          VarC = False
       END IF
    ELSE
       VarC = VarC + 1
       LOCATE CSRLIN, POS(0) - 1, 0
       PRINT " ";
       LOCATE CSRLIN, POS(0) - 1, 1
       IF VarC = 5 THEN
          VarD = False
          VarC = False
       END IF
    END IF
 END IF
 RETURN

TimeSlice:
 InregsX.AX=&H1680
 InregsX.BX=&H0000
 Call InterruptX(&H2F,InregsX,OutregsX)
 Return

Error.Routine:
 If Err=5 Then
    InputLine$=""
    Resume Next
 Endif
 Print "Error";Err
 End

Sub Stdin(Var)
 Var=0
 ' check stdin length
 InregsX.AX = &H4202 ' eof
 InregsX.BX = 0 ' stdin
 InregsX.CX = 0
 InregsX.DX = 0
 CALL InterruptX(&H21, InregsX, OutregsX)
 IF OutregsX.AX = 0 THEN ' no input found
     EXIT SUB
 END IF
 Print "Illegal standard input attempted."
 END
End Sub


