-- Experimental features for diagxy

require "diagxy.lua"	-- (find-anchor "diagxy.lua")

asluaexpr = function (str)
    return assert(loadstring("return "..str))()
  end
getwordasluaexpr = function () return asluaexpr(getword()) end

forths["midpoint"] = function ()
    local node1, node2 = ds[2], ds[1]
    local midx, midy = (node1.x + node2.x)/2, (node1.y + node2.y)/2
    ds[2] = storenode{x=midx, y=midy, TeX="\\phantom{O}"}
    dspop()
  end

splitdist = function (x1, x2, dx0, dx1, dx2)
    local dx = x2-x1
    local rest = dx-(dx0 or 0)-(dx1 or 0)-(dx2 or 0)
    local type = (dx0 and "n" or "_")..(dx1 and "n" or "_")..
                 (dx2 and "n" or "_")
    if type=="_n_" then
      return x1+rest/2, x2-rest/2
    elseif type=="n_n" then
      return x1+dx0, x2-dx2
    elseif type=="nn_" then
      return x1+dx0+rest/2, x2-rest/2
    elseif type=="_nn" then
      return x1+rest/2, x2-dx2-rest/2
    end
    local p = function (n) return n or "nil" end
    print("Bad splitdist pattern: "..p(dx0).." "..p(dx1).." "..p(dx2))
  end

forths["harrownodes"] = function ()
    local node1, node2 = ds[2], ds[1]
    local midy = (node1.y + node2.y)/2
    local dx0 = getwordasluaexpr()
    local dx1 = getwordasluaexpr()
    local dx2 = getwordasluaexpr()
    local x1, x2 = splitdist(node1.x, node2.x, dx0, dx1, dx2)
    dspush(storenode{x=x1, y=midy, TeX="\\phantom{O}"})
    dspush(storenode{x=x2, y=midy, TeX="\\phantom{O}"})
  end

forths["varrownodes"] = function ()
    local node1, node2 = ds[2], ds[1]
    local midx = (node1.x + node2.x)/2
    local dy0 = getwordasluaexpr()
    local dy1 = getwordasluaexpr()
    local dy2 = getwordasluaexpr()
    local y1, y2 = splitdist(node1.y, node2.y, dy0, dy1, dy2)
    dspush(storenode{x=midx, y=y1, TeX="\\phantom{O}"})
    dspush(storenode{x=midx, y=y2, TeX="\\phantom{O}"})
  end

placetoTeX = function (arrow)
    local node = arrow.from
    return format("\\place(%d,%d)[{%s}]", realx(node.x), realy(node.y),
        node.TeX)
  end
forths["place"] = function ()
    storearrow {special=placetoTeX, from=ds[1]}
  end

emitTeX = function (arrow)
    return arrow.TeX
  end
forths["emit\""] = function ()
    storearrow {special=emitTeX, TeX=getuntilquote()}
  end

forths[".plabel="] = function ()
    ds[1].placement = getword()
    ds[1].label = getword()
  end

forths["@"] = function ()
    dspush(ds[table.getn(ds) - depths[1] - getwordasluaexpr()])
  end

forths["aliases"] = function ()
    local n = getwordasluaexpr()
    for dep = n,1,-1 do nodes[getword()] = ds[dep] end
  end