/*      $VERS: 5.3 bbsExtDL.baud 22 Jul 1992 (22.7.92)
    copyright 1992 Richard Lee Stockton FREELY DISTRIBUTABLE

Allows BBBBS user to download from extra devices like CD drives.
 Keeps track of time left to this user, and watches for hangup.

   Just ignores file or directory names that contain spaces
    because BBBBS would be unable to download them anyway.
   Ignores icons (files that end in .info). Also excludes certain
    drawers on certain CDs that contain copyright files. Other
    specific files or directories can be excluded by adding
    their paths to the exclude variable below.
*/

/* Xetec Fish and More Vols I and II */
exclude='FISH_AND_MORE:C FISH_AND_MORE:SYSTEM FISH_AND_MOREII:C'

/* HyperMedia FredFish CD version 1.2 - limited to 3 drawers */
exclude=exclude 'FFCD_V1.2:LZH_FILES/CATALOGS'
exclude=exclude 'FFCD_V1.2:C FFCD_V1.2:DEVS'
exclude=exclude 'FFCD_V1.2:L FFCD_V1.2:LIBS'
exclude=exclude 'FFCD_V1.2:S FFCD_V1.2:FONTS'
exclude=exclude 'FFCD_V1.2:T FFCD_V1.2:PREFS'
exclude=exclude 'FFCD_V1.2:SYSTEM    FFCD_V1.2:SID'
exclude=exclude 'FFCD_V1.2:AQUARIUM  FFCD_V1.2:UTILITIES'
exclude=exclude 'FFCD_V1.2:CATALOGS  FFCD_V1.2:CDS.FILES'
exclude=exclude 'FFCD_V1.2:EXPANSION FFCD_V1.2:READMEMASTER'
exclude=exclude 'FFCD_V1.2:READ_ME   FFCD_V1.2:TRASHCAN'
exclude=exclude 'FFCD_V1.2:SHELL'
exclude=exclude 'FFCD_V1.2:CDTV.TM FFCD_V1.2:CD_SAMPLER'

/* HyperMedia FredFish Online CD version 1.4 - limited to 2 drawers */
exclude=exclude 'FFONL_V1.4:LZH_FILES/CATALOGS'
exclude=exclude 'FFONL_V1.4:C FFONL_V1.4:DEVS'
exclude=exclude 'FFONL_V1.4:L FFONL_V1.4:LIBS'
exclude=exclude 'FFONL_V1.4:S FFONL_V1.4:FONTS'
exclude=exclude 'FFONL_V1.4:T FFONL_V1.4:PREFS'
exclude=exclude 'FFONL_V1.4:SYSTEM    FFONL_V1.4:SID'
exclude=exclude 'FFONL_V1.4:AQUARIUM  FFONL_V1.4:UTILITIES'
exclude=exclude 'FFONL_V1.4:CATALOGS  FFONL_V1.4:CDS.FILES'
exclude=exclude 'FFONL_V1.4:EXPANSION FFONL_V1.4:READMEMASTER'
exclude=exclude 'FFONL_V1.4:READ_ME   FFONL_V1.4:TRASHCAN'
exclude=exclude 'FFONL_V1.4:SHELL     FFONL_V1.4:TOOLS'
exclude=exclude 'FFONL_V1.4:CDTV.TM   FFONL_V1.4:NODE.RINFO'
exclude=exclude 'FFONL_V1.4:PARNET    FFONL_V1.4:START_PARNET'
exclude=exclude 'FFONL_V1.4:COPYRITE.TXT'


SIGNAL ON BREAK_C
SIGNAL ON BREAK_E

PARSE ARG name level maxtime linesperpage colorflag devlist 

lists.=''
lists.0=0
maxtime=maxtime-30
CALL TIME('R')
CR='0D'x
def=''
pen3=''
IF colorflag~=1 THEN
  DO
    def=''
    pen3=''
  END

SAY CR
SAY 'This routine lets you select a list of files to be downloaded'CR
SAY 'from one or more extra devices.  For example, CD-ROM drives.'CR
SAY CR
SAY 'Note that it is more efficient for all concerned if you use the'CR
SAY 'various contents files available here (or Aquarium, in the case'CR
SAY 'of Fish Disks), to make your selections before you call. Thanks!'CR
SAY CR

