-- FILE:     RANDOM.E
-- PURPOSE:  Random access file routines for Euphoria 3.1.1.
-- AUTHOR:   Shian Lee
-- VERSION:  1.00  March/23/2017
-- LANGUAGE: Euphoria version 3.1.1 (http://www.RapidEuphoria.com)
-- PLATFORM: Any
-- LICENCE:  Free. Use at your own risk.
-- NOTE:     * See the attached reference manuals RANDOM.DOC.
--           * Created using QE v2.3.9 for DOS (RapidEuphoria.com archive).
-----------------------------------------------------------------------------



-- include Euphoria 3.1.1 library routines
include machine.e
include file.e



--bookmark: Locals;

constant
    EMPTY = {},

    -- -1 returned by file I/O functions
    FAIL = -1,

    -- string field is limited to a reasonable length of 32767 chars (#7FFF),
    -- this size is also compatible with Microsoft (R) QBasic for MS-DOS (R).
    MIN_STR = 1,
    MAX_STR = 32767,

    -- maximum value for signed 1..6 byte integers
    MAX_S1 = #7F,
    MAX_S2 = #7FFF,
    MAX_S3 = #7FFFFF,
 -- MAX_S4 = #7FFFFFFF,
    MAX_S5 = #7FFFFFFFFF,
    MAX_S6 = #7FFFFFFFFFFF,

    -- shift byte factor for 1..6 bytes
    SH1 = #100,
    SH2 = #10000,
    SH3 = #1000000,
    SH4 = #100000000,
    SH5 = #10000000000,
    SH6 = #1000000000000,

    -- sequence of shift byte factors for 1..6 bytes
    SHIFT_BYTE = {
	#1,
	#100,
	#10000,
	#1000000,
	#100000000,
	#10000000000
    }



-- PURPOSE: ra_open() keeps properties of each file in 3 paralleled lists
sequence
    files_number,   -- list of random access file-numbers
    files_reclen,   -- list of record-lengths (sum of field lengths)
    files_fields    -- list of field types sequences

    -- initialize lists to empty, no file is open yet
    files_number = EMPTY
    files_reclen = EMPTY
    files_fields = EMPTY



-- PURPOSE: crash on fatal error (bad argument or seek error)
-- DETAILS: st,x are arguments for sprintf() - a message to print on screen
constant
    UNSUPPORTED_FIELD_TYPE  = "unsupported field type %s",
    FILE_NUMBER_IS_NOT_OPEN = "file number %g is not open for random access",
    FILE_NUMBER_IS_OPEN     = "file number %g is already open for random access",
    WRONG_NUMBER_OF_VALUES  = "wrong number of values (%g != %g)",
    SEEK_TO_RECORD_FAILED   = "seek to record %g failed"
procedure crash(sequence st, object x)
    puts(1, sprintf('\n' & st & "!\n", x))

    ? 1 / 0     -- crash (save call stack in ex.err)
end procedure



--bookmark: Open/Close File;

-- PURPOSE: ra_open()'s global constants for field types (string and numbers).
--          * for string field, the number of characters is the field type.
-- NOTICE:  changing values/order effects all if..then blocks in this library!
global constant
 -- 1 to 32767      -- bytes (characters) for a string field of that length

    RA_S1 =  0,     -- 1 Signed byte,    -128..127
		    --                   (-#80..#7F)
    RA_U1 = -1,     -- 1 Unsigned byte,  0..255
		    --                   (#0..#FF)
    RA_S2 = -2,     -- 2 Signed bytes,   -32768..32767
		    --                   (-#8000..#7FFF)
    RA_U2 = -3,     -- 2 Unsigned bytes, 0..65535
		    --                   (#0..#FFFF)
    RA_S3 = -4,     -- 3 Signed bytes,   -8388608..8388607
		    --                   (-#800000..#7FFFFF)
    RA_U3 = -5,     -- 3 Unsigned bytes, 0..16777215
		    --                   (#0..#FFFFFF)
    RA_S4 = -6,     -- 4 Signed bytes,   -2147483648..2147483647
		    --                   (-#80000000..#7FFFFFFF)
    RA_U4 = -7,     -- 4 Unsigned bytes, 0..4294967295
		    --                   (#0..#FFFFFFFF)
    RA_S5 = -8,     -- 5 Signed bytes,   -549755813888..549755813887
		    --                   (-#8000000000..#7FFFFFFFFF)
    RA_U5 = -9,     -- 5 Unsigned bytes, 0..1099511627775
		    --                   (#0..#FFFFFFFFFF)
    RA_S6 = -10,    -- 6 Signed bytes,   -140737488355328..140737488355327
		    --                   (-#800000000000..#7FFFFFFFFFFF)
    RA_U6 = -11,    -- 6 Unsigned bytes, 0..281474976710655
		    --                   (#0..#FFFFFFFFFFFF)

    RA_R4 = -12,    -- 4 Real number bytes, 7 significant digits
    RA_R8 = -13     -- 8 Real number bytes, 16 significant digits



-- PURPOSE: open a file for random access
-- NOTE:    you should close the file using ra_close()
-- DETAILS: path is file to open (will be created if not exists);
--          fields defines the types and the order of fields in a record, see
--          global constants above for field types
-- RETURN:  integer; random access file number, or -1 if failed to open/create
-- EXAMPLE: fn = ra_open("balance.dat", {RA_U1, RA_U1, 30, RA_R4, RA_R4})
global function ra_open(sequence path, sequence fields)
    integer fn, len, f, id

    -- if file not exists then create it
    fn = open(path, "rb")
    if fn = FAIL then
	fn = open(path, "wb")
    end if

    -- open binary file for update (for random-access)
    if fn != FAIL then
	close(fn)
	fn = open(path, "ub")
    end if

    -- failed to create or open file
    if fn = FAIL then
	return FAIL
    end if

    -- calculate record length according to fields list
    len = 0
    for i = 1 to length(fields) do
	f = fields[i]
	if not integer(f) or f < RA_R8 or f > MAX_STR then
	    crash(UNSUPPORTED_FIELD_TYPE, {sprintf("%g", f)})
	elsif f >= MIN_STR then
	    len += f
	elsif f >= RA_U1 then
	    len += 1
	elsif f >= RA_U2 then
	    len += 2
	elsif f >= RA_U3 then
	    len += 3
	elsif f >= RA_U4 then
	    len += 4
	elsif f >= RA_U5 then
	    len += 5
	elsif f >= RA_U6 then
	    len += 6
	elsif f = RA_R4 then
	    len += 4
	elsif f = RA_R8 then
	    len += 8
	end if
    end for

    -- must be one or more fields in a record
    if not len then
	crash(UNSUPPORTED_FIELD_TYPE, {"{}"})
    end if

    -- file number must be already closed for random access, using ra_close()
    id = find(fn, files_number)

    -- append file properties to lists of opened files
    if not id then
	files_number &= fn
	files_reclen &= len
	files_fields = append(files_fields, fields)
	return fn
    else
	-- file were closed using close() - you must use ra_close()!
	crash(FILE_NUMBER_IS_OPEN, fn)
    end if
end function



-- PURPOSE: close a random access file
-- NOTE:    you should *not* close the file using close() directly
-- DETAILS: fn is random access file number returned by ra_open()
-- EXAMPLE: ra_close(fn)
global procedure ra_close(integer fn)
    integer id

    -- file number must be already open to be closed
    id = find(fn, files_number)

    -- close file and remove its entry from lists of open-files
    if id then
	close(fn)
	files_number = files_number[1..id - 1] & files_number[id + 1..$]
	files_reclen = files_reclen[1..id - 1] & files_reclen[id + 1..$]
	files_fields = files_fields[1..id - 1] & files_fields[id + 1..$]
    end if
end procedure



-- PURPOSE: return the length of record in a random access file
-- DETAILS: fn is random access file number returned by ra_open()
-- RETURN:  integer; record length as calculated by ra_open()
-- EXAMPLE: i = ra_length(fn)
global function ra_length(integer fn)
    integer id

    -- file number must be already open
    id = find(fn, files_number)

    -- return the length of a record
    if id then
	return files_reclen[id]
    else
	crash(FILE_NUMBER_IS_NOT_OPEN, fn)
    end if
end function



--bookmark: Put/Get Record;

-- PURPOSE: put a record in a random access file
-- DETAILS: fn is random access file number returned by ra_open()
--          index is the record's serial-number, 1 is first
--          v is a sequence of values, according to ra_open() fields
-- EXAMPLE: ra_put(fn, 7, {5, 12, "New shirt", 0, 10.99})  -- put record 7
global procedure ra_put(integer fn, integer index, sequence v)
    integer id, f
    sequence r

    -- file number must be already open for put/get record
    id = find(fn, files_number)

    -- crash?
    if not id then
	crash(FILE_NUMBER_IS_NOT_OPEN, fn)
    elsif index < 1 then
	crash(SEEK_TO_RECORD_FAILED, index)
    elsif seek(fn, (index - 1) * files_reclen[id]) then
	crash(SEEK_TO_RECORD_FAILED, index)
    elsif length(v) != length(files_fields[id]) then
	crash(WRONG_NUMBER_OF_VALUES, {length(v), length(files_fields[id])})
    end if

    -- initialize record-string
    r = EMPTY

    -- convert sequence of values to record-string
    for i = 1 to length(v) do
	f = files_fields[id][i]             -- f is field type

	if f >= MIN_STR then
	    if length(v[i]) < f then        -- right-pad string with spaces
		r &= v[i] & repeat(32, f - length(v[i]))
	    else
		r &= v[i][1..f]
	    end if
	elsif f >= RA_U1 then               -- convert integers/atoms to bytes
	    r &= remainder(floor(v[i]), SH1)
	elsif f >= RA_U2 then
	    r &= remainder(floor(v[i] / SHIFT_BYTE[1..2]), SH1)
	elsif f >= RA_U3 then
	    r &= remainder(floor(v[i] / SHIFT_BYTE[1..3]), SH1)
	elsif f >= RA_U4 then
	    r &= remainder(floor(v[i] / SHIFT_BYTE[1..4]), SH1)
	elsif f >= RA_U5 then
	    r &= remainder(floor(v[i] / SHIFT_BYTE[1..5]), SH1)
	elsif f >= RA_U6 then
	    r &= remainder(floor(v[i] / SHIFT_BYTE), SH1)
	elsif f = RA_R4 then                -- convert real numbers to bytes
	    r &= atom_to_float32(v[i])
	elsif f = RA_R8 then
	    r &= atom_to_float64(v[i])
	end if
    end for

    -- put record-string in file
    puts(fn, r)
end procedure



-- PURPOSE: get a record from a random access file
-- DETAILS: fn is random access file number returned by ra_open()
--          index is the record's serial-number, 1 is first
-- RETURN:  object; sequence of values, according to ra_open() fields, or
--                  -1 at the end of file.
-- EXAMPLE: x = ra_get(fn, 7)  -- get record 7
constant
    -- poke()/peek4u() is faster for 4 bytes value
    MEM = allocate(4)
global function ra_get(integer fn, integer index)
    integer id, f, p
    sequence r, v

    -- file number must be already open for put/get record
    id = find(fn, files_number)

    -- crash?
    if not id then
	crash(FILE_NUMBER_IS_NOT_OPEN, fn)
    elsif index < 1 then
	crash(SEEK_TO_RECORD_FAILED, index)
    elsif seek(fn, (index - 1) * files_reclen[id]) then
	crash(SEEK_TO_RECORD_FAILED, index)
    end if

    -- get record-string
    r = repeat(0, files_reclen[id])
    for i = 1 to length(r) do
	r[i] = getc(fn)
    end for

    -- return -1 at end of file
    if r[$] = FAIL then
	return FAIL
    end if

    -- initialize values sequence, and position in record-string
    v = repeat(0, length(files_fields[id]))
    p = 1

    -- convert record-string to sequence of values
    for i = 1 to length(v) do
	f = files_fields[id][i]             -- f is field type

	if f >= MIN_STR then                -- get string value
	    v[i] = r[p..p + f - 1]
	    p += f
	elsif f >= RA_U1 then               -- convert bytes to integers
	    v[i] = r[p]
	    if f = RA_S1 and v[i] > MAX_S1 then
		v[i] -= SH1                 -- negative signed integer
	    end if
	    p += 1
	elsif f >= RA_U2 then
	    v[i] = r[p] + r[p + 1] * SH1
	    if f = RA_S2 and v[i] > MAX_S2 then
		v[i] -= SH2
	    end if
	    p += 2
	elsif f >= RA_U3 then
	    v[i] = r[p] + r[p + 1] * SH1 + r[p + 2] * SH2
	    if f = RA_S3 and v[i] > MAX_S3 then
		v[i] -= SH3
	    end if
	    p += 3
	elsif f >= RA_U4 then
	    poke(MEM, r[p..p + 3])
	    if f = RA_S4 then
		v[i] = peek4s(MEM)
	    else -- f = RA_U4
		v[i] = peek4u(MEM)
	    end if
	    p += 4
	elsif f >= RA_U5 then
	    poke(MEM, r[p..p + 3])
	    v[i] = peek4u(MEM) + r[p + 4] * SH4
	    if f = RA_S5 and v[i] > MAX_S5 then
		v[i] -= SH5
	    end if
	    p += 5
	elsif f >= RA_U6 then
	    poke(MEM, r[p..p + 3])
	    v[i] = peek4u(MEM) + r[p + 4] * SH4 + r[p + 5] * SH5
	    if f = RA_S6 and v[i] > MAX_S6 then
		v[i] -= SH6
	    end if
	    p += 6
	elsif f = RA_R4 then                -- convert bytes to real numbers
	    v[i] = float32_to_atom(r[p..p + 3])
	    p += 4
	elsif f = RA_R8 then
	    v[i] = float64_to_atom(r[p..p + 7])
	    p += 8
	end if
    end for

    -- return sequence of values
    return v
end function



-- End of file.
