home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / PATHSET.SEQ < prev    next >
Encoding:
Text File  |  1989-07-03  |  1.8 KB  |  47 lines

  1. \ PATHSET.SEQ   Words used to set the path of a file.   by Tom Zimmer
  2.  
  3.    0 value flhndl            \ plugged later
  4.  
  5. : ?drive.extract ( handle --- drive-value )
  6.                 dup >nam 1+ c@ ':' =
  7.                 if      dup>r >nam c@ bl or 96 -
  8.                         r@ count 2- >r dup 2+ swap r> cmove
  9.                         r@ c@ 2- r@ c! r> count + off
  10.                 else    drop 0 25 bdos 1+ then    ;
  11.  
  12. : ?drive.prepend ( drive-value handle --- )
  13.                 over 0=
  14.                 if      2drop
  15.                 else    dup>r count >r dup 2+ r> cmove>
  16.                         64 + r@ >nam c! ':' r@ >nam 1+ c!
  17.                         r@ c@ 2+ r> c!
  18.                 then    ;
  19.  
  20. handle pathhndl
  21.  
  22. : prepend.path  ( handle --- f1 )
  23.                 pathhndl clr-hcb
  24.                 dup =: flhndl ?drive.extract >r
  25.                 flhndl >nam c@ '\' <> dup           \ leave if got path
  26.         if      drop
  27.                 '\' pathhndl 1+ c! 64 pathhndl c!
  28.                 pathhndl 2+ r@ pdos dup 0=
  29.                 if      drop
  30.                         pathhndl 1+ 64 0   \ determine path length
  31.                         do      dup i + c@ 0= if i pathhndl c! leave then
  32.                         loop    drop pathhndl c@ 1 >
  33.                         if      '\' pathhndl count + c!
  34.                                 pathhndl c@ 1+ pathhndl c!
  35.                         then    flhndl c@ pathhndl c@ + 62 > dup 0=
  36.                         if      drop
  37.                                 flhndl 1+ pathhndl c@ over + flhndl c@ cmove>
  38.                                 pathhndl count flhndl 1+ swap cmove
  39.                                 pathhndl c@ flhndl c@ + flhndl c!
  40.                                 false
  41.                         then
  42.                 then
  43.         then    r> flhndl ?drive.prepend 0 flhndl count + c! ;
  44.  
  45. ' PREPEND.PATH IS PATHSET
  46.  
  47.