selected=''
path=''
templist=devlist
devlist=''
longest=0
CALL PRAGMA('W','N')  /* disk requesters OFF */
DO i=1 TO WORDS(templist)
  test=WORD(templist,i)
  IF ~EXISTS(test) THEN ITERATE i
  CALL PRAGMA('D',test)
  test2=PRAGMA('D')
  IF WORDS(test2)>1 THEN test2=test
  devlist=STRIP(devlist test2)
  IF LENGTH(test2)>longest THEN longest=LENGTH(test2)
END
cols=76%(longest+8)
IF devlist='' THEN
  DO
    SAY CR
    SAY '*** Sorry, no External Devices are available! ***'CR
    SAY CR
    EXIT('')
  END

picklist=devlist
IF WORDS(picklist)=1 THEN
  DO
    path=picklist
    IF RIGHT(path,1)~=':' THEN path=path'/'
    picklist=makepicklist()
  END
ELSE
  DO
    lists.0=1
    dirs=WORDS(devlist)
  END
CALL checkdcd()

OPTIONS PROMPT 'Press RETURN'
PULL junk

DO loop=1
  CALL checkdcd()
  test=TIME('E')
  IF test>(maxtime-100) THEN
    DO
      SAY CR
      IF test>maxtime THEN
        DO
          SAY '*** This session''s time is expiring! ***'CR
          SAY CR
          LEAVE loop
        END
      ELSE SAY '*** Less than 2 minutes remaining! ***'CR
      SAY CR
    END
  filename=pick(picklist)
  IF filename='' THEN
    DO
      temp=path
      IF RIGHT(temp,1)='/' THEN temp=LEFT(temp,LENGTH(temp)-1)
      IF FIND(UPPER(devlist),UPPER(temp))>0 THEN
        DO
          IF WORDS(devlist)=1 THEN ITERATE loop
          picklist=devlist
          path=''
          ITERATE loop
        END
      ELSE
        DO
          test=RIGHT(path,1)
          IF test='/' THEN path=LEFT(path,LENGTH(path)-1)
          slash=LASTPOS('/',path)
          IF slash=0 THEN slash=LASTPOS(':',path)
          path=LEFT(path,slash)
        END
    END
  IF WORD(STATEF(path||filename),1)='FILE' THEN
    DO
      IF FIND(UPPER(selected),UPPER(path||filename))=0 THEN
        selected=selected path||filename
      ELSE selected=DELWORD(selected,FIND(UPPER(selected),UPPER(path||filename)),1)
      ITERATE loop
    END
  ELSE IF WORD(STATEF(path||filename),1)='DIR' THEN
    DO
      path=path||filename
      test=RIGHT(path,1)
      IF test~='' & test~='/' & test~=':' THEN path=path'/'
    END
  ELSE IF UPPER(filename)='DONE' THEN LEAVE loop
  IF path~='' THEN picklist=makepicklist()
END
SAY 'Returning to the BBS...'CR
SAY CR
EXIT(STRIP(selected))


checkdcd:
IF ADDRESS()='BAUD' THEN
  DO
    dcd
    IF RC=0 THEN
      DO
        CALL DELAY(128)
        dcd
        IF RC=0 THEN
          DO
            SAY CR
            SAY '*** Lost Carrier!?! ***'CR
            EXIT('')
          END
      END
  END
RETURN


makepicklist:
IF STORAGE()<100000 THEN
  DO
    lists.=''
    lists.0=0
    IF WORDS(devlist)>1 THEN
      DO
        lists.0=1
        lists.1.0=devlist
      END
  END
DO i=1 TO lists.0
  IF path=lists.i THEN RETURN(lists.i.0)
END
IF path='' THEN RETURN('')
SAY 'Loading...'CR
CALL FileList(path'*',filelist,'F','N')
IF filelist.0>1 THEN CALL QSORT(1,filelist.0,filelist)
CALL FileList(path'*',dirlist,'D','N')
IF dirlist.0>1 THEN CALL QSORT(1,dirlist.0,dirlist)
plist=''
dirs=0
longest=0
DO i=1 TO filelist.0
  IF WORDS(filelist.i)~=1 THEN ITERATE i
  IF filelist.i='' THEN ITERATE i
  IF UPPER(RIGHT(filelist.i,5))='.INFO' THEN ITERATE i
  IF FIND(exclude,UPPER(path||filelist.i))>0 THEN ITERATE i
  plist=STRIP(plist filelist.i)
  IF LENGTH(filelist.i)>longest THEN longest=LENGTH(filelist.i)
END
DO i=1 TO dirlist.0
  IF WORDS(dirlist.i)~=1 THEN ITERATE i
  IF UPPER(RIGHT(dirlist.i,5))='.INFO' THEN ITERATE i
  IF FIND(exclude,UPPER(path||dirlist.i))>0 THEN ITERATE i
  plist=STRIP(plist dirlist.i)
  IF LENGTH(dirlist.i)>longest THEN longest=LENGTH(dirlist.i)
  dirs=dirs+1
END
cols=76%(longest+9)
lists.0=lists.0+1
i=lists.0
lists.i=path
lists.i.0=plist
DROP filelist. dirlist. 
RETURN(plist)


pick:
PARSE ARG list 
selection=''
DO k=1 TO lists.0
  IF path=lists.k THEN LEAVE k
