1. File Search & Select PGM
- Posted by MR FREDERICK A COLE <facole at PRODIGY.COM>
Sep 26, 1996
-
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
-
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
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
-
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
-
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
