REM file: Findy.bas - Public Domain DOS Utility
REM Version 1.0a created 06/13/1995
REM Version 1.1a created 03/06/2001
REM Version 1.2a created 11/04/2005
REM Version 1.3a created 12/10/2005

' default integer variables
DEFINT A-Z
REM $DYNAMIC

' define boolean values
CONST True = -1
CONST False = NOT True
CONST TrueD = -1#
CONST FalseD = NOT TrueD
CONST NUL = ""

' define color values
CONST Black = 0
CONST Green = 10
CONST Plain = 7
CONST Red = 12
CONST White = 15
CONST Yellow = 14

' declare include files
REM $INCLUDE: 'qbx.bi'

' declare functions
DECLARE FUNCTION ParseLine (S$)
DECLARE FUNCTION BreakIS()
DECLARE FUNCTION ClearBreak()
DECLARE FUNCTION KeyIS()

' declare registers
COMMON SHARED InregsX AS RegtypeX, OutregsX AS RegtypeX
COMMON SHARED InregsX2 AS RegTypeX, InregsX3 AS RegTypeX

' declare work variables
COMMON SHARED Reverse.Search AS INTEGER, Search.Column AS INTEGER
COMMON SHARED Ignore.Case AS INTEGER, Continuous.Display AS INTEGER
COMMON SHARED Lines.Counted AS INTEGER, List.Lines AS INTEGER
COMMON SHARED Display.Lines AS INTEGER, Line.Number AS INTEGER
COMMON SHARED Boolean.Search AS INTEGER, WildCard.Search AS INTEGER

' declare command line work variables
COMMON SHARED Command.Line AS STRING, Command.Work AS STRING
COMMON SHARED Search.String AS STRING, Input.Line AS STRING
COMMON SHARED Line.Input AS STRING, Char AS STRING
COMMON SHARED Control.Break AS INTEGER, Last.Switch AS INTEGER
COMMON SHARED Pipe.Buffer AS STRING * 1, Redirected.Input AS INTEGER

' declare external procedures
DECLARE SUB SetInt
DECLARE SUB RestInt

' backwards compatible for bc 7.1
REM $INCLUDE: 'bc7.inc'

' install new interrupt service routine
CALL SetInt

' declare standard error trap
ON ERROR GOTO Error.Routine

' reset count variables
Lines.Counted = False
Line.Number = False

' command line parser
FUNCTION ParseLine (X$)
 Imbedded = INSTR(Command.Line, LCASE$(X$))
 IF Imbedded THEN
    Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + LEN(X$))
    Last.Switch = Imbedded - 1
    ParseLine = True
 ELSE
    Imbedded = INSTR(Command.Line, UCASE$(X$))
    IF Imbedded THEN
       Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded + LEN(X$))
       Last.Switch = Imbedded - 1
       ParseLine = True
    ELSE
       ParseLine = False
    END IF
 END IF
END FUNCTION 

' check command line
SELECT CASE COMMAND$
CASE "/?"
   GOTO Boot.Usage
END SELECT

' read command line from PSP
Command.Line = 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
      Command.Line = Command.Line + CHR$(Command.Char)
   END SELECT
NEXT
DEF SEG
IF Command.Line = NUL THEN
   Command.Line = ENVIRON$("FINDY")
END IF
Command.Line = RTRIM$(Command.Line)
Command.Line = LTRIM$(Command.Line)

' locate string to search for
Command.Work = NUL
FOR Count = LEN(Command.Line) TO 1 STEP -1
   IF MID$(Command.Line, Count, 1) = CHR$(34) THEN
      Command.Work = LEFT$(Command.Line, Count - 1)
      Command.Line = MID$(Command.Line, Count + 1)
      Last.Switch = 1
      EXIT FOR
   END IF
NEXT
IF LEFT$(Command.Work, 1) = CHR$(34) THEN
   Command.Work = MID$(Command.Work, 2)
ELSE
   GOTO Boot.Error
END IF
Search.String = Command.Work

' check command line switches
Boolean.Search = ParseLine("/B")
Continuous.Display = ParseLine ("/C")
Display.Lines = ParseLine ("/D")
Ignore.Case = ParseLine ("/I")
List.Lines = ParseLine ("/L")
Reverse.Search = ParseLine ("/R")
WildCard.Search = ParseLine("/W")
Control.Break = ParseLine ("/~")
Var = ParseLine("/_")

' get search column
Search.Column = 1
Imbedded = INSTR(UCASE$(Command.Line), "/N")
IF Imbedded THEN
   Last.Switch = Imbedded - 1
   Imbedded2 = Imbedded + 2
   DO
      Switch$ = MID$(Command.Line, Imbedded2, 1)
      IF Switch$ >= "0" AND Switch$ <= "9" THEN
         Column$ = Column$ + Switch$
      ELSE
         EXIT DO
      END IF
      Imbedded2 = Imbedded2 + 1
   LOOP
   IF Column$ = Nul THEN
      GOTO Boot.Error
   END IF
   Search.Column = INT(VAL(Column$))
   IF Search.Column = False THEN
      GOTO Boot.Error
   END IF
   Command.Line = LEFT$(Command.Line, Imbedded - 1) + MID$(Command.Line, Imbedded2)
END IF
Command.Line = RTRIM$(Command.Line)

' recheck command line
IF INSTR(Command.Line, "/") THEN
   GOTO Boot.Error
END IF
Command.Line = RTRIM$(Command.Line)
IF Last.Switch THEN
   IF LEN(Command.Line) > Last.Switch THEN
      GOTO Boot.Error
   END IF
END IF

' check for case sensitive
IF Ignore.Case THEN
   Search.String = UCASE$(Search.String)
END IF

' check break flag override
IF Control.Break THEN
   Var = ClearBreak
END IF

' search through all redirected input
Line.Input = NUL
Redirected.Input = False

' check pipe 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
   DEF SEG = &H40
   X = PEEK(&H71)
   DEF SEG
   IF X = 64 THEN
      DEF SEG = &H40
      POKE &H71, 0
      DEF SEG
   END IF
Endif
If OutregsX.AX > 0 Then
   InregsX.AX = &H4200
   InregsX.BX = 0 ' stdin
   InregsX.CX = 0
   InregsX.DX = 0
   Call InterruptX(&H21, InregsX, OutregsX)
   DO
      ' check control break
      IF BreakIS THEN
         EXIT DO
      END IF

      ' read from device
      InregsX.AX = &H3F00
      InregsX.BX = 0 ' stdin
      InregsX.CX = 1 ' char
      InregsX.DS = VARSEG(Pipe.Buffer)
      InregsX.DX = VARPTR(Pipe.Buffer)
      Call InterruptX(&H21, InregsX, OutregsX)
      If (OutregsX.Flags AND &H1) = &H1 Then
         Exit Do
      Endif
      If (OutregsX.Flags AND &H1) = &H0 Then
         If OutregsX.AX = 0 Then
            Exit Do
         Endif

         ' store input flag
         Redirected.Input = True

         ' store character
         Char = Pipe.Buffer

         ' check character
         SELECT CASE ASC(Char)
         CASE 13
         CASE 10
            Line.Number = Line.Number + 1
            Input.Line = Line.Input
            IF Ignore.Case THEN
               Input.Line = UCASE$(Input.Line)
            END IF
            Input.Line = MID$(Input.Line, Search.Column)
            GOSUB Search.Pattern
            If VarX Then
               IF Reverse.Search = 0 THEN
                  GOSUB Display.Line
               END IF
            ELSE
               IF Reverse.Search THEN
                  GOSUB Display.Line
               END IF
            END IF
            Line.Input = NUL
         CASE ELSE
            Line.Input = Line.Input + Char
         END SELECT
      END IF
   LOOP
END IF

' check control break
IF BreakIS THEN
   GOTO End.Findy
END IF

' check filename
IF Redirected.Input = False THEN
   CALL RestInt ' restore Control-Break
   X$ = Inkey$ ' quits here
   CALL SetInt ' reset Control-Break
END IF

End.Findy:
IF Continuous.Display = False THEN
   COLOR Yellow, Black
   PRINT "Lines counted"; Lines.Counted
   Prompt$ = "Press <enter> to exit to DOS:"
   CALL MorePrompt(Prompt$, CHR$(13), Outpt$)
END IF

' restore key trapping
CALL RestInt
COLOR Plain, Black
END

' display search found string
Display.Line:
 Lines.Counted = Lines.Counted + 1
 IF List.Lines = False THEN
    COLOR Yellow, Black
    IF Display.Lines THEN
       PRINT MID$(STR$(Line.Number), 2); " ";
    END IF
    PRINT Line.Input
 END IF
 RETURN

' search string with wildcard and boolean matching
Search.Pattern:
 VarX=False
 If Boolean.Search Then
    If Instr(Search.String, "&") Then
       Search.String2$ = Search.String
       CommandLine2$ = Search.String
       First = Instr(CommandLine2$, "&")
       Search.String = Left$(CommandLine2$, First - 1)
       CommandLine2$ = Mid$(CommandLine2$, First + 1)
       Do
          Gosub Get.Match
          If VarX = False Then
             Exit Do
          Endif
          If CommandLine2$ = Nul Then
             Exit Do
          Endif
          First = Instr(CommandLine2$,"&")
          If First Then
             Search.String = Left$(CommandLine2$, First - 1)
             CommandLine2$ = Mid$(CommandLine2$, First + 1)
          Else
             Search.String = CommandLine2$
             CommandLine2$ = Nul
          Endif
       Loop
       Search.String = Search.String2$
       Return
    Endif
 Endif
 Gosub Get.Match
 Return

Get.Match:
 VarX=False
 IF Search.String = Nul THEN
    IF Input.Line = Nul THEN
       VarX = True
    END IF
    RETURN
 END IF
 If Wildcard.Search Then
    Gosub CheckWildcard
    If Match Then
       VarX = True
    Endif
 Else
    If Instr(Input.Line, Search.String) Then
       VarX = True
    Endif
 Endif
 Return

CheckWildcard:
 Match = False
 Length1 = LEN(Search.String)
 FOR I1 = 1 TO LEN(Input.Line)
    S$ = MID$(Input.Line, 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$(Search.String, I2, 1) <> "?" THEN
          IF MID$(Search.String, 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

Boot.Usage:
 ' restore key trapping
 CALL RestInt
 Var$=Inkey$
 ' make header
 COLOR White, Black
 PRINT "Findy v1.3a: Pipe find utility; "
 COLOR Yellow, Black
 PRINT "Usage:"
 PRINT "   Findy "; CHR$(34); "string"; CHR$(34); " [/bcdilnrw]"
 PRINT "Where:"
 PRINT "   "; CHR$(34); "search"; CHR$(34); "  is required search string"
 PRINT "   /b  boolean search"
 PRINT "   /c  continuous list"
 PRINT "   /d  display line number"
 PRINT "   /i  ignore case"
 PRINT "   /l  only list lines counted"
 PRINT "   /n###  search at column"
 PRINT "   /r  unmatched search"
 PRINT "   /w  wildcard search"
 COLOR Plain, Black
 END

Boot.Error:
 CALL RestInt
 Var$=Inkey$
 COLOR White, Black
 PRINT "Command line error. Type Findy /? for help."
 COLOR Plain, Black
 END

' critical error trap
Error.Routine:
 Data.Error = ERR
 SELECT CASE Data.Error
 CASE 9
    PRINT "Subscript out of range."
    END
 CASE 14
    PRINT "Out of string space."
    END
 CASE 53
    Temp.Outpt$ = "File not found."
 CASE 61
    Temp.Outpt$ = "Disk full."
 CASE 70
    Temp.Outpt$ = "Permission denied."
 CASE 71
    Temp.Outpt$ = "Disk not ready."
 CASE ELSE
    Temp.Outpt$ = "Untrapped error" + STR$(Data.Error) + "."
 END SELECT
 COLOR White, Black
 PRINT Temp.Outpt$
 Prompt$ = "Press R to retry, Q to quit, C to continue:"
 CALL MorePrompt(Prompt$, "rqc", Outpt$)
 IF BreakIS THEN
    Outpt$ = "q"
 END IF
 SELECT CASE Outpt$
 CASE "r"
    RESUME
 CASE "q"
    Error.Level = True
    RESUME End.Findy
 CASE "c"
    OutregsX.Flags = &H1
    RESUME NEXT
 END SELECT
 COLOR Plain, Black
 ' restore key trapping
 CALL RestInt
 END 0

SUB MorePrompt (Input.String$, Input.Mask$, Output.String$)
 COLOR White, Black
 PRINT Input.String$ + " ";
 Input.Char$ = NUL
 DO
    LOCATE , , 1
    InregsX2 = InregsX
    DO
       IF BreakIS THEN
          EXIT DO
       END IF
       IF KeyIS THEN
          IF OutregsX.AX <> 0 THEN
             InregsX.AX = &H0000
             CALL InterruptX(&H16, InregsX, OutregsX)
             Input.Char$=CHR$(OutregsX.AX AND &HFF)
             EXIT DO
          END IF
       END IF
    LOOP
    InregsX = InregsX2
    IF BreakIS THEN
       EXIT DO
    END IF
    IF LEN(Input.Char$) THEN
       Input.Char$ = LCASE$(Input.Char$)
       IF INSTR(Input.Mask$, Input.Char$) THEN
	  PRINT Input.Char$
	  Output.String$ = Input.Char$
	  EXIT DO
       END IF
    END IF
 LOOP
END SUB

' clears Control-Break flag
FUNCTION ClearBreak
 DEF SEG = &H40
 POKE &H71, &H0
 DEF SEG
 ClearBreak = True
END FUNCTION

' checks Control-Break flag
FUNCTION BreakIS
 STATIC Var AS INTEGER
 IF Redirected.Input THEN
    DEF SEG = &H40
    X = PEEK(&H71)
    DEF SEG
    IF X = 64 THEN
       Var = True
    END IF
 END IF
 IF KeyIS THEN
    IF OutregsX.AX = 0 THEN
       Var = True
       DEF SEG = &H40
       POKE &H71, 64
       DEF SEG
    END IF
 END IF
 IF Var THEN
    Continuous.Display = True
 END IF
 BreakIS = Var
END FUNCTION

' checks keyboard buffer
FUNCTION KeyIS
 InregsX3 = InregsX
 InregsX.AX = &H0100
 CALL InterruptX(&H16, InregsX, OutregsX)
 InregsX = InregsX3
 IF (OutregsX.Flags AND &H40) = &H40 THEN
    KeyIS = False
 ELSE
    KeyIS = True
 END IF
END FUNCTION
