Warning: this is an htmlized version!
The original is across this link,
and the conversion rules are here.
-- 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:    2008aug17
-- 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")
-- «.relplace»		(to "relplace")
-- «.relphantom»	(to "relphantom")
-- «.thereplusxy»	(to "thereplusxy")
-- «.loop»		(to "loop")
-- «.clearnamednodes»	(to "clearnamednodes")
-- «.def»		(to "def")
-- «.BOX»		(to "BOX")
-- «.deds-with-args»	(to "deds-with-args")
-- «.addlayer»		(to "addlayer")



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 =")
--      (find-dn4 "dednat4.lua" "diagram" "diagramtoTeX =")

emitTeX = function (arrow) return arrow.TeX end
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

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

-- «relphantom»  (to ".relphantom")
forths["relphantom"] = function ()
    local dx, dy = getwordasluaexpr(), getwordasluaexpr()
    ds[1] = storenode{x=ds[1].x+dx, y=ds[1].y+dy, tex=phantomnode}
  end

-- «thereplusxy»  (to ".thereplusxy")
-- (find-dn4ex "eedemo2.tex" "presheaf")
thereplusxy = function (dx, dy, tag)
    ds[1] = storenode({x = ds[1].x + dx, y = ds[1].y + dy, tag = tag})
    return ds[1]
  end
forths["there+xy:"] = function ()
    thereplusxy(getword(), getword(), getword())
  end


-- «loop»  (to ".loop")
-- (find-es "dednat" "loop")
forths["loop"] = function ()
    local node = ds[1]
    local dTeX = getword()
    storearrow {special=emitTeX, TeX = format(
        "\\Loop(%d,%d){%s}%s", realx(node.x), realy(node.y), nodeTeX(node), dTeX
      )}
  end


-- «clearnamednodes»  (to ".clearnamednodes")
-- Use in conjunction with "xs = {}" to reset the grid
clearnamednodes = function ()
    for k,v in pairs(nodes) do
      if type(k)=="string" then nodes[k] = nil end
    end
  end


-- «def»  (to ".def")
-- (find-es "dednat" "enddefdiag")
-- 2009aug11: a hack to create diagrams that are defined in the .dnt
-- file with \def, not with \defdiag and \defded, and that can receive
-- arguments. For example: this dednat block in a .tex file,
--
--   %D diagram pmetauniv
--   %D 2Dx     100    +20
--   %D 2D  100        #1
--   %D 2D             -
--   %D 2D           #4|
--   %D 2D             v
--   %D 2D  +20 #2 ==> #3
--   %D 2D
--   %D (( #1 #3 |-> .plabel= l #4
--   %D    #2 #3  =>
--   %D ))
--   %D enddefpdiagram 4
--
-- becomes this in the .dnt file:
--
--   \def\pmetauniv#1#2#3#4{\left(\bfig    % (find-fline "ee.tex" 50)
--     \morphism(300,0)|l|/|->/<0,-300>[{#1}`{#3};{#4}]
--     \morphism(0,-300)/=>/<300,0>[{#2}`{#3};{}]
--   \efig\right)}
--
-- I don't know how to do something similar with trees yet...

def_args = {
  [0] = "",
  "#1",
  "#1#2",
  "#1#2#3",
  "#1#2#3#4",
  "#1#2#3#4#5",
  "#1#2#3#4#5#6",
  "#1#2#3#4#5#6#7",
  "#1#2#3#4#5#6#7#8",
  "#1#2#3#4#5#6#7#8#9",
}
enddefdiagram = function (pre, post)
    local macroname = diagramname    -- getword()
    local args      = def_args[getwordasluaexpr()]
    local hyperlink = optionalhyperlink("    % ", diagramstartlinen, "")
    local body      = diagramtoTeX()
    local def       = "\\def\\" .. macroname .. args .. "{" ..
                          (pre or "") .. "\\bfig" ..
                          hyperlink .. "\n" ..
                          body .. "\\efig" .. (post or "") .. "}"
    dntprint(def)
  end
enddefpdiagram = function ()
    enddefdiagram("\\left(", "\\right)")
  end
forths["enddefdiagram"]  = enddefdiagram
forths["enddefpdiagram"] = enddefpdiagram



-- «BOX»  (to ".BOX")
-- (find-dn4ex "edrx08.sty" "savebox")
-- This is a wild hack to let me put diagrams in nodes of bigger
-- diagrams using a \setbox{\myboxa} / \usebox{\myboxa} trick.
-- 2010mar25
mybox_names = {
  "\\myboxa",
  "\\myboxb",
  "\\myboxc",
  "\\myboxd",
  "\\myboxe",
  "\\myboxf",
  "\\myboxg",
  "\\myboxh"
}
mybox_prep1 = function (boxname, body)
    -- PP("1", 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
mybox_prep = function (diagname)
    return format("\\defdiagprep{%s}{\n%s}\n", diagname, mybox_preps())
  end
mybox_bodies = {}
forths["BOX"] = function ()
    tinsert(mybox_bodies, nodeTeX(ds[1]))
    ds[1].tex = format("\\usebox{%s}", mybox_names[#mybox_bodies])
  end
-- forths["OUTBOXES"] = function ()
--     dntprint(mybox_prep(diagramname))
--     mybox_bodies = {}
--   end

enddiagram = function ()
    local diagramdef
    if #mybox_bodies > 0 then
      diagramdef = format("\\defprepareddiag{%s}{%s\n%s  }{\n%s}",
          diagramname, optionalhyperlink("    % ", diagramstartlinen, ""),
          mybox_preps(),
          diagramtoTeX())
      mybox_bodies = {}
    else
      diagramdef = format("\\defdiag{%s}{%s\n%s}",
          diagramname, optionalhyperlink("    % ", diagramstartlinen, ""),
          diagramtoTeX())
    end
    dntprint(diagramdef)
    remembertoundefine("diag", diagramname)
  end
forths["enddiagram"] = enddiagram
forths["OUTBOXES"] = function () end



-- «deds-with-args»  (to ".deds-with-args")
-- 2010apr21: this is a way to define deduction trees that take arguments.
-- The way to use it is a bit funny:
--
-- %:
-- %:  #1    #2
-- %:  --#6  --
-- %:  #3    #4
-- %:  --------#6
-- %:     #5
-- %:
-- %:     ^^6-foo
-- %:
-- $$\dedfoo ABCDEL$$
--
tex_tree_tatsuta = function (treetagseg, treelabel, treerootseg)
    local hyp  = optionalhyperlink("    % ", treetagseg.linen, "")
    local body = tex_node_tatsuta(" ", treerootseg)
    local nargs, dedname = string.match(treelabel, "^%^([1-9]).(.*)")
    if nargs then
      local output = "\\def\\ded"..dedname..def_args[nargs+0].."{"..hyp.."\n"..
          body.." }"
      return output
    else
      return format("\\defded{%s}{%s\n%s }\n",
                    treelabel, hyp, body)
    end
  end
tex_tree_function = tex_tree_tatsuta




-- «addlayer»  (to ".addlayer")
-- (find-es "lua5" "addlayer")
addlayer    = function (T) return setmetatable({}, {__index = T}) end
removelayer = function (T) return getmetatable(T).__index end
-- A nice applicattion:
-- (find-dn4 "dednat4.lua" "abbrevs")
-- abbrevs = addlayer(abbrevs)
--   [then add lots of temporary abbrevs]
-- abbrevs = removelayer(abbrevs)




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["y+="] = function () ds[1].y = ds[1].y + 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: