home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 3 / CDPDIII.bin / pd / programming / amos / ldos_demo / examples / ldos / lrecursive.amos / lrecursive.amosSourceCode
Encoding:
AMOS Source Code  |  1992-03-22  |  3.4 KB  |  93 lines
  1. Set Buffer 200
  2. _MAX=1500
  3. Dim NAME$(_MAX) : Rem Enough for  500 names
  4. 'Follow F$,A$,ST 
  5. Screen Open 1,640,256,2,Hires : Paper 0 : Clw 
  6. Palette ,$FF
  7. Global ST,NUM,NAME$()
  8. Reserve As Work 10,264*20 : Rem Enough for 20 lcat pushes
  9. ST=Start(10)-264
  10. Input "Dir :";ROOT$
  11. Proc RECURSIVE[ROOT$]
  12. Print : Print "Sorting..."
  13. Sort NAME$(0)
  14. Dec NUM
  15. LO=_MAX-NUM
  16. Clw 
  17. For I=LO To LO+NUM
  18.    Print NAME$(I); : Locate 50,
  19.    Proc IDENT[NAME$(I)]
  20.    Inc LINE
  21.    If LINE mod 20=0 Then Wait Key 
  22. Next I
  23. End 
  24. Procedure RECURSIVE[F$]
  25.    D$=Right$(F$,1)
  26.    If Not((D$=":") or(D$="/")) Then F$=F$+"/"
  27.    A$= Extension_10_00FC(F$)
  28.    Cline : Centre "Scanning: "+F$ : Print : Cup 
  29.    NAME$(NUM)=F$ : Inc NUM
  30.    Do 
  31.       A$= Extension_10_010E 
  32.       Exit If A$=""
  33.       If Extension_10_011E >0
  34.          D$=Right$(F$,1)
  35.          ST=ST+264
  36.           Extension_10_047E ST
  37.          Proc RECURSIVE[F$+A$]
  38.           Extension_10_048E ST
  39.          ST=ST-264
  40.       End If 
  41.       If Extension_10_011E <0
  42.          NAME$(NUM)=F$+A$ : Inc NUM
  43.       End If 
  44.    Loop 
  45. End Proc
  46. Procedure IDENT[S$]
  47.    ' Doesn't handle national chars in ASCII-files...
  48.    ' Currently no real support for keymaps in AMOS
  49.    LAN= Extension_10_0182(S$)
  50.    LON=30 : _A=-1 : If LAN<LON Then Print "Length < 30 bytes" : Pop Proc
  51.    Open In 1,D$+S$ : A$=Input$(1,LON) : Close 1 : T=Leek(Varptr(A$))
  52.    T$=Left$(A$,4)
  53.    If Instr(A$,"AMOS Basic V")<>0 Then Print "AMOS SOURCE CODE FILE" : Pop Proc
  54.    If Left$(A$,3)="ZOO" Then Print "ZOO ARCHIVE FILE" : Pop Proc
  55.    For I=1 To Len(A$) : A=Asc(Mid$(A$,I,1))
  56.       If(A<20) or(A>126)
  57.          If Not(A=9 or A=10 or A=13)
  58.             _A=0
  59.          End If 
  60.       End If 
  61.    Next I
  62.    If _A Then Print "ASCII FILE" : Pop Proc
  63.    If T=$E3100001 Then Print "ICON FILE" : Pop Proc
  64.    If T=$3F3 Then Print "EXE FILE" : Pop Proc
  65.    If T=$3E7 Then Print "LINKER OBJECT FILE" : Pop Proc
  66.    If T=$464F524D Then Print "IFF FILE - ";Mid$(A$,9,4) : Pop Proc
  67.    If T=$F34C0012 Then Print "'.info' FILE" : Pop Proc
  68.    If T=$400002 Then Print "WB2.0 PATTERN FILE" : Pop Proc
  69.    If(T and $FFFFFFF8)=$F000000 Then Print "FONT FILE " : Pop Proc
  70.    If Mid$(A$,3,3)="-lh"
  71.       Print "LHARC ARCHIVE FILE (";Mid$(A$,4,3);")"
  72.       Pop Proc
  73.    End If 
  74.    If T=$504B0304 Then Print "ZIP ARCHIVE FILE" : Pop Proc
  75.    If T=$12031990 Then Print "AMOS PACKED IFF PIC" : Pop Proc
  76.    If T$="AmSp" Then Print "AMOS .ABK FILE SPRITE" : Pop Proc
  77.    If T$="AmIc" Then Print "AMOS .ABK FILE ICON" : Pop Proc
  78.    If T$="AmBk" Then Print "AMOS .ABK FILE ";Mid$(A$,13,8) : Pop Proc
  79.    If T=$8080C00A Then Print "WORD PERFECT .DOC FILE" : Pop Proc
  80.    If T$="PP20" Then Print "PowerPacked DATA FILE" : Pop Proc
  81.    If(T and $FFFF0000)=$23690000 Then Print "Vector font (PPM?)" : Pop Proc
  82.    If(T and $FF)=$40 Then Print "SuperBase .SBF file" : Pop Proc
  83.    If T=$46454446 Then Print "SuperBase .SBV file" : Pop Proc
  84.    If(T and $FFFFFF00)=$53425000 Then Print "SuperBase .SBP file" : Pop Proc
  85.    If(T=0) and(LAN mod 512=0) Then Print "Possible SuperBase data file" : Pop Proc
  86.    If T=$46433134 or T=$534D4F44 Then Print "Future Composer MODULE" : Pop Proc
  87.    If T$="SYNT" Then Print "Possible SYNTHsound instrument (FC1.4)" : Pop Proc
  88.    If(T$="MMD0") or(T=$4D454404) Then Print "MED MODULE" : Pop Proc
  89.    If T=$1000000 Then Print "ADPro C.file" : Pop Proc
  90.    If(T=$440001) or(T=$80001001) Then Print "CG-font file" : Pop Proc
  91.    If T=$C000000 Then Print "NComm cfg-file" : Pop Proc
  92.    Print "UNKNOWN (header=";Hex$(T);")"
  93. End Proc