-- FILE:     COMPRESS.E
-- PURPOSE:  Compress/Decompress file routines for Euphoria 3.1.1.
-- AUTHOR:   - Based on the program LZSS.C by Haruhiko Okumura, 1989;
--           - Ported to Euphoria by Mic, 2000 (RapidEuphoria.com archive).
--           - Big speed improvements by Matt Lewis, 2003;
--           - Integrated into Lib2 by Shian Lee, 2021.
-- VERSION:  1.01  December/23/2021
-- LANGUAGE: Euphoria version 3.1.1 (http://www.RapidEuphoria.com)
-- PLATFORM: Any
-- LICENCE:  Free. Use at your own risk.
-- NOTE:     * Using implementation of the Lempel-Ziv-Storer-Szymanski (LZSS)
--             algorithm. (Yet not recognized by standard utilities).
--           * If you're interested in how it works, you could probably find the
--             algorithm at programmersheaven.com or Wikipedia. Or look for
--             LZSS encoder-decoder by Haruhiko Okumura (C; public domain).
--           * Euphoria is slower then C - don't expect high compression speed.
--           * Some files cannot be compressed efficiently - it's normal.
--           * An archive can be decompressed later on any platform.
--           * See the attached reference manuals FILE2.DOC.
--           * Created using EDU 3.01 on Linux (RapidEuphoria311.com archive).
-- HISTORY:  v1.01 - initial Lib2 version (December/19/2021).
------------------------------------------------------------------------------



--bookmark: Local Constants;

constant FALSE = 0,
	 TRUE = not FALSE,
	 FAIL = -1,     -- -1 is common for all file I/O errors
	 BLANK = 32     -- ' ' blank character


constant N = 4096,      -- N is max sliding window size
	 NM1 = N - 1,   -- (N Minus 1) subtract faster out of loop (Matt)
	 EIGHTEEN = 18,
	 THRESHOLD = 2

-- for a bit faster initializing tree in compress_file()
constant RSON_INIT = repeat(N, 256),
	 DAD_INIT = repeat(N, N + 1),
	 CODE_BUF_INIT = repeat(0, 17)



--bookmark: Local Variables;

sequence txt_buf
    txt_buf = repeat(0, N + EIGHTEEN - 1)

sequence dad, lson, rson    -- dad, left-son(?), right-son(?) - shian
    dad = repeat(0, N + 1)
    lson = dad
    rson = repeat(0, N + 257)

integer match_pos, match_len

integer fn_in, fn_out   -- input, output file numbers



--bookmark: Local Routines;

-- PURPOSE: used by compress_file() inside loops
-- DETAILS: (wasn't documented).
-- NOTE:    code optimized by Matt Lewis 5/21/03, compression +/- 40% faster
integer pos, cmp, len, k, p -- insert_node() private vars (define once faster)
procedure insert_node(integer key)

    k = key + 1
    pos = N + 1 + txt_buf[k]
    p = pos + 1

    rson[k] = N
    lson[k] = N
    cmp = 1
    match_len = 0

    while TRUE do
	if cmp >= 0 then
	    if rson[p] != N then
		pos = rson[p]
		p = pos + 1
	    else
		rson[p] = key
		dad[k] = pos
		return
	    end if
	else
	    if lson[p] != N then
		pos = lson[p]
		p = pos + 1
	    else
		lson[p] = key
		dad[k] = pos
		return
	    end if
	end if

	-- Optimization:
	--  if..then is faster then loop (Matt)
	--  "if cmp" instead of "if cpm != 0" (Matt)
	--  faster to check if k = p (Mic)
	if k = p then
	  len = 18
	else
	  cmp = txt_buf[k + 1] - txt_buf[p + 1]
	  if cmp then
	    len = 1
	  else
	    cmp = txt_buf[k + 2] - txt_buf[p + 2]
	    if cmp then
	      len = 2
	    else
	      cmp = txt_buf[k + 3] - txt_buf[p + 3]
	      if cmp then
		len = 3
	      else
		cmp = txt_buf[k + 4] - txt_buf[p + 4]
		if cmp then
		  len = 4
		else
		  cmp = txt_buf[k + 5] - txt_buf[p + 5]
		  if cmp then
		    len = 5
		  else
		    cmp = txt_buf[k + 6] - txt_buf[p + 6]
		    if cmp then
		      len = 6
		    else
		      cmp = txt_buf[k + 7] - txt_buf[p + 7]
		      if cmp then
			len = 7
		      else
			cmp = txt_buf[k + 8] - txt_buf[p + 8]
			if cmp then
			  len = 8
			else
			  cmp = txt_buf[k + 9] - txt_buf[p + 9]
			  if cmp then
			    len = 9
			  else
			    cmp = txt_buf[k + 10] - txt_buf[p + 10]
			    if cmp then
			      len = 10
			    else
			      cmp = txt_buf[k + 11] - txt_buf[p + 11]
			      if cmp then
				len = 11
			      else
				cmp = txt_buf[k + 12] - txt_buf[p + 12]
				if cmp then
				  len = 12
				else
				  cmp = txt_buf[k + 13] - txt_buf[p + 13]
				  if cmp then
				    len = 13
				  else
				    cmp = txt_buf[k + 14] - txt_buf[p + 14]
				    if cmp then
				      len = 14
				    else
				      cmp = txt_buf[k + 15] - txt_buf[p + 15]
				      if cmp then
					len = 15
				      else
					cmp = txt_buf[k + 16] - txt_buf[p + 16]
					if cmp then
					  len = 16
					else
					  cmp = txt_buf[k + 17] - txt_buf[p + 17]
					  if cmp then
					    len = 17
					  else
					    len = 18
					  end if
					end if
				      end if
				    end if
				  end if
				end if
			      end if
			    end if
			  end if
			end if
		      end if
		    end if
		  end if
		end if
	      end if
	    end if
	  end if
	end if

	if len > match_len then
	    match_pos = pos
	    match_len = len
	    if len = EIGHTEEN then
		exit
	    end if
	end if
    end while

    dad[k] = dad[p]
    lson[k] = lson[p]
    rson[k] = rson[p]

    dad[lson[p] + 1] = key
    dad[rson[p] + 1] = key

    k = dad[p] + 1
    if rson[k] = pos then
	rson[k] = key
    else
	lson[k] = key
    end if

    dad[p] = N
end procedure



-- PURPOSE: used by compress_file() inside loops
-- DETAILS: (wasn't documented).
integer c, c1 -- delete_node() private variables (define once faster)
procedure delete_node(integer p)

    p += 1

    if dad[p] = N then
	return
    end if

    if rson[p] = N then
	c = lson[p]
	c1 = c + 1
    elsif lson[p] = N then
	c = rson[p]
	c1 = c + 1
    else
	c = lson[p]
	c1 = c + 1

	if rson[c1] != N then
	    while rson[c1] != N do
		c = rson[c1]
		c1 = c + 1
	    end while
	    rson[dad[c1] + 1] = lson[c1]
	    dad[lson[c1] + 1] = dad[c1]
	    lson[c1] = lson[p]
	    dad[lson[p] + 1] = c
	end if

	rson[c1] = rson[p]
	dad[rson[p] + 1] = c
    end if


    dad[c1] = dad[p]

    c1 = dad[p] + 1
    if rson[c1] = (p - 1) then
	rson[c1] = c
    else
	lson[c1] = c
    end if

    dad[p] = N
end procedure



--bookmark: Global Routines;

-- PURPOSE: compress a file
-- DETAILS: source is a file pathname to compress
--          dest is the output file pathname (will be overwritten)
-- RETURN:  atom; 0/compression-ratio-in-percent (error/success)
-- EXAMPLE: a = compress_file("c:\\euphoria\\readme.doc", "readme.lzs")
global function compress_file(sequence source, sequence dest)
    integer c, len, pos, r, rp1, s, sp1
    integer last_match_len, code_buf_ptr, mask
    sequence code_buf
    atom txt_size, code_size

    fn_in = open(source, "rb")
    if fn_in = FAIL then
	return FALSE
    else
	fn_out = open(dest, "wb")
	if fn_out = FAIL then
	    close(fn_in)
	    return FALSE
	end if
    end if

    -- initialize tree
    rson[N + 2..N + 257] = RSON_INIT
    dad = DAD_INIT

    code_buf = CODE_BUF_INIT

    code_buf_ptr = 1
    mask = 1
    s = 0
    sp1 = 1
    r = N - EIGHTEEN
    rp1 = r + 1

    txt_buf[1..r] = repeat(BLANK, r)
    len = 0

    while len < EIGHTEEN do
	c = getc(fn_in)
	if c = -1 then
	    exit
	end if
	txt_buf[rp1 + len] = c
	len += 1
    end while

    if not len then
	close(fn_in)
	close(fn_out)
	return FALSE -- zero length input - nothing to compress
    end if

    txt_size = len
    code_size = 0

    for i = 1 to EIGHTEEN do
	insert_node(r - i)
    end for
    insert_node(r)

    while len do
	if match_len > len then
	    match_len = len
	end if
	if match_len <= THRESHOLD then
	    match_len = 1
	    code_buf[1] = or_bits(code_buf[1], mask)
	    code_buf_ptr += 1
	    code_buf[code_buf_ptr] = txt_buf[rp1]
	else
	    code_buf_ptr += 1
	    code_buf[code_buf_ptr] = and_bits(match_pos, #FF)
	    code_buf_ptr += 1
	    code_buf[code_buf_ptr] = and_bits(or_bits(
					and_bits(floor(match_pos / #10), #F0),
					match_len - (THRESHOLD + 1)), #FF)
	end if

	mask += mask
	if mask > 255 then
	    puts(fn_out, code_buf[1..code_buf_ptr])
	    code_size += code_buf_ptr
	    code_buf[1] = 0
	    code_buf_ptr = 1
	    mask = 1
	end if

	last_match_len = match_len
	pos = last_match_len

	for i = 1 to last_match_len do
	    c = getc(fn_in)
	    if c = -1 then
		pos = i - 1
		exit
	    end if
	    delete_node(s)

	    txt_buf[sp1] = c
	    if sp1 < EIGHTEEN then
		txt_buf[sp1 + N] = c
	    end if

	    s = and_bits(sp1, NM1)
	    sp1 = s + 1
	    r = and_bits(rp1, NM1)
	    rp1 = r + 1

	    insert_node(r)
	end for

	txt_size += pos

	while pos < last_match_len do
	    delete_node(s)
	    s = sp1
	    if s > NM1 then
		s -= N
	    end if
	    sp1 = s + 1
	    r = rp1
	    if r > NM1 then
		r -= N
	    end if
	    rp1 = r + 1
	    len -= 1
	    if len then
		insert_node(r)
	    end if
	    pos += 1
	end while
    end while

    if code_buf_ptr > 1 then
	puts(fn_out, code_buf[1..code_buf_ptr])
	code_size += code_buf_ptr
    end if

    close(fn_in)
    close(fn_out)

    -- success, return compression ratio in %
    return (1.0 - (code_size / txt_size)) * 100
end function



-- PURPOSE: decompress a file
-- DETAILS: source is a file pathname previously compressed by compress_file()
--          dest is the output file pathname (will be overwritten)
-- RETURN:  boolean; FALSE/TRUE (error/success)
-- EXAMPLE: i = decompress_file("readme.lzs", "c:\\euphoria\\readme.doc")
global function decompress_file(sequence source, sequence dest)
    integer c, c2, c3, pos, flags, idx

    fn_in = open(source, "rb")
    if fn_in = FAIL then
	return FALSE
    else
	fn_out = open(dest, "wb")
	if fn_out = FAIL then
	    close(fn_in)
	    return FALSE
	end if
    end if

    pos = N - EIGHTEEN
    flags = 0
    txt_buf[1..pos] = repeat(BLANK, pos)

    while TRUE do
	flags = floor(flags / 2)

	if not and_bits(flags, #100) then
	    c = getc(fn_in)
	    if c = -1 then
		exit
	    end if
	    flags = c + #FF00
	end if

	if and_bits(flags, 1) then
	    c = getc(fn_in)
	    if c = -1 then
		exit
	    end if

	    puts(fn_out, c)
	    pos += 1
	    txt_buf[pos] = c
	    if pos > NM1 then
		pos -= N
	    end if
	else
	    c2 = getc(fn_in)
	    if c2 = -1 then
		exit
	    end if

	    c3 = getc(fn_in)
	    if c3 = -1 then
		exit
	    end if

	    c2 = or_bits(c2, and_bits(c3, #F0) * #10)
	    c3 = and_bits(c3, #0F) + THRESHOLD
	    idx = and_bits(c2, N - 1) + 1

	    while c3 >= 0 do
		c = txt_buf[idx]
		puts(fn_out, c)
		pos += 1
		txt_buf[pos] = c

		if pos > NM1 then
		    pos = 0
		end if

		idx += 1
		if idx > N then
		    idx = 1
		end if
		c3 -= 1
	    end while
	end if
    end while

    close(fn_in)
    close(fn_out)
    return TRUE -- success
end function



-- End of file.
