home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l216 / 1.ddi / FILENAME.PRO < prev    next >
Encoding:
Prolog Source  |  1987-03-23  |  3.4 KB  |  110 lines
  1.  /***********************************************************************
  2.                                                                      
  3.     Turbo Prolog Toolbox
  4.     (C) Copyright 1987 Borland International.                        
  5.                                                                      
  6.         Read filename                           
  7.                                     
  8.     readfilename(ROW,COL,ATTR,EXTENSION,OLDFILENAME,NEWFILENAME)    
  9.  ***********************************************************************/
  10.  
  11. /* These declarations and inclusions are necessary to try filename 
  12.  
  13. DOMAINS
  14. include "tdoms.pro"
  15.  
  16. DATABASE
  17.   insmode
  18.   lineinpstate(STRING,COL)
  19.   lineinpflag
  20.  
  21. include "tpreds.pro"
  22. include "lineinp.pro"
  23. */
  24.  
  25. PREDICATES
  26.   readfilename(ROW,COL,ATTR,ATTR,STRING,STRING,STRING)
  27.   readfilename1(ROW,COL,ATTR,ATTR,STRING,STRING,STRING)
  28.   readfilename2(ROW,COL,ATTR,ATTR,STRING,STRING)
  29.   newext(STRING,STRING,STRING)
  30.   extentfilename(STRING,STRING,STRING)
  31.   splitfilename(STRING,STRING,STRING)
  32.   search_char(CHAR,STRING,INTEGER,INTEGER)
  33.   concatlist(STRINGLIST,STRING)
  34.  
  35. CLAUSES
  36.   readfilename(ROW,COL,WATTR,FATTR,EXT,OLD,FILENAME):-
  37.     concatlist(["File name (.",EXT,"): "],TXT),
  38.     lineinput_repeat(ROW,COL,40,WATTR,FATTR,TXT,OLD,NAME),
  39.     readfilename1(ROW,COL,WATTR,FATTR,EXT,NAME,FNAME),!,
  40.     removewindow,
  41.     extentfilename(FNAME,EXT,FILENAME).
  42.  
  43.   readfilename1(ROW,COL,WATTR,FATTR,EXT,"",FILENAME):-!,
  44.     ROW2=ROW+3,
  45.     readfilename2(ROW2,COL,WATTR,FATTR,EXT,FILENAME).
  46.   readfilename1(_,_,_,_,_,NAME,NAME).
  47.  
  48.   readfilename2(ROW,COL,WATTR,FATTR,EXT,FILENAME):-
  49.     adjustwindow(ROW,COL,10,50,ROW1,COL1),
  50.     makewindow(81,WATTR,FATTR,"",ROW1,COL1,10,50),
  51.     concat("*.",EXT,EXT1),
  52.     dir("",EXT1,FILENAME),!,
  53.     removewindow.
  54.   readfilename2(_,_,_,_,_,_):-removewindow,fail.
  55.  
  56. /* replace old extension with the new extension */
  57.   newext(OLD,EXT,NEW):-
  58.     splitfilename(OLD,NAME,_),
  59.     concatlist([NAME,".",EXT],NEW).
  60.  
  61.   extentfilename(OLDNAME,EXT,FILENAME):-
  62.     splitfilename(OLDNAME,NAME,OLDEXT), OLDEXT="",!,
  63.     concatlist([NAME,".",EXT],FILENAME).
  64.   extentfilename(NAME,_,NAME).
  65.  
  66. /* parse file name string for name and extension */
  67.   splitfilename(FILENAME,NAME,EXT):-
  68.     search_char('.',FILENAME,0,N),
  69.     frontstr(N,FILENAME,NAME,REST),
  70.     frontchar(REST,_,EXT),!.
  71.   splitfilename(NAME,NAME,"").
  72.  
  73.   search_char(CH,STR,N,N) :-frontchar(STR,CH,_),!.
  74.   search_char(CH,STR,N,N2) :-
  75.          frontchar(STR,_,STR1),
  76.          N1=N+1,
  77.          search_char(CH,STR1,N1,N2).
  78.  
  79.   concatlist([],"").
  80.   concatlist([H|T],S):-
  81.     concatlist(T,S1),
  82.     concat(H,S1,S).
  83.  
  84.  
  85.  /***********************************************************************/
  86.  /*        SET/CHANGE DIRECTORY                       */
  87.  /***********************************************************************/
  88.  
  89. PREDICATES
  90.   setdir(ROW,COL,ATTR,ATTR)/* Make a window and prompt the user with the current
  91.                               directory and set the new directory to the new value 
  92.                               if possable. */
  93.   newdisk(STRING)          /* change directory to DISK if it exists or return an error 
  94.                               message */
  95. CLAUSES
  96.   setdir(ROW,COL,WATTR,FATTR):-
  97.     disk(DISK),
  98.     lineinput_repeat(ROW,COL,45,WATTR,FATTR,"Directory: ",DISK,NEWDISK),
  99.     newdisk(NEWDISK),!,
  100.     removewindow.
  101.   setdir(_,_,_,_).
  102.  
  103.   newdisk(DISK):-disk(DISK),!.
  104.   newdisk(_):-    makewindow(1,7,7,"",10,30,4,45),
  105.         write(">> Error in directory name"),nl,
  106.         write("   - Press any key"),
  107.         readkey(_),
  108.         removewindow,
  109.         fail.
  110.