home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / FORTHCAT < prev    next >
Encoding:
Text File  |  1992-11-27  |  3.6 KB  |  58 lines  |  [04] ASCII Text (0x0000)
  1. \ Forth Prodos catalog                                          
  2.                                                                 
  3. VARIABLE #FILES                                                 
  4. : PAD+ PAD 10 + ;  HEX                                          
  5. : .FILE  DUP 10 + C@ 0F = IF ." /" THEN  COUNT 0F AND TYPE ;    
  6. : ?DEL  C@ 0= ;                                                 
  7.                                                                 
  8. : READH PAD+ 27 READF  .FILE ; DEC                              
  9.                                                                 
  10. \    Forth disk catalog                                         
  11. HEX                                                             
  12. : ?TYPE  HEX 0 <# ASCII ] HOLD # #                              
  13.        ASCII $ HOLD  ASCII [ HOLD #> TYPE DEC ;                 
  14. : READN  PAD+ 4 READF  PAD+ [ 200 4 - ] LITERAL  READF ;        
  15. : FBASE  PAD+ I' 27 * + ;                                       
  16. : NFILES  PAD+ 21 + @  DUP #FILES ! CR  . ." files" CR CR ;     
  17. : MORE?  CR ." More? " KEY  DUP ASCII N =                       
  18.       SWAP ASCII n =  OR CR CR ;                                
  19. : ?STOP  #FILES @ 0<  ?DUP 0= IF  MORE?  THEN 0= ;              
  20. DEC                                                             
  21.                                                                 
  22. \    Forth Prodos Catalog                                       
  23. HEX : ?NAMES    \ list of file types... modifiable              
  24.      DUP   1 = IF DROP ." [bad]" ELSE                           
  25.      DUP   4 = IF DROP ." [txt]" ELSE                           
  26.      DUP   6 = IF DROP ." [bin]" ELSE                           
  27.      DUP  0F = IF DROP ." [dir]" ELSE                           
  28.      DUP  19 = IF DROP ." [adb]" ELSE   \ used by Appleworks:3  
  29.      DUP  1A = IF DROP ." [awp]" ELSE                           
  30.      DUP  1B = IF DROP ." [asp]" ELSE                           
  31.      DUP 0F4 = IF DROP ." [mac]" ELSE   \ used by Ascii Express 
  32.      DUP 0F8 = IF DROP ." [lnk]" ELSE   \ used by Merlin asm    
  33.      DUP 0FC = IF DROP ." [bas]" ELSE                           
  34.      DUP 0FD = IF DROP ." [var]" ELSE                           
  35.      DUP 0FE = IF DROP ." [rel]" ELSE   \ used by EDASM         
  36.      DUP 0FF = IF DROP ." [sys]" ELSE ?TYPE  [ DEC ]  THEN THEN 
  37.   THEN THEN THEN THEN THEN THEN THEN THEN THEN THEN THEN ;      
  38.  
  39. \    Forth Prodos Catalog                                       
  40. HEX                                                             
  41. : ?TYPEX  DUP C@ 0F0 AND  DUP E0 = IF                           
  42.          ." Subdirectory: /" DROP .FILE CR CR                   
  43.      ELSE F0 = IF                                               
  44.          ." Directory: /" .FILE CR CR                           
  45.      ELSE                                                       
  46.          DUP 10 + C@ ?NAMES  2 SPACES .FILE CR                  
  47.      THEN THEN ;  DEC                                           
  48.                                                                 
  49. \    Forth Prodos Catalog                                       
  50. HEX                                                             
  51. : 1BLK   0D 0 DO                                                
  52.       FBASE  ?DEL 0= IF                                         
  53.          FBASE  ?TYPEX                                          
  54.          -1 #FILES +!  #FILES @ 0< ?LEAVE                       
  55.       THEN LOOP ;                                               
  56. : DIR"  OPENF"  READN CR NFILES BEGIN                           
  57.       1BLK   ?STOP                                              
  58.     WHILE  READN  REPEAT  0 CLOSEF ;  DEC