END
IF ~DATATYPE(lists.k.ROWS,'N') THEN
  DO
    items=WORDS(list)
    IF items<75 & dirs<15 THEN SAY 'Formatting' items 'items...'CR
    ELSE SAY 'Please be patient, formatting' items 'items may take a while...'CR
    lists.k.ROWS=(items%cols)+((items//cols)>0)
    IF cols>items THEN cols=items
    IF cols<1 THEN cols=1
    longest=(76%cols)-8
    lists.k=path
    DO j=0 TO cols-1
      DO i=1 TO lists.k.ROWS
        thisnum=j*lists.k.ROWS+i
        IF thisnum<=items THEN
          DO
            thisitem=WORD(list,thisnum)
            filestat=STATEF(path||thisitem)
            thisitem=LEFT(thisitem,longest)' '
            IF WORD(filestat,1)='DIR' THEN
              lists.k.i=lists.k.i||pen3'(dir) 'thisitem||def
            ELSE
              DO
                bytes=WORD(filestat,2)
                IF bytes<10000 THEN 
                  lists.k.i=lists.k.i||RIGHT(bytes,5) thisitem
                ELSE IF bytes>1023999 THEN 
                  lists.k.i=lists.k.i||RIGHT(bytes%1024000,4)'m' thisitem
                ELSE lists.k.i=lists.k.i||RIGHT(bytes%1024,4)'k' thisitem
              END
          END
      END
    END
  END
IF selected~='' THEN
  DO
    SAY CR
    SAY pen3'selected:'def||CR
    DO i=1 TO WORDS(selected)
      SAY WORD(selected,i)||CR
    END
  END
SAY CR
SAY 'current path ='pen3 path||def||CR
SAY LEFT('-',75,'-')||CR
OPTIONS PROMPT ' - ['pen3'N'def']on-stop  ['pen3'Q'def']uit  ['pen3'RETURN'def']=Continue - '
DO i=1 TO lists.k.ROWS
  SAY TRIM(lists.k.i)||CR
  IF (i+2)//(linesperpage-1)=0 & nonstop~=1 THEN
    DO
      CALL whodat()
      PULL junk
      IF LEFT(UPPER(junk),1)='Q' THEN LEAVE i
      IF LEFT(UPPER(junk),1)='N' THEN nonstop=1
      IF colorflag=1 THEN SAY '1B'x'M'||LEFT('',60)||'1B'x'M'||CR
    END
END
nonstop=0
SAY LEFT('-',75,'-')||CR
CALL whodat()
readflag=0
DO getloop=1
  pstring=showtime()'   Enter ''?'' for HELP > '
  OPTIONS PROMPT pstring
  PARSE PULL selection 
  IF selection='?' THEN
    DO
      CALL help()
      OPTIONS PROMPT 'Press RETURN'
      PULL junk
      selection=';-)'
      LEAVE getloop
    END
  IF WORDS(selection)>1 & UPPER(WORD(selection,1))='READ' THEN
    DO
      readflag=1
      selection=STRIP(DELWORD(selection,1,1))
    END
  i=FIND('DONE' UPPER(list),UPPER(selection))
  IF i=0 THEN ITERATE getloop
  IF selection='' & path='' THEN ITERATE getloop
  ELSE IF i>1 THEN selection=WORD(list,i-1)
  IF readflag=1 THEN
    DO
      endtest=UPPER(RIGHT(selection,4))
      IF FIND('.ARC .DMS .LZH .LHA .ZIP .ZOO',endtest)>0 THEN
        DO
          CALL Contents.rexx(path||selection)
          IF EXISTS('RAM:CONTENTS') THEN CALL showtext('RAM: CONTENTS')
        END
      ELSE CALL showtext(path selection)
      readflag=0
      selection=';-)'
    END
  LEAVE getloop
END
RETURN(selection)


showtext:
PARSE ARG tpath' 'textfile 
test=RIGHT(tpath,1)
IF test~='' & test~=':' & test~='/' THEN tpath=tpath'/'
x=OPEN(f,STRIP(tpath||textfile),'R')
IF x=0 THEN RETURN
test=READCH(f,64)
mask=XRANGE(,'06'x)||XRANGE('0E'x,'1A'x)||XRANGE('1C'x,'1F'x)
IF VERIFY(test,mask,'M')>0 THEN
  DO
    CALL CLOSE(f)
    testloc=VERIFY(test,mask,'M')
    SAY '*** not an archive or a text file! ***'CR
    SAY 'Character number' testloc 'is ASCII' C2D(SUBSTR(test,testloc,1))||CR
    RETURN
  END
CALL SEEK(f,0,'B')
OPTIONS PROMPT ' - ['pen3'N'def']on-stop  ['pen3'Q'def']uit  ['pen3'RETURN'def']=Continue - '
SAY CR
SAY '-' tpath||textfile '-'CR
DO i=1 WHILE ~EOF(f)
  SAY COMPRESS(READLN(f),CR||'0C'x)||CR
  IF i//(linesperpage-1)=0 & nonstop~=1 THEN
    DO
      CALL whodat()
      PULL junk
      IF LEFT(UPPER(junk),1)='Q' THEN LEAVE i
      IF LEFT(UPPER(junk),1)='N' THEN nonstop=1
      IF colorflag=1 THEN SAY '1B'x'M'||LEFT('',60)||'1B'x'M'||CR
    END
END
CALL CLOSE(f)
IF i//(linesperpage-1)>1 THEN PULL junk
nonstop=0
RETURN


whodat:
IF ADDRESS()~='BAUD' THEN RETURN
MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
CALL checkdcd()
RETURN


help:
SAY CR
SAY CR
SAY pen3'- HELP -'def
SAY CR
SAY 'You can navigate through directory levels using the following commands.'CR
SAY 'Remember that the name must appear in the display before you can select it.'CR
SAY CR
SAY 'To select an item from the displayed list, enter its name as displayed.'CR
SAY 'If the selected item is a' pen3'directory'def', its contents will be displayed.'CR
SAY 'If the selected item is a file, it is added to the ''selected'' list.'CR
SAY 'To remove a selected file from the list, enter its name again.'CR
SAY CR
SAY 'To display the parent directory, enter an ''empty'' RETURN'CR
SAY 'To read a textfile or see the contents of an archive, enter READ filename.'CR
SAY CR
SAY 'Enter'pen3 'DONE' def'to return to the BBS (and download any selected files)'CR
SAY CR
RETURN


showtime:
mins=(maxtime-TIME('E'))%60
secs=TRUNC((maxtime-TIME('E'))//60)
IF secs<10 THEN secs='0'secs
RETURN('Time Remaining: 'mins':'secs)


BREAK_E:
SAY pen3'*** CONTROL-E BREAK ***'def||CR
i=999999
RETURN


BREAK_C:
SAY CR
EXIT('')


/* bbsExtDL.baud */