-- This is the file `experimental.lua' of dednat4.
-- It defines several more or less experimental words
-- for 2D diagrams in dednat4.
-- Author:     Eduardo Ochs <edrx@mat.puc-rio.br>
-- Maintainer: Eduardo Ochs <edrx@mat.puc-rio.br>
-- Version:    2008jun27
-- This file is in the Public Domain.
-- For the latest version see <http://angg.twu.net/dednat4.html>.
-- (find-dn4file "dednat4.lua")

-- There's a very early draft of documentation for this file here:
-- (find-es "dednat" "phantom-nodes")
-- (find-dn4 "README.phantoms")

-- Index:
-- «.midpoint»		(to "midpoint")
-- «.splitdist»		(to "splitdist")
-- «.place»		(to "place")



phantomnode = "\\phantom{O}"

-- «midpoint»  (to ".midpoint")
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=phantomnode}
    dspop()
  end


-- Words for drawing arrows in the middle of rectangles.
-- Actually these words build the vertex nodes for those arrows.
--    "harrownodes" is for horizontal arrows,
--    "varrownodes" is for vertical arrows,
--   "dharrownodes" and
--   "dvarrownodes" are for diagonal arrows.
-- They all expect two nodes on the stack, "node1" and "node2", and
-- they read three parameters with getwordasluaexpr(): "dx0", "dx1",
-- and "dx2" (or "dy0", "dy1" and "dy2").
--   "dx0" controls how far from "node1" the arrow starts,
--   "dx1" controls the length of the arrow,
--   "dx2" controls how far from "node2" the arrow starts.
-- Some of dx0, dx1, and dx2 can be nil; see "splitdist" below.
--   "harrownodes" uses y = (node1.y+node2.y)/2.
--   "varrownodes" uses x = (node1.x+nodex.y)/2.
-- This needs more documentation. Sorry.
-- Also, the "\phantom{O}" shouldn't be hardcoded.

-- «splitdist»  (to ".splitdist")
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

harrownodes = function (dx0, dx1, dx2, TeX1, TeX2)
    local node1, node2 = ds[2], ds[1]
    local midy = (node1.y + node2.y)/2
    local x1, x2 = splitdist(node1.x, node2.x, dx0, dx1, dx2)
    dspush(storenode{x=x1, y=midy, TeX=(TeX1 or phantomnode)})
    dspush(storenode{x=x2, y=midy, TeX=(TeX2 or phantomnode)})
  end
varrownodes = function (dy0, dy1, dy2, TeX1, TeX2)
    local node1, node2 = ds[2], ds[1]
    local midx = (node1.x + node2.x)/2
    local y1, y2 = splitdist(node1.y, node2.y, dy0, dy1, dy2)
    dspush(storenode{x=midx, y=y1, TeX=(TeX1 or phantomnode)})
    dspush(storenode{x=midx, y=y2, TeX=(TeX2 or phantomnode)})
  end

forths["harrownodes"] = function ()
    harrownodes(getwordasluaexpr(), getwordasluaexpr(), getwordasluaexpr())
  end
forths["varrownodes"] = function ()
    varrownodes(getwordasluaexpr(), getwordasluaexpr(), getwordasluaexpr())
  end

forths["hadjnodes"] = function ()
    harrownodes(nil, 20, nil)
  end
forths["vadjnodes"] = function ()
    varrownodes(nil, 20, nil)
  end

proportional = function (w0, w1, w2, z0, z2)
    local way = (w1 - w0)/(w2 - w0)
    return z0 + (z2 - z0)*way
  end
proportionals = function (w0, w1a, w1b, w2, z0, z2)
    return proportional(w0, w1a, w2, z0, z2),
           proportional(w0, w1b, w2, z0, z2)
  end
splitdists = function (w0, w2, dw0, dw1, dw2, z0, z2)
    local w1a, w1b = splitdist(w0, w2, dw0, dw1, dw2)
    local z1a, z1b = proportionals(w0, w1a, w1b, w2, z0, z2)
    return w1a, w1b, z1a, z1b
  end
dharrownodes = function (dx0, dx1, dx2, TeX1a, TeX1b)
    local node0, node2 = ds[2], ds[1]
    local x0, x2, y0, y2 = node0.x, node2.x, node0.y, node2.y
    local x1a, x1b, y1a, y1b = splitdists(x0, x2, dx0, dx1, dx2, y0, y2)
    dspush(storenode{x=x1a, y=y1a, TeX=(TeX1a or phantomnode)})
    dspush(storenode{x=x1b, y=y1b, TeX=(TeX1b or phantomnode)})
  end
dvarrownodes = function (dy0, dy1, dy2, TeX1a, TeX1b)
    local node0, node2 = ds[2], ds[1]
    local x0, x2, y0, y2 = node0.x, node2.x, node0.y, node2.y
    local y1a, y1b, x1a, x1b = splitdists(y0, y2, dy0, dy1, dy2, x0, x2)
    dspush(storenode{x=x1a, y=y1a, TeX=(TeX1a or phantomnode)})
    dspush(storenode{x=x1b, y=y1b, TeX=(TeX1b or phantomnode)})
  end

forths["dharrownodes"] = function ()
    dharrownodes(getwordasluaexpr(), getwordasluaexpr(), getwordasluaexpr())
  end
forths["dvarrownodes"] = function ()
    dvarrownodes(getwordasluaexpr(), getwordasluaexpr(), getwordasluaexpr())
  end



-- «place»  (to ".place")
-- Words for drawing objects that are not arrows, using
-- \place(x,y)[tex]. I'm not extremely happy with this code; if you
-- get a better solution please tell me. Anyway, here's how it works:
--
-- To finish a diagram we run the Forth word "enddiagram", which runs
-- the lua function of the same name, which dumps out the body of the
-- definition of the diagram, wrapped in a \defdiag{name}{body}
-- construct. To produce the body of the definition first we calculate
-- the "text" of each node in the array "nodes", i.e., the field .TeX
-- of the node; if the node doesn't have an explicit .TeX field it is
-- set as the result of running "unabbrev" on the node's .tag or .tex
-- fields. This first part - traversing the array "nodes" - produces
-- no output; all the output (i.e., the body of the definition of the
-- diagram) comes from the second part: traversing the array "arrows".
-- For most arrows their output will be a TeX line of the form
-- \morphism(x,y)modifiers<dx,dy>[{textfrom}`{textto};{label}];
-- \morphism is defined in diagxy.tex. However, if an arrow has a
-- field .special then its output is the result of running
-- arrow.special(arrow) instead of the default. In this way we can
-- have "fake arrows" in the array "arrows" whose output is something
-- totally different, typically a construct like \place(x,y)[{text}].
--
-- "place" is for nodes that have been declared but are not at the
-- extremity of any arrow, "relplace" is for placing new text relative
-- to an existing node.
--
-- See: (find-diagxypage 15)
--      (find-dn4file "dednat4.lua" "arrowtoTeX =")
--      (find-dn4file "dednat4.lua" "diagramtoTeX =")

tex_place  = function (T) return tex_place_(T.x, T.y, T.TeX, p) end
tex_place_ = function (x, y, TeX, p)
    p = p and "["..p.."]" or ""
    return format("\\place(%d,%d)%s[{%s}]", realx(x), realy(y), p, TeX)
  end
forths["place"] = function ()
    storearrow {
        special = function (arrow) return tex_place(arrow.from) end,
        from=ds[1]
      }
  end

---- Obsolete version, very ugly:
-- forths["relplace"] = function ()
--     local x, y = ds[1].x, ds[1].y
--     local dx, dy = getwordasluaexpr(), getwordasluaexpr()
--     local TeX = getword()
--     storearrow { special=tex_place_, x=x+dx, y=y+dy, TeX=TeX }
--   end

emitTeX = function (arrow)
    return arrow.TeX
  end
forths["relplace"] = function ()
    local x, y = ds[1].x, ds[1].y
    local dx, dy = getwordasluaexpr(), getwordasluaexpr()
    local TeX = getword()
    storearrow {special=emitTeX, TeX = format(
        "\\place(%d,%d)[{%s}]", realx(x+dx), realy(y+dy), TeX
      )}
  end
forths["_|"] = macro "relplace 7 7 \\pbsymbol{7}"

-- 2008apr09
-- (find-dn4 "dednat4.lua" "diagram" "diagramtoTeX =")
nodeTeX = function (node)
    return node.TeX or unabbrev(node.tex or node.tag)
  end
forths["place"] = function ()
    local node = ds[1]
    storearrow {special=emitTeX, TeX = format(
        "\\place(%d,%d)[{%s}]", realx(node.x), realy(node.y), nodeTeX(node)
      )}
  end



forths["sl_"] = macro(".slide= -2.5pt")
forths["sl^"] = macro(".slide= 2.5pt")
forths["sl__"] = macro(".slide= -5pt")
forths["sl^^"] = macro(".slide= 5pt")

forths["x+="] = function () ds[1].x = ds[1].x + getwordasluaexpr() end



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


-- Local Variables:
-- coding: raw-text-unix
-- End: