path: root/tex/context/base/mkxl/mlib-lmp.lmt

if not modules then modules = { } end modules ['mlib-lmp'] = {
    version   = 1.001,
    comment   = "companion to mlib-ctx.mkiv",
    author    = "Hans Hagen, PRAGMA-ADE, Hasselt NL",
    copyright = "PRAGMA ADE / ConTeXt Development Team",
    license   = "see context related readme files",
}

-- path relates stuff ... todo: use a stack (or numeric index to list)

local type, tonumber, tostring = type, tonumber, tostring
local find, match = string.find, string.match
local insert, remove, sort = table.insert, table.remove, table.sort

local aux            = mp.aux
local mpnumeric      = aux.numeric
local mppair         = aux.pair

local registerdirect = metapost.registerdirect
local registerscript = metapost.registerscript

local scan           = mp.scan
local skip           = mp.skip
local get            = mp.get
local inject         = mp.inject

local scannumber     = scan.number
local scanstring     = scan.string
local scaninteger    = scan.integer
local scannumeric    = scan.numeric
local scanwhatever   = scan.whatever
local scanpath       = scan.path
local scanproperty   = scan.property

local gethashentry   = get.hashentry

local bpfactor       = number.dimenfactors.bp

local injectwhatever = inject.whatever
local injectboolean  = inject.boolean
local injectnumeric  = inject.numeric
local injectstring   = inject.string
local injectpair     = inject.pair
local injectpath     = inject.path

local injectwhd      = inject.whd -- scaled
local injectxy       = inject.xy
local injectpt       = inject.pt

local report         = logs.reporter("metapost", "log")
local report_message = logs.reporter("metapost")

local codes          = metapost.codes
local types          = metapost.types
local procodes       = mplib.propertycodes

local implement      = interfaces.implement

do

    local function s(a,b)
        local aa = a[1]
        local bb = b[1]
        if aa == bb then
            aa = a[2]
            bb = b[2]
        end
        return aa < bb
    end

    registerscript("sortedpath", function()
        local p = scanpath()
        for i=1,#p do
            local pi = p[i]
            p[i] = { pi[1], pi[2] }
        end
        sort(p,s)
        injectpath(p)
    end)

    registerscript("uniquepath", function()
        local p = scanpath()
        local u = { }
        local n = 0
        local xx = nil
        local yy = nil
        sort(p,s)
        for i=1,#p do
            local pi = p[i]
            local x = pi[1]
            local y = pi[2]
            if x ~= xx or y ~= yy then
                n = n + 1
                u[n] = { x, y }
                xx = x
                yy = y
            end
        end
        injectpath(u)
    end)

end

do

    local p = nil
    local n = 0

    registerscript("pathreset", function()
        p = nil
        n = 0
    end)

    registerdirect("pathlengthof", function()
        p = scanpath()
        n = p and #p or 1
        return n
    end)

    registerdirect("pathpointof", function()
        local i = scaninteger()
        if i > 0 and i <= n then
            local pi = p[i]
            injectpair(pi[1],pi[2])
        end
    end)

    registerdirect("pathleftof", function()
        local i = scaninteger()
        if i > 0 and i <= n then
            local pi = p[i]
            injectpair(pi[5],pi[6])
        end
    end)

    registerdirect("pathrightof", function()
        local i = scaninteger()
        if i > 0 and i <= n then
            local pn
            if i == 1 then
                pn = p[2] or p[1]
            else
                pn = p[i+1] or p[1]
            end
            injectpair(pn[3],pn[4])
        end
    end)

end

registerscript("showproperty", function()
    local k, s, p, d = scanproperty()
    if k then
        report("name %a, property %a, command %a, detail %a",s,procodes[p] or "-",codes[k] or "-",types[d] or "-")
    end
end)

registerscript("showhashentry", function()
    local s = scanstring()
    if s then
        local k, p, d = gethashentry(s)
        if k then
            report("name %a, property %a, command %a, detail %a",s,procodes[p] or "-",codes[k] or "-",types[d] or "-")
        end
    end
end)

-- local getmacro      = tokens.getters.macro
-- local mpgnamespace  = getmacro("??graphicvariable")

-- registerscript("mpv_numeric",   function() injectnumeric  (getmacro(mpgnamespace .. getmacro("currentmpcategory") .. ":" .. scanmpstring())) end)
-- registerscript("mpv_dimension", function() return getmacro(mpgnamespace .. getmacro("currentmpcategory") .. ":" .. scanmpstring()) end)
-- registerscript("mpv_string",    function() injectstring   (getmacro(mpgnamespace .. getmacro("currentmpcategory") .. ":" .. scanmpstring())) end)

