-- FILE:     DOSLFN.E
-- PURPOSE:  DOS Long File Name (LFN) routines for Euphoria 3.1.1.
-- AUTHOR:   Shian Lee
-- VERSION:  1.00  February/13/2022
-- LANGUAGE: Euphoria version 3.1.1 (http://www.RapidEuphoria.com)
-- PLATFORM: DOS32
-- LICENCE:  Free. Use at your own risk.
-- NOTE:     * LFN works on DOS32 platform only if a LFN driver is installed.
--           * User's program must call allow_lfn(1) to enable LFN if possible.
--           * You can use DOSLFN.EU instead of DOSLFN.E. (smaller executable).
--           * See the attached reference manual FILE2.DOC for details.
--           * Created using EDU 3.07 (www.RapidEuphoria311.com).
-- HISTORY:  v1.00 - initial version (February/13/2022).
-----------------------------------------------------------------------------



--bookmark: include Euphoria 3.1.1 library files;
include misc.e
include file.e
include machine.e



--bookmark: Locals;

constant FALSE = 0, 
	 TRUE = 1, 
	 EMPTY = {},
	 NULL = 0,  -- ASCII-0
	 FAIL = -1, -- -1 is common for all file I/O errors
	 OS_DOS32 = (platform() = DOS32)


type boolean(integer b)
    return b = FALSE or b = TRUE
end type


type string(sequence s)
    return equal(s and 0, repeat(0, length(s))) -- flat sequence?
end type


-- PURPOSE: trim a null-terminated-string (asciiz)
-- RETURN:  string;
function trim_asciiz(sequence s)
    integer p

    p = find(NULL, s)
    if p then
	return s[1..p - 1]
    end if
    return s
end function



--bookmark: Long File Name;

-- PURPOSE: return short (8.3) or long full pathname (LFN)
-- DETAILS: long is 0/1 (short/long)
-- RETURN:  object; -1/"pathname" (error/success)
-- EXAMPLE: x = lfn_pathname(".", 1) -- x is -1 if lfn not supported, or
--                                   -- x is "C:\Temp Directory", etc
--          x = lfn_pathname(".", 0) -- x is "C:\TEMPDI~1", etc
function lfn_pathname(string pn, boolean long)
    sequence r, pn2
    integer ad, ad2
    
    if not OS_DOS32 then
	return FAIL
    end if

    ad = allocate_low(length(pn) + 1)
    if not ad then
	return FAIL
    else
	ad2 = allocate_low(261)     -- ES:DI buffer (long=260, short=128) 
	if not ad2 then
	    free_low(ad)
	    return FAIL
	end if
    end if
    
    poke(ad, pn & NULL)
    poke(ad2, NULL)                 -- on error ES:DI buffer = NULL
    r = repeat(0, REG_LIST_SIZE)
    r[REG_AX] = #7160               -- AX=#7160 (LFN) - TRUENAME function
    r[REG_CX] = #8001 + (long = 1)  -- CL=#01/#02 - Get Short/Long path function
				    -- CH=#00/#80 - don't/use SUBST drive letter
    r[REG_DS] = floor(ad / 16)      -- DS:SI=seg:offs for asciiz pn
    r[REG_SI] = remainder(ad, 16)
    r[REG_ES] = floor(ad2 / 16)     -- ES:DI=seg:offs for asciiz pn2
    r[REG_DI] = remainder(ad2, 16)
    r = dos_interrupt(#21, r)       -- (carry set on error in MS-DOS 7.0+ only)
    pn2 = peek({ad2, 261})
    free_low(ad)
    free_low(ad2)
    if pn2[1] = NULL then           -- on error ES:DI buffer = NULL
	return FAIL                 -- path not found, or lfn driver unloaded
    end if
    return trim_asciiz(pn2)
end function



-- PURPOSE: 0 or 1: use regular (MS-DOS 3.2+) or lfn (MS-DOS 7.0+) functions
boolean lfn_allowed
lfn_allowed = FALSE -- use regular (standard) DOS functions by default



-- PURPOSE: allow long file names or not
-- DETAILS: allow is 0/1 (regular/lfn)
-- OUTPUT:  lfn_allowed
global procedure allow_lfn(boolean allow)
    if OS_DOS32 and allow then
	lfn_allowed = sequence(lfn_pathname(".", TRUE)) -- lfn driver loaded?
    else
	lfn_allowed = FALSE
    end if
end procedure



-- PURPOSE: check if long file names allowed
-- NOTE:    check_lfn() must be fast to serve other functions
-- RETURN:  boolean; 0/1 (not allowed/allowed)
global function check_lfn()
    return lfn_allowed 
end function



-- PURPOSE: return the short full pathname of a file or directory
-- DETAILS: verify is 0/1 (return pn on error/return -1 on error)
-- RETURN:  object; -1/"pathname"
global function lfn_short_path(string pn, boolean verify)
    object x
    
    if lfn_allowed then
	x = lfn_pathname(pn, FALSE)
	if verify or sequence(x) then
	    return x -- short path or -1 on error
	end if
    elsif verify then
	return FAIL -- lfn not allowed
    end if
    return pn -- don't verify
end function



-- PURPOSE: return the long full pathname of a file or directory
-- DETAILS: verify is 0/1 (return pn on error/return -1 on error)
-- RETURN:  object; -1/"pathname"
global function lfn_long_path(string pn, boolean verify)
    object x
    
    if lfn_allowed then
	x = lfn_pathname(pn, TRUE)
	if verify or sequence(x) then
	    return x -- long path or -1 on error
	end if
    elsif verify then
	return FAIL -- lfn not allowed
    end if
    return pn -- don't verify
end function



--bookmark: Directory;

-- PURPOSE: return the name of the current directory
-- RETURN:  string;
global function lfn_current_dir()
    object x
    
    if lfn_allowed then
	x = lfn_pathname(".", TRUE)
	if sequence(x) then -- verify lfn driver loaded
	    return x
	end if
    end if
    return current_dir()
end function



-- PURPOSE: change to a new current directory
-- RETURN:  boolean; 0/1 (error/success)
global function lfn_chdir(string pn)
    if lfn_allowed then
	-- if lfn driver unloaded: return chdir({255})
	return chdir(lfn_pathname(pn, FALSE) & EMPTY)
    end if
    return chdir(pn)
end function



--bookmark: Dir;

-- PURPOSE: unpack DOS's attributes byte to string
-- DETAILS: attr byte: bit-0=r, 1=h, 2=s, 3=v, 4=d, 5=a
-- RETURN:  string; dir()'s D_ATTRIBUTES 
-- EXAMPLE: s = attr_to_str(#21)  -- s is "ra"
function attr_to_str(integer attr)
    sequence s
    
    s = EMPTY
    -- get attributes in dir()'s order
    if and_bits(attr,  #1) then s &= 'r' end if -- read-only
    if and_bits(attr,  #2) then s &= 'h' end if -- hidden
    if and_bits(attr,  #4) then s &= 's' end if -- system
    if and_bits(attr,  #8) then s &= 'v' end if -- volume
    if and_bits(attr, #10) then s &= 'd' end if -- directory
    if and_bits(attr, #20) then s &= 'a' end if -- archive
    return s
end function



-- PURPOSE: unpack DOS's date-time words to sequence
-- DETAILS: d is date, t is time (16-bit words)
-- RETURN:  sequence; dir()'s D_YEAR..D_SECOND
-- EXAMPLE: s = datetime_to_seq(#4155, #98137A90) -- s is {2012,10,21,15,20,32}
function datetime_to_seq(integer d, integer t)
    return {                    -- index:     bits (DOS format):
	floor(d / #200) + 1980, -- 4.D_YEAR   9-15 =year (relative to 1980)
	and_bits(d / #20, #F),  -- 5.D_MONTH  5-8  =month (1..12)
	and_bits(d, #1F),       -- 6.D_DAY    0-4  =day (1..31)
	floor(t / #800),        -- 7.D_HOUR   11-15=hours (0..23)
	and_bits(t / #20, #3F), -- 8.D_MINUTE 5-10 =minutes (0..59)
	and_bits(t, #1F) * 2    -- 9.D_SECOND 0-4  =2-second increments (0..29)
    }
end function



-- PURPOSE: return lfn dir entry in dir()'s format
-- DETAILS: ad_fdr is the low memory address of 317-byte FindData record
-- RETURN:  sequence; dir()'s D_NAME..D_SECOND
-- EXAMPLE: s = dir_entry(ad_fdr) 
--           -- s may be {"fred", "ra", 2350, 1994, 1, 22, 17, 22, 40}
function lfn_dir_entry(integer ad_fdr)
    return {
	-- 1.D_NAME
	trim_asciiz(peek({ad_fdr + #2C, 260})),
	-- 2.D_ATTRIBUTES
	attr_to_str(peek(ad_fdr)),
	-- 3.D_SIZE, (high 32 bits) + (low 32 bits)
	peek4u(ad_fdr + #1C) * #100000000 + peek4u(ad_fdr + #20) 
    } &
    datetime_to_seq(
	-- 4.D_YEAR, 5.D_MONTH, 6.D_DAY
	and_bits(peek4u(ad_fdr + #16), #FFFF),
	-- 7.D_HOUR, 8.D_MINUTE, 9.D_SECOND
	and_bits(peek4u(ad_fdr + #14), #FFFF)
    )
end function



-- PURPOSE: return complete info on all files in a directory
-- NOTE:    see Euphoria dir() for details
-- DETAILS: pn is pathname
-- RETURN:  object; -1/lfn dir() sequence (error/success)
global function lfn_dir(string pn)
    sequence r, entry, list
    integer ad_pn, handle, len
    integer ad_fdr, segment_fdr, offset_fdr, ad_dname

    if not lfn_allowed then
	return dir(pn)
    end if
    
    -- remove trailing ASCII-0..32 - dir("C:\\ \n") is "C:\"
    len = length(pn)
    while len and pn[len] <= 32 do
	len -= 1
    end while
    pn = pn[1..len]
    if len = 0 then
	return FAIL -- dir("") is -1
    end if
    
    -- root dir (also subdir) must be searched using DOS wildcards
    if pn[len] = '.' then
	pn &= "\\*.*"       
    elsif pn[len] = ':' or pn[len] = '\\' then
	pn &= "*.*"
    end if
    len = length(pn)
    
    -- allocate buffers
    ad_pn = allocate_low(len + 1)   -- asciiz
    if not ad_pn then
	return FAIL
    else
	ad_fdr = allocate_low(317)  -- 317-byte FindData record
	if not ad_fdr then
	    free_low(ad_pn)
	    return FAIL
	end if
	segment_fdr = floor(ad_fdr / 16)
	offset_fdr = remainder(ad_fdr, 16)
	ad_dname = ad_fdr + #2C     -- D_NAME address
    end if

    -- Find First File (CL=#37=110111="rhsda"=normal search)
    poke(ad_pn, pn & NULL)
    poke(ad_dname, NULL)            -- D_NAME = NULL if lfn driver unloaded
    r = repeat(0, REG_LIST_SIZE)    -- initialize registers list
    r[REG_AX] = #714E               -- AX=#714E (LFN) - Find First File function
    r[REG_CX] = #0037               -- CL/CH=allowable/required-attributes mask
    r[REG_SI] = #0001               -- SI=#0001 - DOS date/time format
    r[REG_ES] = segment_fdr         -- ES:DI=seg:offs of FindData record
    r[REG_DI] = offset_fdr
    r[REG_DS] = floor(ad_pn / 16)   -- DS:DX=seg:offs of asciiz pn
    r[REG_DX] = remainder(ad_pn, 16)
    r = dos_interrupt(#21, r)       -- carry set on error if lfn driver loaded
    handle = r[REG_AX]              -- AX=handle for Find Next File (LFN)
    
    -- return dir() to avoid endless loop (unlikely yet a safety net)
    if and_bits(r[REG_FLAGS], 1) then -- file not found (lfn driver loaded)
    elsif peek(ad_dname) = NULL then  -- D_NAME = NULL if lfn driver unloaded
	free_low(ad_pn)
	free_low(ad_fdr)
	return dir(pn)
    end if
    
    -- Find Next File(s)
    list = EMPTY
    while not and_bits(r[REG_FLAGS], 1) do -- carry set on error
	entry = lfn_dir_entry(ad_fdr)
	list = append(list, entry)  -- add entry to dir list
	r = r and 0                 -- clear registers list
	r[REG_AX] = #714F           -- AX=#714F (LFN) - Find Next File function
	r[REG_BX] = handle          -- BX=filefind handle (from AX=#714E)
	r[REG_SI] = #0001           -- SI=#0001 - DOS date/time format
	r[REG_ES] = segment_fdr     -- ES:DI=seg:offs of FindData record
	r[REG_DI] = offset_fdr
	r = dos_interrupt(#21, r)
    end while
    free_low(ad_pn)
    free_low(ad_fdr)
    
    -- terminate dir search (LFN)
    r = r and 0                 -- clear registers list
    r[REG_AX] = #71A1           -- AX=#71A1 (LFN) - FindClose function
    r[REG_BX] = handle          -- BX=filefind handle (from AX=#714E)
    r = dos_interrupt(#21, r)   -- ignore carry set on error (list=EMPTY)
    
    if equal(list, EMPTY) then
	return FAIL -- match not found
    elsif length(list) = 1 and find('d', list[1][D_ATTRIBUTES]) then
	if not (find('*', pn) or find('?', pn)) then
	    return lfn_dir(pn & "\\*.*") -- search subdir using DOS wildcards
	end if
    end if
    
    return list
end function



--bookmark: File;

-- PURPOSE: open a file or device
-- RETURN:  integer; -1/fn (error/file-number)
global function lfn_open(string pn, string mode)
    sequence r
    integer ad, handle

    -- create lfn files for write or append (it fails if file already exists)
    if lfn_allowed and (mode[1] = 'w' or mode[1] = 'a') then
	ad = allocate_low(length(pn) + 1)   -- asciiz buffer
	if not ad then return FAIL end if
	poke(ad, pn & NULL)
	
	r = repeat(0, REG_LIST_SIZE)
	r[REG_AX] = #716C           -- AX=#716C (LFN) - Create/Open File
	r[REG_BX] = 0               -- BX=0 - read-only access mode
	r[REG_CX] = 0               -- CX=0 - create normal attributes
	r[REG_DX] = #0010           -- DX=#0010 - Create File
	r[REG_DS] = floor(ad / 16)  -- DS:SI=seg:offs of asciiz pn
	r[REG_SI] = remainder(ad, 16)
	r = dos_interrupt(#21, r)
	handle = r[REG_AX]
	free_low(ad)
	if not and_bits(r[REG_FLAGS], 1) then -- carry set on error
	    r = r and 0             -- clear registers list
	    r[REG_AX] = #3E00       -- AH=#3E - Close File function
	    r[REG_BX] = handle      -- BX=DOS file handle
	    r = dos_interrupt(#21, r) -- carry set on error
--          printf(1, "close lfn file error? %d\n", and_bits(r[REG_FLAGS], 1))
	end if
    end if

    -- open short/long file name normally (in all modes)
    return open(pn, mode)
end function



-- End of file.
