Warning: this is an htmlized version! The original is across this link, and the conversion rules are here.
```-- Experimental features for diagxy

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

asluaexpr = function (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
```