'   Directory reading program.  
'   Adapted from READDIR.BAS by Ron Kreymborg
'   Lawrence Davis - 2/23/88
 
'   Compile: BASCOM =RDIR/O/Z/C
'   Link   : L80 RDIR,UCASE,CTAIL,DIR.RRUN,RDIR/N/E

     DEFINT A-Z

'    Set maximum number of files in DIR$(n)
     DIM FCB(20) , DMA(64) , DIR$(100) , CR(2)

'    Read CP/M command line.
     CALL CTAIL(A$)

     IF A$<>"" _
        THEN CMD=-1:GOTO 305

300  PRINT
     INPUT "Enter d:filespec to match: " , A$

     IF A$ = "" _
        THEN END

'    Convert to upper-case
305  CALL UCASE(A$)

'    Extract drive letter and convert to drive code
     DSPEC=INSTR(A$,":")

     IF DSPEC=0 _
        THEN DRV=0

     IF DSPEC >0 THEN _
        DRV$ = LEFT$ (A$ , 1) : DRV = ASC (DRV$) - 64 : A$ = MID$ (A$ , 3)

     PRINT

'    Check for name/ext seperator
     A = INSTR (A$ , ".") : 

     IF A = 0 _
        THEN 310

     A1$ = LEFT$ (A$ , A - 1) : A2$ = MID$ (A$ , A + 1)

'    Process wild card

     IF A1$ = "*" _
        THEN A1$ = "????????"

     IF A2$ = "*" _
        THEN A2$ = "???"

'    Make sure filename is exactly 11 characters
310  IF LEN (A1$) < 8 _
        THEN A1$ = A1$ + SPACE$ (8 - LEN (A1$))

     IF LEN (A2$) < 3 _
        THEN A2$ = A2$ + SPACE$ (3 - LEN (A2$))

     FIL$ = A1$ + A2$
     FCB$ = CHR$(DRV) + FIL$

     FOR I = 1 TO 100
       DIR$ (I) = "           "
      NEXT I

    ' Copy the specified filename into the FCB.

     J = 0
     FCB$ = FCB$+"      "

     FOR I = 0 TO 5
       J = J + 1 : M = 1 : GOSUB 660
       J = J + 1 : M = 256 : GOSUB 660
     NEXT I

'    Set DMA buffer address
     CALL SETDMA(DMA(0))

'    Check if file named in FCB exists
     CALL GET1ST (FCB(0) , FLG)

500  WHILE FLG < 4
     E = E + 1
     GOSUB 720
     CALL GETNXT(FCB(0) , FLG) ' Check for next occurence of file
     WEND

560  GOSUB 900

     POKE 128 , 0             'Clear command line
     IF CMD _
       THEN END

     CALL RRUN
' -------------------------------------------------------------------

'    Sub-Routines
'    ------------

     ' Load the ASCII sequence number into the correct
     ' byte (specified by M) of the Ith FCB word.

660  B$ = MID$(FCB$,J,1)
     FCB(I) = FCB(I)+ASC(B$)*M
     RETURN

     ' Extract each byte from the DMA buffer and load
     ' them into the DIR$ string.

720  K = FLG*16
     U = U+1
     L = 1
     FOR I=K TO K+5
       CALL SPLIT(DMA(I), CR(1), CR(0))
       FOR J=0 TO 1
           IF (I = K AND J = 0)_
              THEN 810
          MID$(DIR$(U),L,1) = CHR$(CR(J))
          L = L+1
810   NEXT J
     NEXT I
     RETURN

'    Sort Directory

900  N = E - 1
     J4 = N
910  J4 = J4 \ 2
     IF J4 = 0 _
        THEN 950
     J2 = N - J4
     J = 1
920  I = J
930  J3 = I + J4
     A = 1 : B = 12
     IF MID$ (DIR$(I) , A , B) <= MID$ (DIR$(J3) , A , B) _
        THEN 940
     SWAP DIR$(I) , DIR$(J3)
     I = I - J4

     IF I >= 1 _
        THEN 930

940  J = J + 1

     IF J > J2 _
        THEN 910

     GOTO 920

' Print Directory

950 FOR I = 1 TO E-1
      IF (I-1) MOD 5 = 0 _
         THEN PRINT 
      PRINT DIR$(I);" : ";
960 NEXT
    PRINT
    PRINT
    F = E - 1
    IF F = 1 THEN _
        PRINT F ; "File found." ELSE PRINT F ; "Files found."
    RETURN