-- diagforth.lua: interpreting the words in "%D" lines in dednat6 files.
-- This file:
--   http://angg.twu.net/dednat6/dednat6/diagforth.lua.html
--   http://angg.twu.net/dednat6/dednat6/diagforth.lua
--           (find-angg "dednat6/dednat6/diagforth.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2021feb26
-- 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")
-- «.BOX»		(to "BOX")
-- «.nodes»		(to "nodes")
-- «.arrow-modifiers»	(to "arrow-modifiers")
-- «.dxyren»		(to "dxyren")
-- «.arrows»		(to "arrows")
-- «.2D-and-2Dx»	(to "2D-and-2Dx")

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

-- «.relplace»		(to "relplace")
-- «.newnode:at:»	(to "newnode:at:")

-- «.high-level-tests»	(to "high-level-tests")
-- «.low-level-tests»	(to "low-level-tests")

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


forths = {}


-- «metastack»  (to ".metastack")
-- (find-dn6 "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")
-- «dxyrun»  (to ".dxyrun")
-- Used mainly by: (find-dn6 "heads6.lua" "diag-head")
--
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




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




-- «BOX»  (to ".BOX")
-- (find-es "dednat" "BOX-dednat6")
-- Note: THIS IS A HACK!!! We even redefine "enddiagram"!
--
mybox_bodies = {}
forths["enddiagram"] = function ()
    if #mybox_bodies == 0 then
      output(arrows_to_defdiag(diagramname, tf:hyperlink()))
    else
      output(arrows_to_defdiagprep(diagramname, mybox_preps(), tf:hyperlink()))
      mybox_bodies = {}
    end
  end
mybox_names = {
  "\\myboxa", "\\myboxb", "\\myboxc", "\\myboxd",
  "\\myboxe", "\\myboxf", "\\myboxg", "\\myboxh"
}
mybox_prep1 = function (boxname, body)
    return format("  \\savebox{%s}{$%s$}\n", boxname, body)
  end
mybox_preps = function ()
    prep = ""
    for i,body in ipairs(mybox_bodies) do
      prep = prep .. mybox_prep1(mybox_names[i], body)
    end
    return prep
  end
forths["BOX"] = function ()
    tinsert(mybox_bodies, node_to_TeX(ds:pick(0)))
    ds:pick(0).tex = format("\\usebox{%s}", mybox_names[#mybox_bodies])
  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 prevn - 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

-- «arrow-modifiers»  (to ".arrow-modifiers")
-- (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
-- (find-dn4 "dednat4.lua" "lplacement")
forths[".PLABEL="] = function ()
    ds:pick(0).lplacement = getword() or error()
    ds:pick(0).label      = getword() or error()
  end

-- «dxyren» (to ".dxyren")
dxyren = function (li)
    local a, b = li:match("^(.*) =+> (.*)$")
    if not a then error("No '==>': "..li) end
    local A, B = split(a), split(b)
    if #A ~= #B then error("Bad args to ren: "..li) end
    for i=1,#A do
      local tag, node = A[i], nodes[A[i]]
      if not node then error("No node with this tag: "..tag) end
      node.tex = B[i]
    end
  end
forths["ren"] = function () dxyren(getrestofline()) end

-- «arrows» (to ".arrows")
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["<-"]  = 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

-- (find-es "diagxy" "loop")
forths["loop"] = function ()
    ds:push(storearrow(DxyLoop {ds:pick(0), dTeX=getword()}))
  end


-- (find-dn6grep "grep -nH -e forths diagforth.lua")
-- (find-LATEXgrep "grep -nH -e forths *.tex")
forths["x+="] = function () ds:pick(0).x = ds:pick(0).x + getwordasluaexpr() end
forths["y+="] = function () ds:pick(0).y = ds:pick(0).y + getwordasluaexpr() end

forths["xy+="] = function ()
    local dx,dy = getwordasluaexpr(), getwordasluaexpr()
    ds:pick(0).x = ds:pick(0).x + dx
    ds:pick(0).y = ds:pick(0).y + dy
  end

-- «relplace»  (to ".relplace")
-- (find-LATEXfile "2017elephant.tex" "relplace")
forths["relplace"] = function ()
    local x, y = ds:pick(0).x, ds:pick(0).y
    local dx, dy = getwordasluaexpr(), getwordasluaexpr()
    local TeX = getword()
    ds:push(storearrow(DxyPlace {{x=x+dx, y=y+dy, tex=TeX}}))
  end




-- «newnode:at:»  (to ".newnode:at:")
-- See: (find-es "dednat" "at:")
-- New, 2021feb26.
-- To do: move Node and storenode to the right places.

Node = Class {
  type       = "Node",
  __tostring = function (node) return mytostring(node) end,
  __index    = {
    v    = function (node) return v(node.x,node.y) end,
    setv = function (node,v) node.x=v[1]; node.y=v[2]; return node end,
  },
}
storenode = function (node)
    node = Node(node)
    table.insert(nodes, node)
    node.noden = #nodes         -- nodes[node.noden] == node
    if node.tag then            -- was: "and not nodes[node.tag]"...
      nodes[node.tag] = node    -- nodes[node.tag] == node
    end
    return node
  end

tow = function (vv, ww, a, b)
    local diff = ww-vv
    local diffrot90 = v(diff[2], -diff[1])
    return vv + (a or 0.5)*diff + (b or 0)*diffrot90
  end
ats_to_vs = function (str)
    return (str:gsub("@(%w+)", "nodes[\"%1\"]:v()"))
  end
forths["newnode:"] = function ()
    local tag = getword()
    ds:push(storenode({tag=tag, TeX=phantomnode}))
  end
forths["at:"] = function ()
    local node = ds:pick(0)
    local vexpr = getword()
    node:setv(expr(ats_to_vs(vexpr)))
  end





-- «high-level-tests» (to ".high-level-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)                 --> 120
= nodes
run [[ (( a,b a c b|->c    ]]
= ds
PP(ds:pick(0))            --> b|->c
PP(ds:pick(1))            --> c
PP(ds:pick(2))            --> a
= depths
PP(depths:metapick(0))
PP(depths:metapick(1))    --> a,b
PP(depths:metapick(2))    --> a
PP(depths:metapick(3))    --> c

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


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

--]==]



-- «low-level-tests» (to ".low-level-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}
= nodes







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-dn6 "diags.lua")
= 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:             utf-8-unix
-- End: