sequence lc
sequence uc
constant Win_Western_lc = "abcdefghijklmnopqrstuvwxyz" & 
                          "šœžÿãäåæçèéêëìíîïðñòóôõöøùúûüýþ" & #E0 & #E1 & #E2
constant Win_Western_uc = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & 
                          "ŠŒŽŸÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ" & #C0 & #C1 & #C2

--/topic Support Routines
--/proc SetCase(sequence pLower, sequence pUpper, integer pLastCodePoint)
--/desc Defines the mapping from uppercase to lower case, and visa versa
--/i pLower is a set of integers representing the lowercase characters. /n
--/i pUpper is a set of integers representing the corresponding uppercase characters. /n
--/i pLastCodePoint is the highest code point value in the character set. This
-- is 255 (#FF) for Windows Western character set, which is the default set. If
-- this is supplied as -1 then the existing mappings are retained and the
-- new mappings repesented in /i pLower and /i pUpper overlay the existing
-- ones. 
--
--Example:
--/code
--      -- Set to strict ASCII characters
--      SetCase("abcdefghijklmnopqrstuvwxyz", 
--              "ABCDEFGHIJKLMNOPQRSTUVWXYZ",
--              #7F)
--      -- Add Windows Western extensions
--      SetCase("šœžÿãäåæçèéêëìíîïðñòóôõöøùúûüýþ" & #E0 & #E1 & #E2,  
--              "ŠŒŽŸÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ" & #C0 & #C1 & #C2,
--              -1)
--      -- Turn off all case conversions.
--      SetCase("","", 255)
--/endcode

global procedure SetCase(sequence pLower, sequence pUpper, integer pLastCodePoint)
    integer lUChar
    integer lLChar

    if pLastCodePoint >= 0 then
        -- Reset the case mappings.
        lc = repeat(0, pLastCodePoint+1)
        for i = 1 to pLastCodePoint+1 do
            lc[i] = i-1
        end for
        uc = lc
    else
        -- Extend the mapping sequences if needed.
        lUChar = 0
        for i = 1 to length(pLower) do
            if pLower[i] > lUChar then
                lUChar = pLower[i]
            end if
        end for
        for i = 1 to length(pUpper) do
            if pUpper[i] > lUChar then
                lUChar = pUpper[i]
            end if
        end for
        lUChar += 1
        lLChar = length(lc)
        if lUChar > lLChar then
            lc &= repeat(0, lUChar - lLChar)
            uc &= repeat(0, lUChar - lLChar)
        end if
        for i = lLChar + 1 to lUChar do
            lc[i] = i - 1
            uc[i] = i - 1
        end for
    end if
    
    for i = 1 to length(pLower) do
        lLChar = pLower[i]
        lUChar = pUpper[i]
        lc[pUpper[i]+1] = pLower[i]
        uc[pLower[i]+1] = pUpper[i]
    end for
end procedure


--/topic Support Routines
--/func w32upper(object Text)
--/desc returns the supplied text converted to uppercase
--/ret SEQEUENCE: Uppercase version of /i Text
--This function assumes that /i Text is either a single character (integer)
-- or a sequence containing only characters. Each character must be a
-- member of the current character set as defined by /SetCase, which
-- by default is the Windows Western character code set.
--
--Note that the default character set handles most European languages.
--
--Example:
--/code
--  sequence UC
--  UC = w32upper("Orvillé Stœber")
--  -- gives "ORVILLÉ STŒBER"
--/endcode
global function w32upper(object x)
    if integer(x) then
            x = uc[x+1]
    elsif sequence(x) then
        for i = 1 to length(x) do
            x[i] = uc[x[i]+1]
        end for        
    end if
    return x
end function

--/topic Support Routines
--/func w32lower(object Text)
--/desc returns the supplied text converted to lowercase
--/ret SEQEUENCE: Lowercase version of /i Text
--This function assumes that /i Text is either a single character (integer)
-- or a sequence containing only characters. Each character must be a
-- member of the current character set as defined by /SetCase, which
-- by default is the Windows Western character code set.
--
--Note that the default character set handles most European languages.
--
--Example:
--/code
--  sequence LC
--  LC = w32lower("ORVILLÉ STŒBER")
--  -- gives "orvillé stœber"
--/endcode
global function w32lower(object x)
    if integer(x) then
            x = lc[x+1]
    elsif sequence(x) then
        for i = 1 to length(x) do
            x[i] = lc[x[i]+1]
        end for        
    end if
    return x
end function

    
--/topic Support Routines
--/func Obj_upper(object Data)
--/desc returns the supplied Data converted to uppercase
--/ret SEQEUENCE: Uppercase version of /i Data
--This function, unlike /w32upper, allows /i Data to contain anything, including
-- nested sequences. Whenever this function encounters a character defined
-- by /SetCase, it is replaced by its uppercase equivalent. Atoms which
-- are not in the character set are returned unchanged.
--
--Note that the default character set handles most European languages.
--
--Example:
--/code
--  sequence UC
--  UC = Obj_upper({"Derek", "Pärnell", 17.56} )
--  -- gives {"DEREK", "PÄRNELL", 17.56}
--/endcode
global function Obj_upper(object x)
    if integer(x) then
        if x >= 0 and x < length(uc) then
            x = uc[x+1]
        end if
    elsif sequence(x) then
        for i = 1 to length(x) do
            if integer(x[i]) then
                if x[i] >= 0 and x[i] < length(uc) then
                    x[i] = uc[x[i]+1]
                end if
            elsif sequence(x) then
                x[i] = Obj_upper(x[i])
            end if
        end for        
    end if
    return x
end function

--/topic Support Routines
--/func Obj_lower(object Data)
--/desc returns the supplied Data converted to lowercase.
--/ret SEQEUENCE: Lowercase version of /i Data
--This function, unlike /w32lower, allows /i Data to contain anything, including
-- nested sequences. Whenever this function encounters a character defined
-- by /SetCase, it is replaced by its lowercase equivalent. Atoms which
-- are not in the character set are returned unchanged.
--
--Note that the default character set handles most European languages.
--
--Example:
--/code
--  sequence LC
--  LC = Obj_lower({"Ðerek", "Parnell", 17.56} )
--  -- gives {"ðerek", "parnell", 17.56}
--/endcode
global function Obj_lower(object x)
    if integer(x) then
        if x >= 0 and x < length(lc) then
            x = lc[x+1]
        end if
    elsif sequence(x) then
        for i = 1 to length(x) do
            if integer(x[i]) then
                if x[i] >= 0 and x[i] < length(lc) then
                    x[i] = lc[x[i]+1]
                end if
            elsif sequence(x) then
                x[i] = Obj_lower(x[i])
            end if
        end for
    end if
    return x
end function

-- Initially set up the Windows Western character mappings.
SetCase(Win_Western_lc, Win_Western_uc, #FF)