Warning: this is an htmlized version!
The original is here, 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: