if not modules then modules = { } end modules ['mlib-mpf'] = { 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", } -- moved from mlib-lua: local type, tostring, tonumber, select, loadstring = type, tostring, tonumber, select, loadstring local find, gsub = string.find, string.gsub local concat = table.concat local formatters = string.formatters local lpegmatch = lpeg.match local lpegpatterns = lpeg.patterns local P, S, Ct, Cs, Cc, C = lpeg.P, lpeg.S, lpeg.Ct, lpeg.Cs, lpeg.Cc, lpeg.C local report_luarun = logs.reporter("metapost","lua") local report_script = logs.reporter("metapost","script") local report_message = logs.reporter("metapost") local trace_luarun = false trackers.register("metapost.lua", function(v) trace_luarun = v end) local trace_script = false trackers.register("metapost.script",function(v) trace_script = v end) local be_tolerant = true directives.register("metapost.lua.tolerant", function(v) be_tolerant = v end) local set = mp.set local get = mp.get local aux = mp.aux local scan = mp.scan do -- serializers local f_integer = formatters["%i"] local f_numeric = formatters["%F"] -- no %n as that can produce -e notation and that is not so nice for scaled but maybe we -- should then switch between ... i.e. make a push/pop for the formatters here ... not now. local f_integer = formatters["%i"] local f_numeric = formatters["%F"] local f_pair = formatters["(%F,%F)"] local f_ctrl = formatters["(%F,%F) .. controls (%F,%F) and (%F,%F)"] local f_triplet = formatters["(%F,%F,%F)"] local f_quadruple = formatters["(%F,%F,%F,%F)"] local f_transform = formatters["totransform(%F,%F,%F,%F,%F,%F)"] local f_pen = formatters["(pencircle transformed totransform(%F,%F,%F,%F,%F,%F))"] local f_points = formatters["%p"] local f_pair_pt = formatters["(%p,%p)"] local f_ctrl_pt = formatters["(%p,%p) .. controls (%p,%p) and (%p,%p)"] local f_triplet_pt = formatters["(%p,%p,%p)"] local f_quadruple_pt = formatters["(%p,%p,%p,%p)"] local r = P('%') / "percent" + P('"') / "dquote" + P('\n') / "crlf" -- + P(' ') / "space" local a = Cc("&") local q = Cc('"') local p = Cs(q * (r * a)^-1 * (a * r * (P(-1) + a) + P(1))^0 * q) mp.cleaned = function(s) return lpegmatch(p,s) or s end -- management -- sometimes we gain (e.g. .5 sec on the sync test) local cache = table.makeweak() local runscripts = { } local runnames = { } local runmodes = { } local nofscripts = 0 local function registerscript(name,mode,f) nofscripts = nofscripts + 1 if not f then f = mode mode = "buffered" end if f then runscripts[nofscripts] = f runnames[name] = nofscripts else runscripts[nofscripts] = name end runmodes[nofscripts] = mode if trace_script then report_script("registering %s script %a as %i",mode,name,nofscripts) end return nofscripts end metapost.registerscript = registerscript function metapost.registerdirect(name,f) registerscript(name,"direct",f) end function metapost.registertokens(name,f) registerscript(name,"tokens",f) end function metapost.scriptindex(name) local index = runnames[name] or 0 if trace_script then report_script("fetching scriptindex %i of %a",index,name) end return index end -- The gbuffer sharing and such is not really needed now but make a dent when -- we have a high volume of simpel calls (loops) so we keep it around for a -- while. local nesting = 0 local runs = 0 local gbuffer = { } local buffer = gbuffer local n = 0 local function mpdirect(a) n = n + 1 buffer[n] = a end local function mpflush(separator) buffer[1] = concat(buffer,separator or "",1,n) n = 1 end function metapost.getbuffer() local b = { } for i=1,n do b[i] = buffer end return b, n end function metapost.setbuffer(b, s) n = 0 for i=1,(s or #b) do local bi = b[i] if bi then n = n + 1 buffer[n] = tostring(bi) end end end function metapost.runscript(code) nesting = nesting + 1 runs = runs + 1 local index = type(code) == "number" local f local result if index then f = runscripts[code] if not f then report_luarun("%i: bad index: %s",nesting,code) elseif trace_luarun then report_luarun("%i: index: %i",nesting,code) end local m = runmodes[code] if m == "direct" then result = f() if trace_luarun then report_luarun("%i: direct: %a",nesting,type(result)) end nesting = nesting - 1 return result, true -- string and tables as string and objects elseif m == "tokens" then result = f() if trace_luarun then report_luarun("%i: tokens: %a",nesting,type(result)) end nesting = nesting - 1 return result -- string and tables as text to be scanned else if trace_luarun then report_luarun("%i: no mode",nesting) end end else if trace_luarun then report_luarun("%i: code: %s",nesting,code) end f = cache[code] if not f then f = loadstring("return " .. code) if f then cache[code] = f elseif be_tolerant then f = loadstring(code) if f then cache[code] = f end end end end -- returning nil is more efficient and a signal not to scan in mp if f then local lbuffer, ln if nesting == 1 then buffer = gbuffer n = 0 else lbuffer = buffer ln = n buffer = { } n = 0 end result = f() if result then local t = type(result) -- we can consider to use the injector for tables but then we need to -- check if concatination is expected so best keep this! if t == "number" or t == "boolean" then -- native types elseif t == "string" or t == "table" then -- (concatenated) passed to scantokens else -- scantokens result = tostring(result) end if trace_luarun then report_luarun("%i: %s result: %s",nesting,t,result) end elseif n == 0 then -- result = "" result = nil -- no scantokens done then if trace_luarun then report_luarun("%i: no buffered result",nesting) end elseif n == 1 then result = buffer[1] if trace_luarun then report_luarun("%i: 1 buffered result: %s",nesting,result) end else -- the space is why we sometimes have collectors if nesting == 1 then -- if we had no space we could pass result directly in lmtx result = concat(buffer," ",1,n) if n > 500 or #result > 10000 then gbuffer = { } -- newtable(20,0) lbuffer = gbuffer end else -- if we had no space we could pass result directly in lmtx result = concat(buffer," ") end if trace_luarun then report_luarun("%i: %i buffered results: %s",nesting,n,result) end end if nesting == 1 then n = 0 else buffer = lbuffer n = ln end else report_luarun("%i: no result, invalid code: %s",nesting,code) result = "" end nesting = nesting - 1 return result end function metapost.nofscriptruns() local c = mplib.getcallbackstate() return c.count, string.format( "%s (file: %s, text: %s, script: %s, log: %s)", c.count, c.file, c.text, c.script, c.log ) end -- writers local function rawmpp(value) n = n + 1 local t = type(value) if t == "number" then buffer[n] = f_numeric(value) elseif t == "string" then buffer[n] = value elseif t == "table" then if #t == 6 then buffer[n] = "totransform(" .. concat(value,",") .. ")" else buffer[n] = "(" .. concat(value,",") .. ")" end else -- boolean or whatever buffer[n] = tostring(value) end end local function mpprint(first,second,...) if second == nil then if first ~= nil then rawmpp(first) end else for i=1,select("#",first,second,...) do local value = (select(i,first,second,...)) if value ~= nil then rawmpp(value) end end end end local function mpp(value) n = n + 1 local t = type(value) if t == "number" then buffer[n] = f_numeric(value) elseif t == "string" then buffer[n] = lpegmatch(p,value) elseif t == "table" then if #t > 4 then buffer[n] = "" else buffer[n] = "(" .. concat(value,",") .. ")" end else -- boolean or whatever buffer[n] = tostring(value) end end local function mpvprint(first,second,...) -- variable print if second == nil then if first ~= nil then mpp(first) end else for i=1,select("#",first,second,...) do local value = (select(i,first,second,...)) if value ~= nil then mpp(value) end end end end local function mpstring(value) n = n + 1 buffer[n] = lpegmatch(p,value) end local function mpboolean(b) n = n + 1 buffer[n] = b and "true" or "false" end local function mpnumeric(f) n = n + 1 if not f or f == 0 then buffer[n] = "0" else buffer[n] = f_numeric(f) end end local function mpinteger(i) n = n + 1 -- buffer[n] = i and f_integer(i) or "0" buffer[n] = i or "0" end local function mppoints(i) n = n + 1 if not i or i == 0 then buffer[n] = "0pt" else buffer[n] = f_points(i) end end local function mppair(x,y) n = n + 1 if type(x) == "table" then buffer[n] = f_pair(x[1],x[2]) else buffer[n] = f_pair(x,y or x) end end local function mppairpoints(x,y) n = n + 1 if type(x) == "table" then buffer[n] = f_pair_pt(x[1],x[2]) else buffer[n] = f_pair_pt(x,y or x) end end local function mptriplet(x,y,z) n = n + 1 if type(x) == "table" then buffer[n] = f_triplet(x[1],x[2],x[3]) else buffer[n] = f_triplet(x,y,z) end end local function mptripletpoints(x,y,z) n = n + 1 if type(x) == "table" then buffer[n] = f_triplet_pt(x[1],x[2],x[3]) else buffer[n] = f_triplet_pt(x,y,z) end end local function mpquadruple(w,x,y,z) n = n + 1 if type(w) == "table" then buffer[n] = f_quadruple(w[1],w[2],w[3],w[4]) else buffer[n] = f_quadruple(w,x,y,z) end end local function mpquadruplepoints(w,x,y,z) n = n + 1 if type(w) == "table" then buffer[n] = f_quadruple_pt(w[1],w[2],w[3],w[4]) else buffer[n] = f_quadruple_pt(w,x,y,z) end end local function mptransform(x,y,xx,xy,yx,yy) n = n + 1 if type(x) == "table" then buffer[n] = f_transform(x[1],x[2],x[3],x[4],x[5],x[6]) else buffer[n] = f_transform(x,y,xx,xy,yx,yy) end end local function mpcolor(c,m,y,k) n = n + 1 if type(c) == "table" then local l = #c if l == 4 then buffer[n] = f_quadruple(c[1],c[2],c[3],c[4]) elseif l == 3 then buffer[n] = f_triplet(c[1],c[2],c[3]) else buffer[n] = f_numeric(c[1]) end else if k then buffer[n] = f_quadruple(c,m,y,k) elseif y then buffer[n] = f_triplet(c,m,y) else buffer[n] = f_numeric(c) end end end -- we have three kind of connectors: -- -- .. ... -- (true) local function mp_path(f2,f6,t,connector,cycle) if type(t) == "table" then local tn = #t if tn == 1 then local t1 = t[1] n = n + 1 if t.pen then buffer[n] = f_pen(unpack(t1)) else buffer[n] = f2(t1[1],t1[2]) end elseif tn > 0 then if connector == true or connector == nil then connector = ".." elseif connector == false then connector = "--" end if cycle == nil then cycle = t.cycle if cycle == nil then cycle = true end end local six = connector == ".." -- otherwise we use whatever gets asked for local controls = connector -- whatever local a = t[1] local b = t[2] n = n + 1 buffer[n] = "(" n = n + 1 if six and #a == 6 and #b == 6 then buffer[n] = f6(a[1],a[2],a[5],a[6],b[3],b[4]) controls = ".." else buffer[n] = f2(a[1],a[2]) controls = connector end for i=2,tn-1 do a = b b = t[i+1] n = n + 1 buffer[n] = connector n = n + 1 if six and #a == 6 and #b == 6 then buffer[n] = f6(a[1],a[2],a[5],a[6],b[3],b[4]) controls = ".." else buffer[n] = f2(a[1],a[2]) controls = connector end end n = n + 1 buffer[n] = connector a = b b = t[1] n = n + 1 if cycle then if six and #a == 6 and #b == 6 then buffer[n] = f6(a[1],a[2],a[5],a[6],b[3],b[4]) controls = ".." else buffer[n] = f2(a[1],a[2]) controls = connector end n = n + 1 buffer[n] = connector n = n + 1 buffer[n] = "cycle" else buffer[n] = f2(a[1],a[2]) end n = n + 1 buffer[n] = ")" end end end local function mppath(...) mp_path(f_pair,f_ctrl,...) end local function mppathpoints(...) mp_path(f_pair_pt,f_ctrl_pt,...) end local function mpsize(t) n = n + 1 buffer[n] = type(t) == "table" and f_numeric(#t) or "0" end local replacer = lpeg.replacer("@","%%") local function mpfprint(fmt,...) n = n + 1 if not find(fmt,"%",1,true) then fmt = lpegmatch(replacer,fmt) end buffer[n] = formatters[fmt](...) end local function mpquoted(fmt,s,...) if s then n = n + 1 if not find(fmt,"%",1,true) then fmt = lpegmatch(replacer,fmt) end -- buffer[n] = '"' .. formatters[fmt](s,...) .. '"' buffer[n] = lpegmatch(p,formatters[fmt](s,...)) elseif fmt then n = n + 1 -- buffer[n] = '"' .. fmt .. '"' buffer[n] = lpegmatch(p,fmt) else -- something is wrong end end aux.direct = mpdirect aux.flush = mpflush aux.print = mpprint aux.vprint = mpvprint aux.boolean = mpboolean aux.string = mpstring aux.numeric = mpnumeric aux.number = mpnumeric aux.integer = mpinteger aux.points = mppoints aux.pair = mppair aux.pairpoints = mppairpoints aux.triplet = mptriplet aux.tripletpoints = mptripletpoints aux.quadruple = mpquadruple aux.quadruplepoints = mpquadruplepoints aux.path = mppath aux.pathpoints = mppathpoints aux.size = mpsize aux.fprint = mpfprint aux.quoted = mpquoted aux.transform = mptransform aux.color = mpcolor -- for the moment local function mpdraw(lines,list) -- n * 4 if list then local c = #lines for i=1,c do local ci = lines[i] local ni = #ci n = n + 1 buffer[n] = i < c and "d(" or "D(" for j=1,ni,2 do local l = j + 1 n = n + 1 buffer[n] = ci[j] n = n + 1 buffer[n] = "," n = n + 1 buffer[n] = ci[l] n = n + 1 buffer[n] = l < ni and ")--(" or ");" end end else local l = #lines local m = l - 4 for i=1,l,4 do n = n + 1 buffer[n] = i < m and "d(" or "D(" n = n + 1 buffer[n] = lines[i] n = n + 1 buffer[n] = "," n = n + 1 buffer[n] = lines[i+1] n = n + 1 buffer[n] = ")--(" n = n + 1 buffer[n] = lines[i+2] n = n + 1 buffer[n] = "," n = n + 1 buffer[n] = lines[i+3] n = n + 1 buffer[n] = ");" end end end local function mpfill(lines,list) if list then local c = #lines for i=1,c do local ci = lines[i] local ni = #ci n = n + 1 buffer[n] = i < c and "f(" or "F(" for j=1,ni,2 do local l = j + 1 n = n + 1 buffer[n] = ci[j] n = n + 1 buffer[n] = "," n = n + 1 buffer[n] = ci[l] n = n + 1 buffer[n] = l < ni and ")--(" or ")--C;" end end else local l = #lines local m = l - 4 for i=1,l,4 do n = n + 1 buffer[n] = i < m and "f(" or "F(" n = n + 1 buffer[n] = lines[i] n = n + 1 buffer[n] = "," n = n + 1 buffer[n] = lines[i+1] n = n + 1 buffer[n] = ")--(" n = n + 1 buffer[n] = lines[i+2] n = n + 1 buffer[n] = "," n = n + 1 buffer[n] = lines[i+3] n = n + 1 buffer[n] = ")--C;" end end end aux.draw = mpdraw aux.fill = mpfill for k, v in next, aux do mp[k] = v end -- mp.print = table.setmetatablecall(aux, function(t,...) -- mpprint(...) -- end) mp.print = table.setmetatablecall(aux, function(t,first,second,...) if second == nil then if first ~= nil then rawmpp(first) end else for i=1,select("#",first,second,...) do local value = (select(i,first,second,...)) if value ~= nil then rawmpp(value) end end end end) end do local mpnumeric = mp.numeric local scanstring = scan.string local scriptindex = metapost.scriptindex function mp.mf_script_index(name) local index = scriptindex(name) -- report_script("method %i, name %a, index %i",1,name,index) mpnumeric(index) end -- once bootstrapped ... (needs pushed mpx instances) metapost.registerdirect("scriptindex",function() return scriptindex(scanstring()) end) end function mp.n(t) -- used ? return type(t) == "table" and #t or 0 end do -- experiment: names can change local mppath = aux.path local mpsize = aux.size local whitespace = lpegpatterns.whitespace local newline = lpegpatterns.newline local setsep = newline^2 local comment = (S("#%") + P("--")) * (1-newline)^0 * (whitespace - setsep)^0 local value = (1-whitespace)^1 / tonumber local entry = Ct( value * whitespace * value) local set = Ct((entry * (whitespace-setsep)^0 * comment^0)^1) local series = Ct((set * whitespace^0)^1) local pattern = whitespace^0 * series local datasets = { } mp.datasets = datasets function mp.dataset(str) return lpegmatch(pattern,str) end function datasets.load(tag,filename) if not filename then tag, filename = file.basename(tag), tag end local data = lpegmatch(pattern,io.loaddata(filename) or "") datasets[tag] = { data = data, line = function(n) mppath(data[n or 1]) end, size = function() mpsize(data) end, } end table.setmetatablecall(datasets,function(t,k,f,...) local d = datasets[k] local t = type(d) if t == "table" then d = d[f] if type(d) == "function" then d(...) else mpvprint(...) end elseif t == "function" then d(f,...) end end) end -- \startluacode -- local str = [[ -- 10 20 20 20 -- 30 40 40 60 -- 50 10 -- -- 10 10 20 30 -- 30 50 40 50 -- 50 20 -- the last one -- -- 10 20 % comment -- 20 10 -- 30 40 # comment -- 40 20 -- 50 10 -- ]] -- -- MP.myset = mp.dataset(str) -- -- inspect(MP.myset) -- \stopluacode -- -- \startMPpage -- color c[] ; c[1] := red ; c[2] := green ; c[3] := blue ; -- for i=1 upto lua("mp.print(mp.n(MP.myset))") : -- draw lua("mp.path(MP.myset[" & decimal i & "])") withcolor c[i] ; -- endfor ; -- \stopMPpage -- texts: function mp.report(a,b,c,...) if c then report_message("%s : %s",a,formatters[(gsub(b,"@","%%"))](c,...)) elseif b then report_message("%s : %s",a,b) elseif a then report_message("message : %s",a) end end function mp.flatten(t) local tn = #t local t1 = t[1] local t2 = t[2] local t3 = t[3] local t4 = t[4] for i=1,tn-5,2 do local t5 = t[i+4] local t6 = t[i+5] if t1 == t3 and t3 == t5 and ((t2 <= t4 and t4 <= t6) or (t6 <= t4 and t4 <= t2)) then t[i+3] = t2 t4 = t2 t[i] = false t[i+1] = false elseif t2 == t4 and t4 == t6 and ((t1 <= t3 and t3 <= t5) or (t5 <= t3 and t3 <= t1)) then t[i+2] = t1 t3 = t1 t[i] = false t[i+1] = false end t1 = t3 t2 = t4 t3 = t5 t4 = t6 end -- remove duplicates local t1 = t[1] local t2 = t[2] for i=1,tn-2,2 do local t3 = t[i+2] local t4 = t[i+3] if t1 == t3 and t2 == t4 then t[i] = false t[i+1] = false end t1 = t3 t2 = t4 end -- move coordinates local m = 0 for i=1,tn,2 do if t[i] then m = m + 1 t[m] = t[i] m = m + 1 t[m] = t[i+1] end end -- prune the table (not gc'd) for i=tn,m+1,-1 do t[i] = nil end -- safeguard so that we have at least one segment if m == 2 then t[3] = t[1] t[4] = t[2] end end