1. File Search & Select PGM
- Posted by MR FREDERICK A COLE <facole at PRODIGY.COM> Sep 26, 1996
- 2040 views
- Last edited Sep 27, 1996
Welcome Euphoria Users, I have written an "include file" routine to make it easier to find and select a file which then returns the file name and path to the program. One example where I find it very useful is the Euphoria Editor, ed.ex, program,; no longer do you have to remember the file name and type it in, but you can search on all drives and subdirectories for the desired file and then click on the mouse left button to select the file and return it to the editor. It runs in the graphics text Mode 3 with 25 lines of text. To check out the program to see how it works on your system you can type in this short program: include filescrh.e -- Name of the include file routine sequence fs fs = file_select() puts(1,fs) -- prints to screen the path and file name selected If the above four line program works fine on your computer, you may want to incorporate this feature in the Euphoria Editor or your own program. To modify the Euphoria Editor to use this feature only a few things need to be changed. First, it would be wise to make a backup copy of the editor before you make any changes. Start the Editor and load in ed.ex. At the beginning of the ed.ex program add the one new line as shown below: without type_check -- makes it a bit faster include graphics.e include get.e include file.e include filescrh.e --new line To find the next section of the program to change use the find feature of the editor. Press the "Esc" key, then f, then type in the words, file name:, and press the enter key twice. It will take you to the section listed below. Add the three (3) new lines. elsif command[1] = 'n' then if modified and last_use() then set_top_line("") printf(SCREEN, "save changes to %s? ", {file_name}) if find('y', key_gets("yn")) then save_file(file_name) end if end if save_state() temp_name = lower(file_select()) -- new line if length(temp_name) = 0 then -- new line set_top_line("new file name: ") temp_name = delete_trailing_white(key_gets("")) end if -- new line if length(temp_name) != 0 then file_name = temp_name stop = TRUE end if The next section is also found with the find feature. Press the "Esc" key, then f, then press the Enter key. (find defaults to, file name:) It will take you to the section listed below. Add the three (3) new lines. if length(file_name) = 0 then -- we still don't know the file name - so ask user file_name = lower(file_select()) --new line if length(file_name) = 0 then --new line puts(SCREEN, "file name: ") cursor(ED_CURSOR) file_name = key_gets("") puts(SCREEN, '\n') end if --new line end if That is all the changes necessary for the Euphoria Editor. If you want to start a new file name; one that doesn't yet exist in the directories, you can do so by clicking on EXIT and then typing in the name, exactly like it is now done. I am providing this include file program to the Euphoria Public Domain. This program is supplied "AS IS" and without warranty. The program works fine for me but it has been tested on only a few computer systems, so if there are occasions that this program does not work properly or when used in your application, feel free to modify to suit your needs. Enjoy!! Fred Cole (facole at prodigy.com) The include file "filescrh.e" follows: ------------------------------------------ --- File Search & Select --- --- Ver 1.0 --- --- Written by: Fred Cole --- --- facole at prodigy.com --- --- Free to Euphoria Public Domain --- --- Provided "AS IS" and --- --- Without Warranty --- --- Permission given to modify --- ------------------------------------------ -- Search sub-directories and drives using a mouse to search for a file. -- When the desired file is found and the mouse pointer is moved to that line, -- the mouse left button is clicked to return the directory path and file name -- of the selected file. Use in Graphics Mode (3) with 25 lines text. include file.e include get.e include graphics.e include image.e include machine.e include mouse.e include sort.e function mouse() object y mouse_events(LEFT_DOWN) mouse_pointer(1) while 1 do y = get_mouse() if atom(y) then else exit end if end while mouse_pointer(0) return y end function procedure first_line(sequence b) text_color(6) position(1,10) puts(1,"Directory Path is:") position(1,30) text_color(9) puts(1,b) position(2,1) end procedure function file_path(sequence b) object x,y,p integer a,c sequence x1,x2 x = dir(b) p = 0 if not atom(x) and length(b)>3 then for t=1 to length(x) by 1 do if find("..",x[t]) = 0 then else p = 1 exit end if end for if p=0 then p = {{46,46},{100},0,0,0,0,0,0,0} x = prepend(x,p) end if elsif atom(x) and length(b)>3 then x = {{{46,46},{100},0,0,0,0,0,0,0}} elsif atom(x) then clear_screen() while atom(x) do first_line(b) position(3,12) text_color(15) puts(1,"NO FILES FOUND") text_color(3) position(25,37) puts(1,"<CHANGE DRIVE>") text_color(4) puts(1," <EXIT>") y = mouse() if y[3]/8 = 24 and y[2] < 288 or y[2] > 392 and y[2]<472 or y[2]>512 then elsif y[3]/8 = 24 and y[2] <= 392 and y[2] >= 288 then return("CHANGE DRIVE") elsif y[3]/8 = 24 and y[2] <= 512 and y[2] >= 472 then return("EXIT") end if end while end if x = sort(x) a = 0 x1 = {} x2 = {} while a < length(x) do a = a+1 if compare(x[a][2],"d") = 0 then x1 = append(x1,x[a]) else x2 = append(x2,x[a]) end if end while clear_screen() first_line(b) a = 0 c = 0 x = x1 & x2 while a < length(x) do a = a+1 if compare(x[a][2],"d") = 0 then text_color(14) else text_color(15) end if printf(1,"%12s",{x[a][1]}) printf(1," %4s",{x[a][2]}) printf(1," %7d",x[a][3]) printf(1," %02d",x[a][5]) printf(1,"/%02d",x[a][6]) printf(1,"/%04d",x[a][4]) printf(1," %02d",x[a][7]) printf(1,":%02d",x[a][8]) printf(1,":%02d\n",x[a][9]) c = c+1 if a > 23 and a = length(x) then position(25,21) text_color(10) puts(1,"<RETURN>") text_color(3) position(25,37) puts(1,"<CHANGE DRIVE>") text_color(4) puts(1," <EXIT>") y = mouse() if y[3]/8 > c and y[3]/8 < 24 or y[3] = 0 or (y[3]/8 = 24 and y[2] < 160 or y[2] > 216 and y[2] < 288 or y[2] > 392 and y[2]<472 or y[2]>512) then first_line(b) a = a - c c = 0 elsif y[3]/8 = 24 and y[2] <= 216 and y[2] >= 160 then clear_screen() first_line(b) a = 0 c = 0 elsif y[3]/8 = 24 and y[2] <= 392 and y[2] >= 288 then return("CHANGE DRIVE") elsif y[3]/8 = 24 and y[2] <= 512 and y[2] >= 472 then return("EXIT") elsif (y[3]/8)-c <= 0 and y[3] != 0 then return (x[y[3]/8+a-c]) end if elsif a <= 23 and a = length(x) then text_color(3) position(25,37) puts(1,"<CHANGE DRIVE>") text_color(4) puts(1," <EXIT>") y = mouse() if (y[3]/8)-c <= 0 and y[3] != 0 then return (x[y[3]/8+a-c]) elsif y[3]/8 > c and y[3]/8 < 24 or y[3] = 0 or (y[3]/8 = 24 and y[2] < 288 or y[2] > 392 and y[2]<472 or y[2]>512) then first_line(b) a = 0 c = 0 elsif y[3]/8 = 24 and y[2] <= 392 and y[2] >= 288 then return("CHANGE DRIVE") elsif y[3]/8 = 24 and y[2] <= 512 and y[2] >= 472 then return("EXIT") end if elsif c = 23 and a != length(x) then position(25,22) text_color(10) puts(1,"<MORE>") text_color(3) position(25,37) puts(1,"<CHANGE DRIVE>") text_color(4) puts(1," <EXIT>") y = mouse() if y[3]=8*24 and y[2]<=208 and y[2]>=168 then clear_screen() first_line(b) c = 0 elsif y[3] != 0 and y[3] != 8*24 then return (x[y[3]/8+a-c]) elsif y[3] = 0 or (y[3]=8*24 and y[2]<168 or y[2]>208 and y[2]<288 or y[2]>392 and y[2]<472 or y[2]>512) then first_line(b) c = 0 a = a - 23 elsif y[3]/8 = 24 and y[2] <= 392 and y[2] >= 288 then return("CHANGE DRIVE") elsif y[3]/8 = 24 and y[2] <= 512 and y[2] >= 472 then return("EXIT") end if end if end while end function function select_drive() sequence rv -- list of register values object b, bl, br, cntr, drives, xy bk_color(0) clear_screen() drives = {} for h=1 to 26 by 1 do rv = repeat(0, 10) -- zero register rv[REG_AX] = #4409 -- Function: Check if Block Device is Remote rv[REG_BX] = 0000 + h -- Drive Number rv = dos_interrupt(#21, rv) -- Call DOS interrupt #21 if rv[5] != 0 then drives = drives & 64+h & " " end if end for position(2,34) text_color(10) puts(1,"Select Drive\n\n") text_color(15) cntr = 40 - floor((length(drives))/2) -- Center available Drive Choices puts(1,repeat(32,cntr) & drives) br = 24*((length(drives))/3-1)+8*cntr bl = 8*cntr text_color(4) position(25,60) puts(1,"<EXIT>") position(5,1) mouse_events(LEFT_DOWN) while 1 do xy = mouse() if xy[2]<bl or xy[2]>br or xy[3]<24 or xy[3]>24 then if xy[3]/8 = 24 and xy[2] <= 512 and xy[2] >= 472 then return("EXIT") end if elsif remainder((xy[2]-bl),24)=0 then b = drives[((xy[2]-bl)/8)+1] return (b) end if end while end function procedure closing() cursor(UNDERLINE_CURSOR) text_color(15) set_active_page(0) set_display_page(0) end procedure global function file_select() sequence t object b integer i set_active_page(1) set_display_page(1) text_color(4) cursor(NO_CURSOR) t = "CHANGE DRIVE" while compare(t,"CHANGE DRIVE") = 0 do b = select_drive() if compare(b,"EXIT") = 0 then closing() return({}) end if b = b & ":\\" t = file_path(b) if compare(t,"EXIT") = 0 then closing() return({}) end if while compare(t[2],"d") = 0 do if compare(t[1],"..") = 0 then i = length(b)-1 while compare(b[i],92) != 0 do i = i-1 end while b = b[1..i] elsif compare(t[1],".") = 0 then else b = b & t[1] & "\\" end if if length(b) > 3 then t = file_path(b[1..length(b)-1]) else t = file_path(b) end if if compare(t,"EXIT") = 0 then closing() return({}) end if end while end while closing() return (b & t[1]) end function
2. Re: File Search & Select PGM
- Posted by Jacques Deschjnes <desja at QUEBECTEL.COM> Sep 26, 1996
- 2007 views
- Last edited Sep 27, 1996
Mr. Fred Cole proposed his version of a file select function, Here is my own version. Specifications: -> full navigation this version doesn't use mouse but have full navigation with cursor key, PageUp, PageDown, Home and End keys. -> ESC key can be used to cancel the operation, in which case and empty sequence is returned to caller. -> The file list adapt itself to current screen metrics. -> Directory names are displayed in black, file names in white and the selected one is on green background. -> screen state saved and restored How to use it: include filelist.e in your program srceen is organised in 3 regions: first line is filter and number of files in current list. second line is selected file info (name, size, date, etc) rest of screen is the list The function to call is ChooseFile(filter) the parameter filter is a path or wildcard filter. you can change the filter or drive while viewing the list with the f command. example: include FileList.e sequence FileName FileName = ChooseFile("c:\\euphoria\*.ex") puts(1,name) Consider it public domain. I would appreciated report on bugs and to receive your improve version of it. ************************************************************************ -- FileList: display le list of file for user to pick one and return the -- selected file. -- Creation date: august 26th, 1996 -- By: Jacques Deschenes, Baie-comeau, P.Q. Canada -- e-mail: desja at quebectel.com -- -- caller pass a wildcard path to use as a filter without warning without type_check -- with trace include graphics.e include wildcard.e include machine.e include get.e include image.e include file.e -- Keys constant constant ESC = 27, ENTER = 13, HOME = 327, END = 335, UP = 328, DOWN = 336, LEFT =331, RIGHT =333, PG_UP = 329, PG_DOWN = 337 sequence list,path,filter list = {} path = current_dir() & '\\' -- default path filter = "*.*" -- default filter -- display metrics integer ListLines, -- number of lines to display list ListCol, -- number of columns to display the list PerLine -- number of file name displayed per line constant NAME_FIELD= 14 -- width of name field -- math functions function Min(integer a, integer b) if a < b then return a else return b end if end function -- Min function Max(integer a, integer b) if a > b then return a else return b end if end function -- Max function ToUpper(integer c) -- convert c to upper case if c >= 'a' and c <= 'z' then return c - 'a' + 'A' else return c end if end function -- ToUpper() function f_split(sequence path) -- split path to drive, directory, name and extension -- return sequence {drive,dir,name,ext} sequence slice,drive,dir,name,ext atom c slice = {} drive = {} dir = {} name = {} ext = {} for i =1 to length(path) by 1 do c = ToUpper(path[i]) slice = slice & c if c = ':' then drive = slice slice = {} elsif c = '\\' then dir = dir & slice slice = {} elsif c = '.' then name = slice[1..length(slice)-1] slice = {} end if end for if length(name) = 0 then name = slice else ext = slice end if if length(ext)=0 and not match("*",name) and not match("?",name) then dir = dir & name name = "*" ext = "*" end if if length(dir) then if dir[length(dir)] != '\\' then dir = dir & '\\' end if end if return {drive,dir,name,ext} end function -- f_split() function ParentDir(sequence path) -- return the parent directory sequence parent integer i if path[length(path)] = '\\' then path = path[1..length(path)-1] end if i = length(path) while i > 0 do if path[i] = '\\' or path[i] = ':' then exit end if i = i-1 end while if i = 0 then return {} end if parent = path[1..i] if parent[length(parent)] != '\\' then parent = parent & '\\' end if return parent end function -- ParentDir() function CreateList(sequence filter) -- create the list of files to display. object FileList FileList = dir(filter) if atom(FileList) then return {} end if if length(FileList[1][D_NAME]) = 1 and match(".",FileList[1][D_NAME]) then FileList = FileList[2..length(FileList)] end if return FileList end function -- CreateList function Left(sequence Str, integer width) -- left justify a string in a specified field width. Str = Str & repeat(32,width) return Str[1..width] end function -- Left() procedure WriteFileInfo(integer index) -- write file info line on second line of screen position(2,1) bk_color(BLUE) text_color(WHITE) if index=0 then puts(1,"No files\n") else printf(1,"%14s %5s %8d %4d/%2.2d/%2.2d %2.2d:%2.2d:%2.2d\n", list[index]) end if end procedure --WriteFileInfo() sequence padding padding = repeat(32,NAME_FIELD) procedure WriteFileName(integer i) -- write file name to screen -- directory are displayed in black, files in white sequence name if match("d",list[i][D_ATTRIBUTES]) then text_color(BLACK) else text_color(WHITE) end if name = list[i][D_NAME] & padding puts(1,name[1..NAME_FIELD]) end procedure -- WriteFileName() integer PrevFirst, PrevIndex PrevFirst = 0 PrevIndex = 0 procedure DisplayList(integer index) -- Display the list HiLight the selected one sequence pos integer first,last if index = PrevIndex then return end if first = 1 if index > ListLines*PerLine then first = floor(index/PerLine-ListLines+1)*PerLine+1 end if if first = PrevFirst then position(3+floor((PrevIndex-first)/PerLine), NAME_FIELD*remainder(PrevIndex-first,PerLine)+1) bk_color(BROWN) WriteFileName(PrevIndex) position(3+floor((index-first)/PerLine), NAME_FIELD*remainder(index-first,PerLine)+1) bk_color(GREEN) WriteFileName(index) WriteFileInfo(index) PrevIndex = index return end if bk_color(BROWN) clear_screen() text_color(WHITE) bk_color(BLUE) puts(1,repeat(32,2*ListCol)) position(1,1) printf(1,"%s files: %d\n",{Left(path&filter,60),length(list)}) WriteFileInfo(index) last = Min(first+ListLines*PerLine-1,length(list)) bk_color(BROWN) for i = first to last by 1 do WriteFileName(i) if remainder(i,PerLine)=0 then pos = get_position() if pos[1] < ListLines + 2 then puts(1,"\n") end if end if end for position(3+floor((index-first)/PerLine), NAME_FIELD*remainder(index-first,PerLine)+1) bk_color(GREEN) WriteFileName(index) PrevFirst = first PrevIndex = index end procedure --DisplayList function NewSpec() sequence PathSplit, new_path, new_filter object input_line, new_list -- trace(1) new_list = {} position(2,1) text_color(WHITE) bk_color(BLUE) puts(1,repeat(32,80)) cursor(#0607) position(2,1) puts(1,"NEW FILTER: ") input_line = gets(0) cursor(NO_CURSOR) if atom(input_line) then return list else new_filter = input_line[1..length(input_line)-1] if length(new_filter) = 0 then return list end if end if PathSplit=f_split(new_filter) if length(PathSplit[3]) then new_filter = PathSplit[3]&'.'&PathSplit[4] else new_filter = filter end if if length(PathSplit[1]) then new_path = PathSplit[1]&PathSplit[2] elsif length(PathSplit[2]) then new_path = PathSplit[2] else new_path = path end if if new_path[length(new_path)] != '\\' then new_path = new_path & '\\' end if new_list=dir(new_path&new_filter) if atom(new_list) then return list end if filter = new_filter path = new_path if length(new_list[1][D_NAME])=1 and match(".",new_list[1][D_NAME]) then return new_list[2..length(new_list)] else return new_list end if end function -- NewSpec() function DoSelect() -- navigate the list and return the index of the selected one integer index,car index = 1 while 1 do DisplayList(index) car = wait_key() if car = ESC then return 0 elsif car = LEFT then if index > 1 then index = index - 1 end if elsif car = RIGHT then if index < length(list) then index = index + 1 end if elsif car = UP then if index > PerLine then index = index - PerLine end if elsif car = DOWN then if index <= length(list)-PerLine then index = index + PerLine end if elsif car = HOME then if index > 1 then index = 1 end if elsif car = END then if index < length(list) then index = length(list) end if elsif car = PG_DOWN then if PrevFirst + PerLine*ListLines -1 < length(list) then index = Min(index+ListLines*PerLine,length(list)) end if elsif car = PG_UP then if index > ListLines*PerLine then index = index - ListLines*PerLine end if elsif car = 'F' or car = 'f' then list = NewSpec() index = 1 PrevIndex = 0 PrevFirst = 0 elsif car = ENTER then if match("d",list[index][D_ATTRIBUTES])=0 then return index else if match("..",list[index][D_NAME])=1 then path = ParentDir(path) else path = path&list[index][D_NAME]&'\\' end if list = CreateList(path&filter) index = 1 PrevIndex = 0 PrevFirst = 0 end if end if end while end function -- DoSelect global function ChooseFile(sequence APath) -- display a list of file -- return the selected file or {} if operation canceled sequence saved, FileSpec, vc, CurPos integer pick,OldColor,OldBack CurPos = get_position() OldColor = TextColor OldBack= BkColor FileSpec=f_split(APath) if length(FileSpec[1]) then path = FileSpec[1] & FileSpec[2] end if if length(FileSpec[3]) then filter = FileSpec[3]&"."&FileSpec[4] end if vc = video_config() saved=save_text_image({1,1},{vc[VC_LINES],vc[VC_COLUMNS]}) -- save all screen cursor(NO_CURSOR) ListLines = vc[VC_LINES] - 2 ListCol = vc[VC_COLUMNS] PerLine = floor(ListCol/NAME_FIELD) list = CreateList(filter) pick = DoSelect() display_text_image({1,1},saved) text_color(OldColor) bk_color(OldBack) cursor(#0607) FileSpec = f_split(filter) position(CurPos[1],CurPos[2]) if pick then return FileSpec[1] & FileSpec[2] & list[pick][D_NAME] else return {} end if end function -- ChooseFile
3. Re: File Search & Select PGM
- Posted by "Lucien T. Elliott" <lucien at NY.FRONTIERCOMM.NET> Sep 28, 1996
- 1955 views
jacques, interesting difference between your filesearch and freds. pls allow me to comment though; freds worked right out of the box, and your did not! the problem seems to be that you have either modified graphics.e or you have a more recent version ( i may have missd some update of it). but, your use of bkcolor and textcolor as variables (i suppose to save the text & bkg colors) result in unresolved references. which brings us to the real problem; if this language is growing (rightly so IMHO) from the includes, then we must be careful to notify one another of any changes to these common functions, and make them commonly available (sounds like an admin headache to me too). also, how do we avoid conflict and possible disagreement over changes to common function? we could end up with a mess as bad as the many flavors available for C... Lucien T. Elliott Warwick Information Technology 29 Hawthorn Avenue Warwick, NY 10990 (914) 986 5139 URL //ny.frontiercomm.net/~lucien EMAL lucien at ny.frontiercomm.net
4. Re: File Search & Select PGM
- Posted by Jacques Deschjnes <desja at QUEBECTEL.COM> Sep 28, 1996
- 1947 views
- Last edited Sep 29, 1996
Lucien T. Elliott wrote: > pls allow me to comment though; freds worked right out of the box, > and your did not! the problem seems to be that you have either > modified graphics.e or you have a more recent version ( i may > have missd some update of it). >=20 > but, your use of bkcolor and textcolor as variables (i suppose > to save the text & bkg colors) result in unresolved references. >=20 > which brings us to the real problem; if this language is growing > (rightly so IMHO) from the includes, then we must be careful to > notify one another of any changes to these common functions, > and make them commonly available (sounds like an admin > headache to me too). also, how do we avoid conflict and possible > disagreement over changes to common function? we could end > up with a mess as bad as the many flavors available for C... OOPS! Sorry about that! I just forgot that at the time wrote that File Search I modified graphics.e. Here are the modifications: global integer TextColor -- text_color last value global integer BkColor -- bk_color last value TextColor =3D 7 -- default value BkColor =3D 0 -- default value global procedure text_color(color c) -- set the foreground text color to c - text or graphics modes -- add 16 to get blinking TextColor =3D c machine_proc(M_SET_T_COLOR, c) end procedure global procedure bk_color(color c) -- set the background color to c - text or graphics modes BkColor =3D c machine_proc(M_SET_B_COLOR, c) end procedure This was done to enables me to reset the color context when leaving file search function. I like functions that restore the original context on leaving. But to restore original colors we need a mean to know their origal values. Jacques Desch=EAnes P.S. I will be more carefull to stick to originals includes next time.
5. File Search & Select PGM
- Posted by Jacques Deschjnes <desja at QUEBECTEL.COM> Sep 28, 1996
- 1942 views
- Last edited Sep 29, 1996
Yesterday I posted a filelist.e include file that use a modified graphics.e Consedering the reply of Mr. Elliott I decided to comment out the lines refering to TextColor an BackColor so this one will work with the original graphics.e But the caller will have to take care of restoring the colors prevailing before the call to ChooseFile() Jaques Deschenes Baie-Comeau, Quebec, Canada ********************************************************************* -- FileList: display le list of file for user to pick one and return the -- selected file. -- Creation date: august 26th, 1996 -- By: Jacques Deschenes, Baie-comeau, P.Q. Canada -- e-mail: desja at quebectel.com -- -- caller pass a wildcard path to use as a filter without warning with trace include graphics.e include wildcard.e include machine.e include get.e include image.e include file.e -- Keys constant constant ESC = 27, ENTER = 13, HOME = 327, END = 335, UP = 328, DOWN = 336, LEFT =331, RIGHT =333, PG_UP = 329, PG_DOWN = 337 sequence list,path,filter list = {} path = current_dir() & '\\' filter = "*.*" -- display metrics integer ListLines, -- number of lines to display list ListCol, -- number of columns to display the list PerLine -- number of file name displayed per line constant NAME_FIELD= 14 -- width of name field -- math functions function Min(integer a, integer b) if a < b then return a else return b end if end function -- Min function Max(integer a, integer b) if a > b then return a else return b end if end function -- Max function ToUpper(integer c) -- convert c to upper case if c >= 'a' and c <= 'z' then return c - 'a' + 'A' else return c end if end function -- ToUpper() function f_split(sequence path) -- split path to drive, directory, name and extension -- return sequence {drive,dir,name,ext} sequence slice,drive,dir,name,ext atom c slice = {} drive = {} dir = {} name = {} ext = {} for i =1 to length(path) by 1 do c = ToUpper(path[i]) slice = slice & c if c = ':' then drive = slice slice = {} elsif c = '\\' then dir = dir & slice slice = {} elsif c = '.' then name = slice[1..length(slice)-1] slice = {} end if end for if length(name) = 0 then name = slice else ext = slice end if if length(ext)=0 and not match("*",name) and not match("?",name) then dir = dir & name name = "*" ext = "*" end if if length(dir) then if dir[length(dir)] != '\\' then dir = dir & '\\' end if end if return {drive,dir,name,ext} end function -- f_split() function ParentDir(sequence path) sequence parent integer i if path[length(path)] = '\\' then path = path[1..length(path)-1] end if i = length(path) while i > 0 do if path[i] = '\\' or path[i] = ':' then exit end if i = i-1 end while if i = 0 then return {} end if parent = path[1..i] if parent[length(parent)] != '\\' then parent = parent & '\\' end if return parent end function -- ParentDir() function CreateList(sequence filter) object FileList FileList = dir(filter) if atom(FileList) then return {} end if if length(FileList[1][D_NAME]) = 1 and match(".",FileList[1][D_NAME]) then FileList = FileList[2..length(FileList)] end if return FileList end function -- CreateList function Left(sequence Str, integer width) -- left justify a string in a specified field width. Str = Str & repeat(32,width) return Str[1..width] end function -- Left() procedure WriteFileInfo(integer index) position(2,1) bk_color(BLUE) text_color(WHITE) if index=0 then puts(1,"No files\n") else printf(1,"%14s %5s %8d %4d/%2.2d/%2.2d %2.2d:%2.2d:%2.2d\n", list[index]) end if end procedure --WriteFileInfo() sequence padding padding = repeat(32,NAME_FIELD) procedure WriteFileName(integer i) sequence name if match("d",list[i][D_ATTRIBUTES]) then text_color(BLACK) else text_color(WHITE) end if name = list[i][D_NAME] & padding puts(1,name[1..NAME_FIELD]) end procedure -- WriteFileName() integer PrevFirst, PrevIndex PrevFirst = 0 PrevIndex = 0 procedure DisplayList(integer index) -- Display the list HiLight the selected one sequence pos integer first,last if index = PrevIndex then return end if first = 1 if index > ListLines*PerLine then first = floor(index/PerLine-ListLines+1)*PerLine+1 end if if first = PrevFirst then position(3+floor((PrevIndex-first)/PerLine), NAME_FIELD*remainder(PrevIndex-first,PerLine)+1) bk_color(BROWN) WriteFileName(PrevIndex) position(3+floor((index-first)/PerLine), NAME_FIELD*remainder(index-first,PerLine)+1) bk_color(GREEN) WriteFileName(index) WriteFileInfo(index) PrevIndex = index return end if bk_color(BROWN) clear_screen() text_color(WHITE) bk_color(BLUE) puts(1,repeat(32,2*ListCol)) position(1,1) printf(1,"%s files: %d\n",{Left(path&filter,60),length(list)}) WriteFileInfo(index) last = Min(first+ListLines*PerLine-1,length(list)) bk_color(BROWN) for i = first to last by 1 do WriteFileName(i) if remainder(i,PerLine)=0 then pos = get_position() if pos[1] < ListLines + 2 then puts(1,"\n") end if end if end for position(3+floor((index-first)/PerLine), NAME_FIELD*remainder(index-first,PerLine)+1) bk_color(GREEN) WriteFileName(index) PrevFirst = first PrevIndex = index end procedure --DisplayList function NewSpec() sequence PathSplit, new_path, new_filter object input_line, new_list -- trace(1) new_list = {} position(2,1) text_color(WHITE) bk_color(BLUE) puts(1,repeat(32,80)) cursor(#0607) position(2,1) puts(1,"NEW FILTER: ") input_line = gets(0) cursor(NO_CURSOR) if atom(input_line) then return list else new_filter = input_line[1..length(input_line)-1] if length(new_filter) = 0 then return list end if end if PathSplit=f_split(new_filter) if length(PathSplit[3]) then new_filter = PathSplit[3]&'.'&PathSplit[4] else new_filter = filter end if if length(PathSplit[1]) then new_path = PathSplit[1]&PathSplit[2] elsif length(PathSplit[2]) then new_path = PathSplit[2] else new_path = path end if if new_path[length(new_path)] != '\\' then new_path = new_path & '\\' end if new_list=dir(new_path&new_filter) if atom(new_list) then return list end if filter = new_filter path = new_path if length(new_list[1][D_NAME])=1 and match(".",new_list[1][D_NAME]) then return new_list[2..length(new_list)] else return new_list end if end function -- NewSpec() function DoSelect() -- navigate the list and return the index of the selected one integer index,car index = 1 while 1 do DisplayList(index) car = wait_key() if car = ESC then return 0 elsif car = LEFT then if index > 1 then index = index - 1 end if elsif car = RIGHT then if index < length(list) then index = index + 1 end if elsif car = UP then if index > PerLine then index = index - PerLine end if elsif car = DOWN then if index <= length(list)-PerLine then index = index + PerLine end if elsif car = HOME then if index > 1 then index = 1 end if elsif car = END then if index < length(list) then index = length(list) end if elsif car = PG_DOWN then if PrevFirst + PerLine*ListLines -1 < length(list) then index = Min(index+ListLines*PerLine,length(list)) end if elsif car = PG_UP then if index > ListLines*PerLine then index = index - ListLines*PerLine end if elsif car = 'F' or car = 'f' then list = NewSpec() index = 1 PrevIndex = 0 PrevFirst = 0 elsif car = ENTER then if match("d",list[index][D_ATTRIBUTES])=0 then return index else if match("..",list[index][D_NAME])=1 then path = ParentDir(path) else path = path&list[index][D_NAME]&'\\' end if list = CreateList(path&filter) index = 1 PrevIndex = 0 PrevFirst = 0 end if end if end while end function -- DoSelect global function ChooseFile(sequence APath) -- display a list of file -- return the selected file or {} if operation canceled sequence saved, FileSpec, vc, CurPos integer pick --,OldColor,OldBack CurPos = get_position() --OldColor = TextColor OldBack= BkColor FileSpec=f_split(APath) if length(FileSpec[1]) then path = FileSpec[1] & FileSpec[2] end if if length(FileSpec[3]) then filter = FileSpec[3]&"."&FileSpec[4] end if vc = video_config() saved=save_text_image({1,1},{vc[VC_LINES],vc[VC_COLUMNS]}) -- save all screen cursor(NO_CURSOR) ListLines = vc[VC_LINES] - 2 ListCol = vc[VC_COLUMNS] PerLine = floor(ListCol/NAME_FIELD) list = CreateList(filter) pick = DoSelect() display_text_image({1,1},saved) -- text_color(OldColor) bk_color(OldBack) cursor(#0607) FileSpec = f_split(filter) position(CurPos[1],CurPos[2]) if pick then return FileSpec[1] & FileSpec[2] & list[pick][D_NAME] else return {} end if end function -- ChooseFile