1. inprved filelist.e
- Posted by Jacques Deschenes <desja at QUEBECTEL.COM>
Nov 25, 1996
-
Last edited Nov 26, 1996
--=====================_848990548==_
to all,
This message is a postage of the last revision of FILELIST.E I posted ealier
added feature are:
1) a drive list
2) the filelist is now sorted.
3) The names betwen angle brackets on the last line of display act as
mouse buttons. 4) to change drive using keyboard, press corresponding key.
5) to change filter you should use alt-f instead of 'F'.
--=====================_848990548==_
-- 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
--
-- globals:
-- function ChooseFile(sequence APath)
-- APath = [drive][directory][name wildcard]
--
-- procedure SetFListColors(sequence colors)
-- color is a sequence of 7 colors as:
-- colors = {iInfoBack, -- information lines back color
-- iInfoText, -- informations lines text color
-- iListBack, -- list back color
-- iFileName, -- file name text color
-- iDirName, -- directory name text color
-- iSelected -- selected item back color
-- }
--
-- *********************USAGE **************
-- include FileList.e
-- sequence FileName
-- FileName = ChooseFile(filter)
-- filter is a directory specification that can include a wild card file
-- name.
--
-- caller pass a wildcard path to use as a filter
--
-- revision October 16th , 1996
-- 1) function NewSpec() was not working. Corrected this bug.
-- 2) now last line of display same color as top 2.
-- 3) Added SetFListColors() procedure to set menu colors.
-- 4)
-- revision: October 13th, 1996
-- corrected bugs:
-- 1) DisplayList() crash when list was empty.
-- 2) PrevIndex and PrevFirst were not initialised at each call so display
-- was not updating correctly.
-- 3) directories were not included in list when using a file filter.
--
-- revision date: October 30th, 1996
-- modified code to use mouse.
-- revision date: November 4th, 1996.
-- corrected bugs:
-- 1) no response from mouse on next call to ChooseFile()
-- 2) End of second line was not cleared on next call to ChooseFile()
--
-- revision date: November 25th, 1996
-- 1) added a drive list
-- 2) display an ordered list of directories an files
-- 3) added mouse buttons on the last line of display
without warning
--with trace
--constant test = 1 -- set to 1 during test and debug phase.
include graphics.e
include wildcard.e
include machine.e
include get.e
include image.e
include file.e
include mouse.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,
ALT_F=289
sequence drives,list,path,filter
list = {}
path = current_dir() & '\\'
filter = "*.*"
integer -- colors
iInfoBack, -- information lines back colors
iInfoText, -- information lines text colors
iListBack, -- file list back color
iFileName, -- file list name text color
iDirName, -- files list directory name text color
iSelected -- selected item back color
integer iUseMouse -- set to 1 if mouse detected.
-- 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
ScrLines, -- number of screen lines
ScrCol -- number of screen colomns
constant NAME_FIELD= 14 -- width of name field
procedure ScrollDown(integer NbLines, integer color)
-- NbLines = How mamy lines to scroll down
-- color = color of empty lines.
sequence r
r = repeat(0,10)
r[REG_AX] = #700 + NbLines -- NbLines = 0 clear screen.
r[REG_CX] = #0101
r[REG_DX] = ScrLines*256 + ScrCol
r[REG_BX] = color*256
r = dos_interrupt(#10,r)
end procedure -- ScrollDown()
procedure ScrollUp(integer NbLines, integer color)
-- NbLines = How mamy lines to scroll up
-- color = color of empty lines.
sequence r
r = repeat(0,10)
r[REG_AX] = #600 + NbLines -- NbLines = 0 clear screen.
r[REG_CX] = #0101
r[REG_DX] = ScrLines*256 + ScrCol
r[REG_BX] = color*256
r = dos_interrupt(#10,r)
end procedure -- ScrollUp()
procedure Clreol()
-- clear end of line
sequence CurPos, FirstLine
CurPos = get_position()
if CurPos[1] = ScrLines then
FirstLine = save_text_image({1,1},{1,ScrCol}) -- save first line
puts(1,repeat(32,ScrCol-CurPos[2]+1))
ScrollDown(1,7)
display_text_image({1,1},FirstLine)
else
puts(1,repeat(32,ScrCol-CurPos[2]+1))
end if
position(CurPos[1],CurPos[2])
end procedure -- Clreol()
-- 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 MousePresent()
-- return 1 if mouse detected
integer MouseVector
sequence r
MouseVector = (256*peek(207)+peek(206)) *16 + 256*peek(205)+peek(204)
if MouseVector = 0 or peek(MouseVector) = #CF then
return 0 -- no mouse
end if
r = repeat(0,10)
r[REG_AX] = 0
r = dos_interrupt(#33,r)
return r[REG_AX] = #FFFF -- r[REG_AX] = #FFFF if mouse present
end function -- MousePresent
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)
-- remove last sub directory from path if there is one and return it.
-- if root return empty sequence
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 sort(sequence fl)
-- quick sort a file list by ascending file name
sequence swap, m
integer l,r,p
if length(fl) < 2 then
return fl
end if
if length(fl) = 2 then
if compare(fl[1][D_NAME],fl[2][D_NAME]) = 1 then
return {fl[2],fl[1]}
else
return fl
end if
end if
p = floor(length(fl)/2)
m = fl[p][D_NAME]
l = 1 r = length(fl)
while l < r do
while compare(fl[l][D_NAME],m) = -1 do
l = l + 1
end while
while compare(m,fl[r][D_NAME]) = -1 do
r = r - 1
end while
if l < r then
swap = fl[r]
fl[r] = fl[l]
fl[l] = swap
end if
end while
return sort(fl[1..r]) & sort(fl[r+1..length(fl)])
end function -- sort()
function FilterList(sequence FileList, sequence filter)
-- filter list to remove unwanted files.
sequence dirs,files
if length(FileList[1][D_NAME]) = 1 and match(".",FileList[1][D_NAME]) then
FileList = FileList[2..length(FileList)]
end if
dirs ={}
files = {}
for i = 1 to length(FileList) do
if match("d",FileList[i][D_ATTRIBUTES]) then
dirs = append(dirs,FileList[i])
else
if wildcard_file(filter,FileList[i][D_NAME]) then
files = append(files,FileList[i])
end if
end if
end for
return sort(dirs) & sort(files)
end function -- FilterList()
function CreateList(sequence filter)
-- create a list of file from filter
object FileList
FileList = dir(path & "*.*")
if atom(FileList) then
return {}
end if
return FilterList(FileList,filter)
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(iInfoBack)
text_color(iInfoText)
if length(list) = 0 or index=0 then
puts(1,"No files")
else
printf(1,"%14s %5s %8d %4d/%2.2d/%2.2d %2.2d:%2.2d:%2.2d",
list[index])
end if
Clreol()
puts(1,'\n')
end procedure --WriteFileInfo()
procedure WriteDriveList()
position(3,1)
bk_color(iInfoBack)
text_color(iInfoText)
for i = 1 to length(drives) do
puts(1,drives[i] & ": ")
end for
Clreol()
puts(1,'\n')
end procedure --WriteDriveList()
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
constant buttons=" <Filter> <"&17&"> <"&16&"> <"&24&"> <"&25&
"> <PgUp> <PgDn> <Home> <End> <CANCEL>"
constant buttonsX={{3,8},{12,12},{16,16},{20,20},{24,24},{28,31},{35,38},
{42,45},{49,51},{55,60}}
constant ButtonsToKey={ALT_F,LEFT,RIGHT,UP,DOWN,PG_UP,PG_DOWN,HOME,END,
ESC}
procedure DisplayList(integer index)
-- Display the list HiLight the selected one
sequence pos
integer first,last
if index = PrevIndex then
return
end if
mouse_pointer(0)
first = 1
if index > ListLines*PerLine then
first = floor(index/PerLine-ListLines+1)*PerLine+1
end if
if first = PrevFirst then
position(4+floor((PrevIndex-first)/PerLine),
NAME_FIELD*remainder(PrevIndex-first,PerLine)+1)
bk_color(iListBack)
WriteFileName(PrevIndex)
position(4+floor((index-first)/PerLine),
NAME_FIELD*remainder(index-first,PerLine)+1)
bk_color(iSelected)
WriteFileName(index)
WriteFileInfo(index)
PrevIndex = index
mouse_pointer(1)
return
end if
bk_color(iListBack)
clear_screen()
position(ScrLines,1)
bk_color(iInfoBack)
text_color(iInfoText)
puts(1,buttons)
Clreol()
position(1,1)
text_color(iInfoText)
bk_color(iInfoBack)
puts(1,repeat(32,2*ListCol))
position(1,1)
printf(1,"%s files: %d\n",{Left(path&filter,60),length(list)})
WriteFileInfo(index)
WriteDriveList()
if not length(list) then
mouse_pointer(1)
return -- empty list
end if
last = Min(first+ListLines*PerLine-1,length(list))
bk_color(iListBack)
for i = first to last by 1 do
WriteFileName(i)
if remainder(i,PerLine)=0 then
pos = get_position()
if pos[1] < ListLines + 3 then
puts(1,"\n")
end if
end if
end for
position(4+floor((index-first)/PerLine),
NAME_FIELD*remainder(index-first,PerLine)+1)
bk_color(iSelected)
WriteFileName(index)
PrevFirst = first
PrevIndex = index
mouse_pointer(1)
end procedure --DisplayList
function NewSpec()
-- ask user for a new filter specification. Can be a new drive.
sequence PathSplit, new_path, new_filter
object input_line, new_list
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 input_line[1] = 10 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
if atom(dir(new_path&new_filter)) then -- check if valid filter.
return list -- if not return old list.
end if
path = new_path
filter = new_filter
new_list=CreateList(filter)
if atom(new_list) then
return list
else
return new_list
end if
end function -- NewSpec()
constant NO_EVENT = 0, KEY_EVENT = 1, MOUSE_EVENT = 2 -- type of events
function GetEvent()
-- loop and wait for a mouse or key event.
integer key object mouse
while 1 do
key = ToUpper(get_key())
if key > -1 then
return {KEY_EVENT,key}
end if
mouse = get_mouse()
if sequence(mouse) then
if mouse[1] = LEFT_DOWN or mouse[1] = RIGHT_DOWN then
return {MOUSE_EVENT,mouse}
end if
end if
end while
end function -- GetEvent
function ConvertMouseToKey(sequence MouseEvent, integer index)
-- convert a mouse event to a key event.
integer x,y, TmpIdx
--trace(1)
x = floor(MouseEvent[2]/8) + 1
y = floor(MouseEvent[3]/8) + 1
if y = 1 then
if x <= length(path&filter) then
return {ALT_F,index}
else
return {0,index}
end if
elsif y = 2 then
return {ENTER,index}
elsif y = 3 then
TmpIdx = floor((x-1)/3) + 1
if TmpIdx <= length(drives) then
return {drives[TmpIdx],index}
else
return {0,index}
end if
elsif y = ScrLines then -- buttons
TmpIdx = 0
for i = 1 to length(buttonsX) do
if x >= buttonsX[i][1] and x <= buttonsX[i][2] then
TmpIdx = ButtonsToKey[i]
exit
end if
end for
return {TmpIdx,index}
elsif floor(x/NAME_FIELD)+1 <= PerLine then
TmpIdx = PerLine*(y-4)+floor(x/NAME_FIELD) + 1
if TmpIdx <= length(list) then
if MouseEvent[1] = LEFT_DOWN then
return {ENTER,TmpIdx}
else
return {0,TmpIdx}
end if
else
return{0,index}
end if
else
return {0,index}
end if
end function -- convertMouseToKey()
function DoSelect()
-- navigate the list and return the index of the selected one
integer index,char sequence event, KeyIndex
index = 1
while 1 do
DisplayList(index)
if iUseMouse then
event = GetEvent()
if event[1] = MOUSE_EVENT then
KeyIndex = ConvertMouseToKey(event[2],index)
char = KeyIndex[1]
index = KeyIndex[2]
else
char = event[2]
end if
else
char = ToUpper(get_key())
end if
if char = ESC then
return 0
elsif find(char,drives) then
path = char&":\\"
list = CreateList(filter)
index = 1
PrevIndex = 0 PrevFirst = 0
elsif char = LEFT then
if index > 1 then
index = index - 1
end if
elsif char = RIGHT then
if index < length(list) then
index = index + 1
end if
elsif char = UP then
if index > PerLine then
index = index - PerLine
end if
elsif char = DOWN then
if index <= length(list)-PerLine then
index = index + PerLine
end if
elsif char = HOME then
if index > 1 then
index = 1
end if
elsif char = END then
if index < length(list) then
index = length(list)
end if
elsif char = PG_DOWN then
if PrevFirst + PerLine*ListLines -1 < length(list) then
index = Min(index+ListLines*PerLine,length(list))
end if
elsif char = PG_UP then
if index > ListLines*PerLine then
index = index - ListLines*PerLine
end if
elsif char = ALT_F then
list = NewSpec()
index = 1
PrevIndex = 0 PrevFirst = 0
elsif char = 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(filter)
index = 1
PrevIndex = 0 PrevFirst = 0
end if
end if -- case char
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 screen
cursor(NO_CURSOR)
ScrLines = vc[VC_LINES]
ScrCol = vc[VC_COLUMNS]
ListLines = vc[VC_LINES] - 4
ListCol = vc[VC_COLUMNS]
PerLine = floor(ListCol/NAME_FIELD)
list = CreateList(filter)
PrevFirst = 0 PrevIndex = 0
if MousePresent() then
iUseMouse = 1 -- use mouse
mouse_pointer(1) -- show mouse cursor
mouse_events(LEFT_DOWN + RIGHT_DOWN)
else
iUseMouse = 0
end if
pick = DoSelect()
if iUseMouse then
mouse_pointer(0) -- hide mouse cursor
end if
display_text_image({1,1},saved)
-- text_color(OldColor) bk_color(OldBack)
cursor(#0607)
position(CurPos[1],CurPos[2])
if pick then
return path & list[pick][D_NAME]
else
return {}
end if
end function -- ChooseFile
global procedure SetFListColors(sequence colors)
-- Set the color for the file list display
-- sequence structure:
-- { InfoLines_back_color, InfoLines_textColor, list_back_color,
-- list_file_name_color, list_directory_color, list_selected_back_color}
iInfoBack = colors[1]
iInfoText = colors[2]
iListBack = colors[3]
iFileName = colors[4]
iDirName = colors[5]
iSelected = colors[6]
end procedure -- SetFListColors()
-- This will return a list of PHYSICAL floppy and hard drives
global function GetDriveList()
integer hdn,fdn
sequence fl,hl,cdl, cdId
object d
fdn = floor(peek(#410) / 64)
if fdn = 0 then
fl = "A"
elsif fdn = 1 then
fl = "AB"
end if
hdn = peek(#475)
if hdn = 1 then
hl = "C"
cdId = "D:"
elsif hdn = 2 then
hl = "CD"
cdId = "E:"
end if
--check for CD-ROM
d = {}
cdl = ""
while not atom(d) do
d = dir(cdId)
if sequence(d) then
cdl = cdl & cdId[1]
cdId[1] = cdId[1] + 1
end if
end while
return fl & hl & cdl
end function -- GetDriveList()
-------------------------------------------------------------------------------
-- initialisation
drives = GetDriveList()
SetFListColors({BLUE, WHITE, BROWN, WHITE, BLACK, GREEN}) -- default colors
--if test then
-- puts(1,"Selected file is " & ChooseFile("*.*")&'\n')
--end if
--=====================_848990548==_
Jacques Deschenes
Baie-Comeau, Quebec
Canada
desja at quebectel.com
--=====================_848990548==_--