-- registerscript("mpvar", function() return getmacro(mpgnamespace .. getmacro("currentmpcategory") .. ":" .. scanmpstring(), true) end) -- Isn't it already edef'd?
-- registerscript("mpvar", function() return getmacro(metapost.namespace .. scanmpstring(), true) end) -- Isn't it already edef'd?

do

    local expandtex       = mp.expandtex

    local tokenvalues     = tokens.values
    local dimension_value = tokenvalues.dimension
    local integer_value   = tokenvalues.integer
    local boolean_value   = tokenvalues.boolean
    local string_value    = tokenvalues.string
    local unknown_value   = tokenvalues.none

    registerdirect("mpvard", function()
        if not expandtex(dimension_value,"mpcategoryparameter",true,scanstring()) then
            injectnumeric(0)
        end
    end)

    registerdirect("mpvarn", function()
        if not expandtex(integer_value,"mpcategoryparameter",true,scanstring()) then
            injectnumeric(0)
        end
    end)

    registerdirect("mpvars", function()
        if not expandtex(string_value,"mpcategoryparameter",true,scanstring()) then
            injectstring("")
        end
    end)

    registerdirect("mpvarb", function()
        if not expandtex(boolean_value,"mpcategoryparameter",true,scanstring()) then
            injectboolean(false)
        end
    end)

    registerdirect("mpvar", function()
        if not expandtex(unknown_value,"mpcategoryparameter",true,scanstring()) then
            injectnumeric(0)
        end
    end)

    --

    local mpprint  = mp.print
    local mpquoted = mp.quoted
    local getmacro = tokens.getters.macro

    registerscript("texvar", function() mpprint (getmacro(metapost.namespace .. scanstring())) end)
    registerscript("texstr", function() mpquoted(getmacro(metapost.namespace .. scanstring())) end)

end

do

    registerscript("textextanchor", function()
        local x, y = match(scanstring(),"tx_anchor=(%S+) (%S+)") -- todo: make an lpeg
        if x and y then
            x = tonumber(x)
            y = tonumber(y)
        end
        injectpair(x or 0,y or 0)
    end)

end

do

    local mpnamedcolor = attributes.colors.mpnamedcolor
    local mpprint      = mp.aux.print

    mp.mf_named_color = function(str)
        mpprint(mpnamedcolor(str))
    end

    -- todo: we can inject but currently we always get a string back so then
    -- we need to deal with it upstream in the color module ... not now

    registerscript("namedcolor",function() mpprint(mpnamedcolor(scanstring())) end)

end

do

    local hashes = table.setmetatableindex("table")

    -- There is no need to 'new' a hash in which case one can use any reasonable
    -- tag. The registry aproach is mkiv compatible.

    local registery = { }

 -- registerdirect("lmt_hash_new", function()
 --  -- local name  = scanstring()
 --     local name  = scanwhatever()
 --     hashes[name] = { }
 -- end)

    registerdirect("lmt_hash_new", function()
        for i=1,#registry + 1 do
            if not registry[i] then
                registry[i] = { }
                injectwhatever(i)
            end
        end
    end)

    registerdirect("lmt_hash_dispose", function()
     -- local name  = scanstring()
        local name  = scanwhatever()
        hashes[name] = nil
        -- when new'd
        if registry[name] then
            registry[name] = false
        end
    end)

    registerdirect("lmt_hash_in", function()
     -- local name  = scanstring()
        local name  = scanwhatever()
     -- local key   = scanstring()
        local key   = scanwhatever()
        local hash  = hashes[name]
        injectwhatever(hash and hash[key] and true or false)
    end)

    registerdirect("lmt_hash_to", function()
     -- local name  = scanstring()
        local name  = scanwhatever()
     -- local key   = scanstring()
        local key   = scanwhatever()
        local value = scanwhatever()
        local hash  = hashes[name]
        if hash then
            hash[key] = value
        end
    end)

    registerdirect("lmt_hash_from", function()
     -- local name  = scanstring()
        local name  = scanwhatever()
     -- local key  = scanstring()
        local key  = scanwhatever()
        local hash = hashes[name]
        injectwhatever(hash and hash[key] or false)
    end)

    interfaces.implement {
        name      = "MPfromhash",
        arguments = "2 strings",
        actions   = function(name,key)
            local hash = hashes[name] or hashes[tonumber(name)] or hashes[tostring(name)]
            if hash then
                local v = hash[key]
                if v then
                    context(v)
                end
            end
        end
    }

end

do

    local bpfactor     = number.dimenfactors.bp
    local nbdimensions = nodes.boxes.dimensions

    registerdirect("boxdimensions", function()
        local category = scanstring()
        local index    = scanwhatever()
        injectwhd(nbdimensions(category,index))
    end)

end

do

    local skiptoken      = skip.token

    local comma_code     = codes.comma

    local getmacro       = tokens.getters.macro
    local setmacro       = tokens.setters.macro

    local getdimen       = tex.getdimen
    local getcount       = tex.getcount
    local gettoks        = tex.gettoks
    local setdimen       = tex.setdimen
    local setcount       = tex.setcount
    local settoks        = tex.settoks

    -- more helpers

    registerdirect("getmacro", function() return getmacro(scanstring()) end)
    registerdirect("getcount", function() return getcount(scanwhatever()) end)
    registerdirect("gettoks",  function() return gettoks (scanwhatever()) end)
    registerdirect("getdimen", function() return getdimen(scanwhatever()) * bpfactor end)

    registerscript("setmacro", function() setmacro(scanstring(),scanstring()) end)
    registerscript("setdimen", function() setdimen(scanwhatever(),scannumeric()/bpfactor) end)
    registerscript("setcount", function() setcount(scanwhatever(),scannumeric()) end)
    registerscript("settoks",  function() settoks (scanwhatever(),scanstring()) end)

    registerscript("setglobalmacro", function() setmacro(scanstring(),scanstring(),"global") end)
    registerscript("setglobaldimen", function() setdimen("global",scanwhatever(),scannumeric()/bpfactor) end)
    registerscript("setglobalcount", function() setcount("global",scanwhatever(),scaninteger()) end)
    registerscript("setglobaltoks",  function() settoks ("global",scanwhatever(),scanstring()) end)

    local utfnum = utf.byte
    local utflen = utf.len
    local utfsub = utf.sub

    registerdirect("utfnum", function() return utfnum(scanstring()) end)
    registerdirect("utflen", function() return utflen(scanstring()) end)

    registerdirect("utfsub", function() -- we have an optional third argument so we explicitly scan a text argument
        return utfsub(scanstring(),skiptoken(comma_code) and scannumeric(),skiptoken(comma_code) and scannumeric())
    end)

    local setlogging = metapost.setlogging

    registerscript("message", function()
        setlogging(false)
        local str = scanstring()
        setlogging(true)
        report_message("message : %s",str)
    end)

end

-- position fun

do

    local getcount       = tex.getcount

    local mpprint        = mp.print
    local mpfprint       = mp.fprint

    local mpscaninteger  = mp.scan.integer
    local mpscannumber   = mp.scan.number

    local jobpositions   = job.positions
    local getwhd         = jobpositions.whd
    local getxy          = jobpositions.xy
    local getx           = jobpositions.x
    local gety           = jobpositions.y
    local getposition    = jobpositions.position
    local getpage        = jobpositions.page
    local getparagraph   = jobpositions.paragraph
    local getregion      = jobpositions.region
    local getcolumn      = jobpositions.column
    local getmacro       = tokens.getters.macro

    local columnofpos    = jobpositions.columnofpos
    local getcolumndata  = jobpositions.getcolumndata
 -- local overlapping    = jobpositions.overlapping
 -- local onsamepage     = jobpositions.onsamepage
 -- local columnofpos    = jobpositions.columnofpos

    -- why not inject path directly

    registerscript("positionpath", function()
        local w, h, d = getwhd(scanstring())
        if w then
            mpfprint("((%p,%p)--(%p,%p)--(%p,%p)--(%p,%p)--cycle)",0,-d,w,-d,w,h,0,h)
        else
            mpprint("(origin--cycle)")
        end
    end)

    registerscript("positioncurve", function()
        local w, h, d = getwhd(scanstring())
        if w then
            mpfprint("((%p,%p)..(%p,%p)..(%p,%p)..(%p,%p)..cycle)",0,-d,w,-d,w,h,0,h)
        else
            mpprint("(origin--cycle)")
        end
    end)

    registerscript("positionbox", function()
        local p, x, y, w, h, d = getposition(scanstring())
        if p then
            mpfprint("((%p,%p)--(%p,%p)--(%p,%p)--(%p,%p)--cycle)",x,y-d,x+w,y-d,x+w,y+h,x,y+h)
        else
            mpprint("(%p,%p)--cycle",x or 0,y or 0)
        end
    end)

    registerscript("positioncolumnbox", function()
        local column = mpscaninteger()
        local data   = getcolumndata(getcount("realpageno"),column)
        if data then
            local x, y, w, h, d = data.x, data.y, data.w, data.h, data.d
            mpfprint("((%p,%p)--(%p,%p)--(%p,%p)--(%p,%p)--cycle)",x,y-d,x+w,y-d,x+w,y+h,x,y+h)
        else
            mpprint("(0,0)--cycle")
        end
    end)

    registerscript("overlaycolumnbox", function()
        local column = mpscaninteger()
        local data   = getcolumndata(getcount("realpageno"),column)
        if data then
            local w, hd = data.w, data.h + data.d
            mpfprint("((0,0)--(%p,0)--(%p,%p)--(0,%p)--cycle)",w,w,hd,hd)
        else
            mpprint("(0,0)--cycle")
        end
    end)

    registerdirect("positionpage",      function() return getpage     (scanstring()) or 0 end)
    registerdirect("positioncolumn",    function() return getcolumn   (scanstring()) or 0 end)
    registerdirect("positionparagraph", function() return getparagraph(scanstring()) or 0 end)
    registerdirect("positionregion",    function() return getregion   (scanstring()) or "unknown" end)
    registerdirect("positionanchor",    function() return getmacro    ("MPanchorid") end)
    registerdirect("positionwhd",       function() injectwhd(getwhd(scanstring())) end)
    registerdirect("positionxy",        function() injectxy (getxy (scanstring())) end)
    registerdirect("positionx",         function() injectpt (getx  (scanstring())) end)
    registerdirect("positiony",         function() injectpt (gety  (scanstring())) end)

    registerdirect("positioncolumnatx", function()
        local realpage  = mpscaninteger()
        local xposition = mpscannumber()
        return columnofpos(realpage,xposition)
    end)

end

do

    local modes       = tex.modes
    local systemmodes = tex.systemmodes

    registerdirect("mode",       function() injectboolean(modes      [scanstring()] and true or false) end)
    registerdirect("systemmode", function() injectboolean(systemmodes[scanstring()] and true or false) end)

    -- for compatibility reasons we keep this (metafun manual):

    local modes       = tex.modes
    local systemmodes = tex.systemmodes

    function mp.mode(s)
        injectboolean(modes[s] and true or false)
    end

    function mp.systemmode(s)
        injectboolean(systemmodes[s] and true or false)
    end

    mp.processingmode = mp.mode

end

-- for alan's nodes:

do

    local lpegmatch, lpegpatterns, P = lpeg.match, lpeg.patterns, lpeg.P

    -- todo: scansuffix / why no return boolean (first one)

    registerdirect("isarray", function()
         injectboolean(find(scanstring(),"%d") and true or false)
    end)

    registerdirect("prefix", function()
        local str = scanstring()
        return match(str,"^(.-)[%d%[]") or str
    end)

    local dimension = lpeg.counter(P("[") * lpegpatterns.integer * P("]") + lpegpatterns.integer)

    registerdirect("dimension", function() return dimension(scanstring()) end)

    -- todo : share with mlib-pps.lua metapost,isobject

    -- registerdirect("isobject", function()
    --     injectboolean(find(scanstring(),"mf_object="))
    -- end

    local p1      = P("mf_object=")
    local p2      = lpegpatterns.eol * p1
    local pattern = (1-p2)^0 * p2 + p1

    registerdirect("isobject", function()
        local str = scanstring()
        injectboolean(pattern and str ~= "" and lpegmatch(pattern,str))
    end)

end

-- key/values (moved here, old mechanism)

do

    local stack, top = { }, nil

    local function setvariable(k,v)
        if top then
            top[k] = v
        else
            metapost.variables[k] = v
        end
    end

    local function pushvariable(k)
        local t = { }
        if top then
            insert(stack,top)
            top[k] = t
        else
            metapost.variables[k] = t
        end
        top = t
    end

    local function popvariable()
        top = remove(stack)
    end

    registerscript("passvariable", function() setvariable (scanstring(), scanwhatever()) end)
    registerscript("pushvariable", function() pushvariable(scanstring()) end)
    registerscript("popvariable",  function() popvariable () end)

    local stack = { }

    local function pushvariables()
        insert(stack,metapost.variables)
        metapost.variables = { }
    end

    local function popvariables()
        metapost.variables = remove(stack) or metapost.variables
    end

    metapost.setvariable   = setvariable
    metapost.pushvariable  = pushvariable
    metapost.popvariable   = popvariable
    metapost.pushvariables = pushvariables
    metapost.popvariables  = popvariables

    implement {
        name      = "mppushvariables",
        actions   = pushvariables,
    }

    implement {
        name      = "mppopvariables",
        actions   = popvariables,
    }

end

do

    local repeatable = utilities.randomizer.repeatable

    registerdirect("repeatablerandom", function()
        return repeatable(scanstring())
    end)

end