-- diagforth.lua: interpreting the words in "%D" lines in dednat5 files.
-- This file:
--   http://angg.twu.net/dednat5/diagforth.lua.html
--   http://angg.twu.net/dednat5/diagforth.lua
--                    (find-dn5 "diagforth.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011may13
-- License: GPL3
--


-- (find-blogme4 "eval.lua" "parse_pattern")
-- (find-angg "LUA/lua50init.lua" "untabify")
-- (find-blogme4 "eval.lua" "readvword")



-- «.metastack»		(to "metastack")
-- «.diag-head»		(to "diag-head")
-- «.diagram»		(to "diagram")
-- «.enddiagram»	(to "enddiagram")
-- «.nodes»		(to "nodes")
-- «.2D-and-2Dx»	(to "2D-and-2Dx")

-- «.run»		(to "run")
-- «.forths»		(to "forths")

require "diagtex"   -- (find-dn5 "diagtex.lua")
require "parse"     -- (find-dn5 "parse.lua")
require "process"   -- (find-dn5 "process.lua")
require "errors"    -- (find-dn5 "errors.lua")


forths = {}


-- «metastack»  (to ".metastack")
-- (find-dn5 "diagstacks.lua" "MetaStack")
forths["(("] = function () depths:ppush() end
forths["))"] = function () depths:ppop() end
forths["@"] = function () ds:push(depths:metapick(1 + getwordasluaexpr())) end



-- «run»  (to ".run")

-- «diag-head»  (to ".diag-head")
-- (find-dn5file "segments.lua" "tosegments =")
dxyrun = function (str, pos)
    setsubj(str, pos or 1)
    while getword() do
      -- PP(word)
      if    forths[word] then forths[word]()
      elseif nodes[word] then ds:push(nodes[word])
      else Error("Unknown word: "..word)
      end
    end
  end

registerhead "%D" {
  action = function ()
      dxyrun(untabify(linestr), 3)
    end,
}



-- «diagram»  (to ".diagram")
-- «enddiagram»  (to ".enddiagram")
forths["diagram"] = function ()
    diagramname = getword() or derror("No diagram name")
    xys = {}
    nodes = {}
    arrows = {}
    lasty = nil
  end
forths["enddiagram"] = function ()
    output(arrows_to_defdiag(diagramname, " % no hyperlink yet"))
  end



-- «2D-and-2Dx»  (to ".2D-and-2Dx")
-- (find-dn4file "dednat4.lua" "dxy2Dx =")
torelativenumber = function (prevn, str)
    local sign, strn = str:match("^([-+]?)([0-9.]+)$")
    if not sign then return end           -- fail
    local n = tonumber(strn)
    if sign == "" then return n end
    if sign == "+" then return prevn + n else return prev - n end
  end

dxy2Dx = function ()
    xs = {}
    local lastx = nil
    while getword() do
      local n = torelativenumber(lastx, word)
      if n then
        xs[startcol] = n
        lastx = n
      end
    end
  end
forths["2Dx"] = dxy2Dx

firstxin = function (s, e)
    for i=s,e do if xs[i] then return xs[i] end end
  end
dxy2Ddo = function (y, word)
    if word == "#" then getrestofline(); return end
    local x = firstxin(startcol, endcol-1)
    if not x then return end
    storenode {x=x, y=y, tag=word}
  end
dxy2D = function ()
    if not getword() then return end
    thisy = torelativenumber(lasty, word)
    if not thisy then getrestofline(); return end
    while getword() do dxy2Ddo(thisy, word) end
    lasty = thisy
  end
forths["2D"]  = dxy2D



-- «forths»  (to ".forths")
forths["#"] = function () getrestofline() end

-- «nodes»  (to ".nodes")
forths["node:"] = function ()
    local x,y = getwordasluaexpr()
    local tag = getword()
    ds:push(storenode {x=x, y=y, tag=tag})
  end
forths[".tex="] = function () ds:pick(0).tex = getword() or werror() end
forths[".TeX="] = function () ds:pick(0).TeX = getword() or werror() end

-- (find-dn4 "dednat4.lua" "diag-arrows")
forths[".p="] = function () ds:pick(0).placement = getword() or werror() end
forths[".slide="] = function () ds:pick(0).slide = getword() or werror() end
forths[".curve="] = function () ds:pick(0).curve = getword() or werror() end
forths[".label="] = function () ds:pick(0).label = getword() or werror() end
forths[".plabel="] = function ()
    ds:pick(0).placement = getword() or error()
    ds:pick(0).label     = getword() or error()
  end

pusharrow = function (shape)
    local from, to = ds:pick(1), ds:pick(0)
    ds:push(storearrow(DxyArrow {from=from.noden, to=to.noden, shape=shape}))
  end

forths["->"] = function () pusharrow("->") end
forths["=>"] = function () pusharrow("=>") end
forths[".>"] = function () pusharrow(".>") end
forths[":>"] = function () pusharrow(":>") end
forths["|.>"] = function () pusharrow("|.>") end
forths["-->"] = function () pusharrow("-->") end
forths["==>"] = function () pusharrow("==>") end
forths["|->"] = function () pusharrow("|->") end
forths["`->"] = function () pusharrow("^{ (}->") end
forths["<-"]   = function () pusharrow("<-") end
forths["<-|"]  = function () pusharrow("<-|") end
forths["<--"]  = function () pusharrow("<--") end

forths["sl^^"] = function () ds:pick(0).slide =    "5pt" end
forths["sl^"]  = function () ds:pick(0).slide =  "2.5pt" end
forths["sl_"]  = function () ds:pick(0).slide = "-2.5pt" end
forths["sl__"] = function () ds:pick(0).slide =   "-5pt" end

defarrows = function (bigstr)
    for _,spec in ipairs(split(bigstr)) do
      forths[spec] = function () pusharrow(spec) end
    end
  end

forths["place"] = function ()
    ds:push(storearrow(DxyPlace {ds:pick(0)}))
  end
forths["loop"] = function ()
    ds:push(storearrow(DxyLoop {ds:pick(0), dTeX=getword()}))
  end


-- dump-to: tests
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
require "diagforth"
forths["PP"] = function () PP(getwordasluaexpr()) end
run = dxyrun
run [[ 2Dx     100     +20 ]]
run [[ 2D 100 a,b <=== a   ]]
run [[ 2D      -       -   ]]
run [[ 2D      |  <->  |   ]]
run [[ 2D      v       v   ]]
run [[ 2D +20  c ==> b|->c ]]
PP(xs)
PP(lasty)
PP(nodes)
run [[ (( a,b a c b|->c    ]]
PP(ds:pick(0))
PP(depths)
PP(depths:metapick(0))
PP(depths:metapick(1))
PP(depths:metapick(2))

run [[    @ 1 @ 0 =>       ]]
print(arrows_to_defdiag("foo"))


* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
require "diagforth"
forths["PP"] = function () PP(getwordasluaexpr()) end
run [[ node: 110,120 a    ]]
run [[ (( node: 120,130 b ]]
run [[    =>   a b |->    ]]
print(arrows_to_TeX())
run [[    PP ds         ]]
run [[ ))               ]]
run [[ PP ds            ]]
PP(ds)
PP(depths)
print(arrows_to_TeX())
print(arrows_to_defdiag("foo"))
run [[ )) ]]

--]==]



-- dump-to: tests
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
require "diagforth"
storenode {TeX="a", tag="a", x=100, y=100}
storenode {TeX="b", tag="b", x=140, y=100}
PP(nodes)
PP(nodes["a"])
PP(nodes[1])
PP(nodes["b"])
PP(nodes[2])
storearrow(DxyArrow {from="a", to="b", shape="|->",
                     slide="5pt", label="up", placement="a"})
storearrow(DxyArrow {from="a", to="b", shape=".>"})
storearrow(DxyPlace {nodes["a"]})
storearrow(DxyLiteral {"literal foobar"})
-- (find-dn5 "diags.lua")
PP(arrows)
print(arrow_to_TeX(arrows[1]))
print(arrows[2]:TeX())
print(arrows[3]:TeX())
print(arrows[4]:TeX())
print(arrows_to_TeX())

--]==]

-- Local Variables:
-- coding:             raw-text-unix
-- ee-anchor-format:   "«%s»"
-- End: