Click above to get retro games delivered to your door ever month!

 /*
   Source File: APTFILER.PRG
        System: ApT Library
        Author: JAO
      Comments: Pick list of files dialog box

   Function list
   =============
   function aptFiler()     : File selection dialog
   function aptDirectory() : Load file into array and sort the result
   static selectFile()     : Record the currently highlighted file
   static getWcard()       : Change wildcard specification
   static trimPath()       : Trim a path to fit in the box

   Copyright (c) 1991 - 1993, APTware Ltd
 */

 #include "aptfiler.ch"
 #include "inkey.ch"
 #include "directry.ch"
 #include "setcurs.ch"

 static aDir     ,;  // Directory array
        cFileName,;  // File selected
        cPath    ,;  // Path of file selected
        nLen         // Number of files

 /*
              FUNCTION aptFiler
    Purpose : Display files pick-list and allow selection
    In      : cWcard - DOS Wildcard                    Default: "*.*"
    Returns : Fully qualified filename (pathname + filename)
    Example : cFile := aptFiler("*.prn")
    Notes   : aptFiler() is a general purpose dialog box that offers a pick
            : list of the files that match the wildcard in the current
            : directory, and lets the user change directory at will.
 */

 function aptFiler(cWcard)

   local oDCol    ,; // tbcolumn object
        oDIR      ,; // tbrowse object
        nP, nR, nC,; // Screen coordinates
        i         ,; // Index into files array (details for a single file)
        nAsk      ,; // Button selected in dialog box
        cDir := substr(getargv(0), 1, rat("\", getargv(0)))

   default cWcard to "*.*"

   pushscr(0,0,maxrow(),maxcol())
   setblink(.f.)
   setcursor(SC_NONE)
   cPath := normPath(cDir)

   nP := aptBox(37,13,,,,trimPath(cPath,35),,.t.,.f.)
   nR := abs2r(nP)
   nC := abs2c(nP)
   do while .t.
     i := 1
     if len(aDir := aptDirectory(cWcard,"D")) == 0
      if aptAsk("No matching files!;Set specification set to all?", YESNO) == 2
        cFileName := "."
        exit
      endif
      cWcard := "*.*"
      loop
     endif
     oDIR := tbrowsenew(nR + 1, nC + 4, nR + 9, nC + 19)
     oDIR:skipBlock         := {|x,k,o| o := i, k := i + x,;
                                        i := if(k > nLen, nLen,;
                                             if(k < 1, 1, i + x)), i - o}
     oDIR:goTopBlock        := {|| i := 1}
     oDIR:goBottomBlock     := {|| i := nLen}
     oDIR:colorSpec         := PICKC
     oDIR:cargo             := array(TB_CARGO_DIM)
     oDIR:cargo[TB_LEDIT]   := .f.
     oDIR:cargo[TB_REDRAW]  := .t.
     oDIR:cargo[TB_REOPEN]  := .f.
     oDIR:cargo[TB_SHADOW]  := .f.
     oDIR:cargo[TB_STABIL]  := {|o| aptStabilize(o)}
     oDIR:cargo[TB_BOX]     := BROWB
     oDIR:cargo[TB_METHODS] := ;
       {{K_ESC       , {|o| tbQuit(o)}}                 ,;
        {K_UP        , {|o| o:up(),o}}                  ,;
        {K_DOWN      , {|o| o:down(),o}}                ,;
        {K_PGDN      , {|o| o:pageDown(),o}}            ,;
        {K_PGUP      , {|o| o:pageUp(),o}}              ,;
        {K_HOME      , {|o| o:home(),o}}                ,;
        {K_END       , {|o| o:end(),o}}                 ,;
        {K_CTRL_PGUP , {|o| o:goTop(),o}}               ,;
        {K_CTRL_PGDN , {|o| o:goBottom(),o}}            ,;
        {K_ENTER     , {|o| selectFile(o,cWcard)}}      ,;
        {K_TAB       , {|o| tbQuit(o)}}}

     if isMouse()
       oDIR:cargo[TB_INIT] := {|| pushHot(nR, nC + 21, nR + 8, nC + 33, ;
                              {|| aptputkey(K_TAB)})}
     endif

     oDCol := tbcolumnnew("", {|| aDir[i, F_NAME]})
     oDCol:width := 15
     oDIR:addColumn(oDCol)
     aptButtons(BUT_SAY, {"WCARD", BUT_OK, BUT_CANCEL},;
       nR + 1, nC + 23, 0, ASKC, BUT_VERTICAL)
     oDIR := tbKeyHandler(oDIR, .f.)
     if lastkey() == K_TAB .or. lastkey() == K_ESC
       if lastkey() == K_ESC .or. (nAsk := aptButtons(BUT_GET)) == 3
         chdir(substr(cDir, 1, len(cDir) - 1))
         cFilename := "."
         exit
       elseif nAsk == 1
         cWcard := getWcard(cWcard)
       else
         exit
       endif
     elseif lastkey() == K_ENTER
       exit
     endif
   enddo
   aptBox()
   popScr()
   setcursor(SC_NORMAL)

 return if(cFileName == ".", "", cPath + cFileName)

 /*
              FUNCTION aptDirectory
    Purpose : Load file names into an array
    In      : cWcard - DOS Wildcard                       Default: "*.*"
    Returns : Array of files (same structure as Clipper DIRECTORY() func)
    Example : aFiles := aptDirectory("*.prn")
    Notes   : List of files that match the wildcard in the current directory.
            :
            : "." is replaced with "\".
            : Directories above the current directory are prefixed with
            : ".", those below with ".".  File names are not prefixed.
 */

 function aptDirectory(cWcard)

   local nStartAt := 1, aDir

   default cWcard to "*.*"

   aDir := directory(cWcard, "D")
   if (nLen := len(aDir)) > 0
     if aDir[1, F_NAME] == "."
       aDir[1] := {"\",0,"","","D"}
     endif
     aeval(aDir, {|x,i| aDir[i, F_NAME] := padr(lower(aDir[i, F_NAME]), 12) + ;
       if(aDir[i,F_ATTR] == "D", if(trim(aDir[i,F_NAME]) $ "\..", ".",".")," ")})
   endif

 return aDir

 /*
              FUNCTION selectFile
    Purpose : Pick a file from aptFiler() dialog
    In      : oD     - Tbrowse object
            : cWcard - DOS Wildcard
    Returns : oDIR   - Modified tbrowse object
    Notes   : Select file method.  Copies the currently highlighted file
            : name to a file-wide static and tells the tbrowse to quit.
 */

 static function selectFile(oD, cWcard)

   local nScan := 0

   cFileName := substr(eval(oD:getColumn(oD:colPos):block), 1, 12)
   nScan := ascan(aDir, {|x| cFileName == substr(x[F_NAME],1,12) .and.;
     "D" $ x[F_ATTR]})
   cFileName := rtrim(cFileName)
   if nScan <> 0
     if chdir(cFileName) == 0
       if cFileName == ".."
         cPath := substr(cPath, 1, rat("\", substr(cPath, 1, len(cPath) - 1)))
       elseif cFileName == "\"
         cPath := substr(cPath, 1, at("\", cPath))
       else
         cPath += upper(cFileName) + "\"
       endif
       @ oD:nTop-2, oD:nLeft-3 say padc(trimPath(cPath,35),35) color GROUPC
       aDir := aptDirectory(cWcard)
       oD:refreshAll()
       oD:goTop()
     endif
   else
     oD:cargo[TB_QUIT] := .t.
   endif

 return oD

 /*
              FUNCTION getWcard
    Purpose : Change wildcard specification
    In      : cSpec - Current wildcard
    Returns : cGet  - New specification
 */

 static function getWcard(cSpec)

   local nP := aptBox(30,1,,INPUTB,PICKC,,,.t.,.f.),;
         getlist := {}

   cSpec := padr(cSpec, 12)
   @ abs2r(nP), abs2c(nP) say "Enter wildcard" get cSpec picture "@!"
   setcursor(SC_NORMAL)
   readmodal(getlist)
   setcursor(SC_NONE)
   aptBox()

 return rtrim(cSpec)

 /*
              FUNCTION trimPath
    Purpose : Trims a DOS path, prepending "..." on overflow
    In      : cPath - DOS path to trim
            : nLen  - Length to trim it to
    Returns : Trimmed path
 */

 static function trimPath(cPath, nLen)

   nLen -= 3                // Make room for "..."
   if len(cPath) > nLen
     cPath := right(cPath, nLen)
     cPath := "...\" + substr(cPath, at("\", cPath) + 1)
   endif

 return cPath