REM Parse/combine stdin, work filename contents, command line. v1.0a PD 2006.

REM Example to copy paths from temp.lst:
REM   Type temp.lst | Parse *.txt *.lst

REM Example to copy paths from temp.lst and a file list:
REM   Type temp.lst | Parse @filelist.txt *.txt *.lst

' declare all variables integer
DEFINT A-Z
REM $DYNAMIC

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

' define color values
CONST Black = 0
CONST Plain = 7
CONST White = 15
CONST Yellow = 14

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

' declare registers
COMMON SHARED InregsX AS RegTypeX, OutregsX AS RegTypeX

' declare buffers
COMMON SHARED Pipe.Buffer AS STRING * 1

' 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 error routine
ON ERROR GOTO Error.Routine

' 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

' store command line
Command.Line$ = RTRIM$(Command.Line$)
Command.Line$ = LTRIM$(Command.Line$)
Command.Line.Redirect$ = Command.Line$

' search through all input filenames
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
   Pipe.Redirect = True
   InregsX.AX = &H4200
   InregsX.BX = 0 ' stdin
   InregsX.CX = 0
   InregsX.DX = 0
   Call InterruptX(&H21, InregsX, OutregsX)
Endif
DO
   ' get standard input
   Standard.Input$ = NUL

   If Pipe.Redirect Then
      DO

         ' 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
            Redirected.Input = True

            ' store character
            Char$ = Pipe.Buffer

            ' check input character
            SELECT CASE ASC(Char$)
            CASE 10, 26
            CASE 13
               EXIT DO
            CASE ELSE
               Standard.Input$ = Standard.Input$ + Char$
            END SELECT
         END IF
      LOOP
   END IF

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

   ' check standard input
   IF Redirected.Input THEN
      IF Standard.Input$ = NUL THEN
	 EXIT DO
      END IF
   END IF

   ' process redirected input
   Command.Line$ = Command.Line.Redirect$

   ' process command loop
   DO

      ' store redirected input
      Standard.Input$ = RTRIM$(Standard.Input$)
      Standard.Input$ = LTRIM$(Standard.Input$)
      IF LEFT$(Standard.Input$, 1) = CHR$(34) THEN
         Standard.Input$ = MID$(Standard.Input$, 2)
      END IF
      IF RIGHT$(Standard.Input$, 1) = CHR$(34) THEN
         Standard.Input$ = LEFT$(Standard.Input$, LEN(Standard.Input$) - 1)
      END IF

      ' process work filename
      IF LEFT$(Command.Line$, 1) = "@" THEN

	 ' make input filename
         Command.Line$ = MID$(Command.Line$, 2)
         GOSUB Make.Filename

	 ' process work filename
	 CLOSE #1
         OPEN Command.Work$ FOR INPUT SHARED AS #1

         ' process input filenames
         DO UNTIL EOF(1)
            LINE INPUT #1, Command.Work$

            ' process search filename
            Command.Work$ = RTRIM$(Command.Work$)
            IF LEN(Command.Work$) THEN
               Command.Work$ = Standard.Input$ + Command.Work$
               COLOR Yellow, Black
               PRINT Command.Work$
            END IF
         LOOP
      ELSE
         IF Command.Line$=Nul THEN
	    EXIT DO
         END IF
         GOSUB Make.Filename
         Command.Work$ = Standard.Input$ + Command.Work$
         COLOR Yellow, Black
         PRINT Command.Work$
      END IF
   LOOP

   ' check standard input
   IF Standard.Input$ = NUL THEN
      EXIT DO
   END IF
LOOP

End.Parse:

' restore key trapping
CALL RestInt

COLOR Plain, Black
END

' construct filename from command line
Make.Filename:
 IF LEFT$(Command.Line$, 1) = CHR$(34) THEN
    Imbedded = INSTR(2, Command.Line$, CHR$(34))
    IF Imbedded THEN
       Command.Work$ = MID$(Command.Line$, 2, Imbedded - 2)
       Command.Line$ = MID$(Command.Line$, Imbedded + 1)
    ELSE
       Command.Work$ = Command.Line$
       Command.Line$ = NUL
    END IF
 ELSE
    Imbedded = INSTR(Command.Line$, " ")
    IF Imbedded THEN
       Command.Work$ = LEFT$(Command.Line$, Imbedded - 1)
       Command.Line$ = MID$(Command.Line$, Imbedded + 1)
    ELSE
       Command.Work$ = Command.Line$
       Command.Line$ = NUL
    END IF
 END IF
 RETURN

' critical error trap
Error.Routine:
 SELECT CASE ERR
 CASE 53
    Outpt$ = "File not found."
 CASE 61
    Outpt$ = "Disk full."
 CASE 70
    Outpt$ = "Permission denied."
 CASE 71
    Outpt$ = "Disk not ready."
 CASE ELSE
    Outpt$ = "Untrapped error" + STR$(ERR) + "."
 END SELECT
 COLOR White, Black
 PRINT Outpt$
 COLOR Plain, Black
 ' restore key trapping
 CALL RestInt
 END
