|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
-- diagxy.lua
-- What is this: this file adds support for a forthish front-end to
-- Michael Barr's "diagxy" TeX package (that in its turn is a
-- front-end to xypic) to dednat3.lua. This is usually activated in
-- the following form: if dednat3 finds a line like
-- %L require "diagxy.lua"
-- in the TeX file it is processing it will run ``require "diagxy.lua"''
-- as Lua code, and that will load this and add an entry for "%D" to
-- dednat3's table of "interesting line heads"; after that all lines
-- in the TeX file that start with "%D" will be processed by
-- `diagheadcode', that will interpret what comes after the "%D" as
-- forthish code (see `dofs').
-- «.withoutdednat3» (to "withoutdednat3")
-- «.nodes-and-arrows» (to "nodes-and-arrows")
-- «.2D» (to "2D")
-- «.dofs» (to "dofs")
-- «.diagram» (to "diagram")
-- «.forthwords» (to "forthwords")
-- «.diaghead» (to "diaghead")
--%%%%
--%
--% «withoutdednat3» (to ".withoutdednat3")
--%
--%%%%
-- In case we are loading this without loading dednat3.lua before (for
-- tinkering or debugging), provide dummy versions for some functions
-- and variables from dednat3.
-- (find-angg "dednat/dednat3.lua" "abbrevs")
-- (find-angg "dednat/dednat3.lua" "untabify")
-- (find-angg "dednat/dednat3.lua" "auxtreefunctions")
unabbrev = unabbrev or function (str) return str end
standardabbrevs = standardabbrevs or function () end
optionalhyperlink = optionalhyperlink or function () return "" end
untabify = untabify or function (str) return str end
linen = linen or -2222
sourcefname = sourcefname or "(no sourcefname)"
--%%%%
--%
--% «nodes-and-arrows» (to ".nodes-and-arrows")
--%
--%%%%
-- The data structures for nodes and arrows:
--
-- nodes an array of "node"s
-- nnodes an integer
-- node.noden an integer such that nodes[node.noden]==node
-- node.TeX a string (in TeX). It becomes an Ni in \morphism...[N1`N2;L]
-- node.tex a string, in TeX with abbreviations, or nil
-- node.tag a string; in general we have nodes[node.tag]==node
-- node.x an integer (given in Tk pixels)
-- node.y an integer (given in Tk pixels)
--
-- arrows an array of "arrow"s
-- narrows an integer
-- arrow.arrown an integer such that arrows[arrow.arrown]==arrow
-- arrow.from an index: nodes[arrow.from] is the starting node
-- arrow.to an index: nodes[arrow.to] is the ending node
-- arrow.shape a string, e.g. "|->", or nil; nil means "->"
-- arrow.label a string (in TeX). It becomes the L in \morphism...[N1`N2;L]
-- arrow.placement a string, e.g. "a" for "label |a|bove arrow", or nil
-- arrow.slide a string, e.g. "10pt", or nil
-- arrow.curve a string, e.g. "^2em", or nil
-- arrow.special a function or nil
dxyorigx = 100
dxyorigy = 100
dxyscale = 15
realx = function (x) return dxyscale*(x-dxyorigx) end
realy = function (y) return -dxyscale*(y-dxyorigy) end
nodes = {}
nnodes = 0
arrows = {}
narrows = 0
storenode = function (node)
nnodes = nnodes+1
node.noden = nnodes
nodes[nnodes] = node
if node.tag and not nodes[node.tag] then nodes[node.tag] = node end
return node
end
storearrow = function (arrow)
narrows = narrows+1
arrow.arrown = narrows
arrows[narrows] = arrow
return arrow
end
arrowtoTeX = function (arrow)
if arrow.special then
return arrow.special(arrow)
end
local node1, node2 = nodes[arrow.from], nodes[arrow.to]
local x1, y1 = realx(node1.x), realy(node1.y)
local x2, y2 = realx(node2.x), realy(node2.y)
local dx, dy = x2-x1, y2-y1
local p, sh
p = arrow.placement and "|"..arrow.placement.."|" or ""
local slide, curve
if arrow.slide then slide = "@<"..arrow.slide..">" end
if arrow.curve then curve = "@/"..arrow.curve.."/" end
if arrow.slide or arrow.curve then
sh = format("/{@{%s}%s%s}/",
(arrow.shape or "->"), (slide or ""), (curve or ""))
else
sh = "/"..(arrow.shape or "->").."/"
end
return format("\\morphism(%d,%d)%s%s<%d,%d>[{%s}`{%s};{%s}]",
x1, y1, p, sh, dx, dy,
node1.TeX, node2.TeX, (arrow.label or ""))
end
--[[
storenode {TeX="a", tag="a", x=100, y=100}
storenode {TeX="b", tag="b", x=140, y=100}
PP(nodes)
storearrow {from="a", to="b", shape="|->",
slide="5pt", label="up", placement="a"}
storearrow {from="a", to="b", shape=".>"}
print(arrowtoTeX(arrows[1]))
print(arrowtoTeX(arrows[2]))
--]]
--%%%%
--%
--% «2D» (to ".2D")
--%
--%%%%
-- The only special data structure used in the 2D support is the array
-- "xs", of cols->Tkcols; only the first position of each x spec is
-- stored in it. Example: if
-- "100 140 " this xspecstr and then
-- " +10 " this xspecstr are fed to dxy2Dx, then we'll have
-- 0123456789 xs[0]=100, xs[2]=110], xs[5]=140.
xs = {}
prevy = nil
dxy2Dgetword = function (str, pos)
if not str or string.len(str)<=pos then return end
local _, endpos, spaces, word = string.find(str, "^( *)([^ ]+)", pos+1)
if not word then return end
local wordpos = pos + string.len(spaces)
return endpos, wordpos, word
end
dxy2Dx = function (xspecstr, pos)
local wordpos, word
pos = pos or 0
while 1 do
pos, wordpos, word = dxy2Dgetword(xspecstr, pos)
if not word then break end
local _, __, sign, n = string.find(word, "^(%+?)([0-9.]+)$")
if n then -- words that are not like nn or +nn are ignored
if sign=="" then
xs[wordpos] = tonumber(n)
else -- sign=="+": add n to the previous x
local prevx
for j=wordpos-1,0,-1 do
if xs[j] then prevx=xs[j]; break end
end
if not prevx then
error("line "..linen.." col "..pos..": no prevx")
end
xs[wordpos] = prevx+tonumber(n)
end
end
end
end
dxy2D = function (str, pos, insteadofstorenode)
local wordpos, yword, y
pos, wordpos, yword = dxy2Dgetword(str, pos or 0)
if not yword then return end -- blank lines are ignored
local _, __, sign, n = string.find(yword, "^(%+?)([0-9.]+)$")
if n then -- lines not starting with a y spec are ignored
if sign=="" then
y = tonumber(n)
else
if not prevy then error("line "..linen.." col "..pos..": no prevy") end
y = tonumber(n)+prevy
end
prevy = y
while 1 do
pos, wordpos, word = dxy2Dgetword(str, pos)
if not word then break end
for i=wordpos,wordpos+string.len(word)-1 do
if xs[i] then
(insteadofstorenode or storenode)({tag=word, x=xs[i], y=y})
break
end -- words without an x are ignored
end
end
end
end
--[[
dxy2Dx(" 100 140 +20"); PP(xs)
dxy2Dx(" +10 +3"); PP(xs)
dxy2D("55 a b^ool ", 0, P)
dxy2D("+5 a^F ign h ", 0, P)
--]]
--%%%%
--%
--% «dofs» (to ".dofs")
--%
--%%%%
-- (find-angg "LFORTH/kernel.lua")
-- (find-angg "LFORTH/kernel.lua" "getword")
-- (find-es "lua5" "0-based")
-- lua50e 'P(string.find("012345678", "^(23456)", 1+2)) --> 1+2 7 "23456"'
ds = {}
dspush = function (v) table.insert(ds, 1, v); return v end
dspop = function () return table.remove(ds, 1) end
depths = {}
depthspush = function (v) table.insert(depths, 1, v); return v end
depthspop = function () return table.remove(depths, 1) end
forths = forths or {}
forths["drop"] = dspop
forths["swap"] = function () ds[2], ds[1] = ds[1], ds[2] end
forths["(("] = function () depthspush(table.getn(ds)) end
forths["))"] = function ()
if not depths[1] then
error("line "..linen.." col "..p.wordpos..": missing `))'")
end
for i=table.getn(ds)-1,depthspop(),-1 do table.remove(ds, 1) end
end
pushtag = function (tag) dspush(assert(nodes[tag], tag..": no such node")) end
pusharrow = function (shape)
dspush(storearrow {from=ds[2].noden, to=ds[1].noden, shape=shape})
end
dof = function (word)
if forths[word] then forths[word]()
elseif nodes[word] then dspush(nodes[word]) -- diagxy-specific
else error("No such word: "..word)
end
end
p = {text=str, pos=0, word=nil, wordpos=nil, stuffpos=nil}
getword = function ()
local _, __, spaces, word = string.find(p.text, "^( *)([^ ]+)", p.pos+1)
if _ then
p.stuffpos, p.pos = p.pos+string.len(spaces), __
return word
end
p.pos = nil
end
getrestofline = function ()
local stuff = string.sub(p.text, p.pos+1+1)
p.stuffpos, p.pos = p.pos+1, string.len(p.text)
return stuff
end
getuntilquote = function ()
local _, __, stuff = string.find(p.text, "^ (.-)\"", p.pos+1)
if not _ then error("line "..linen..": no closing quote") end
p.stuffpos, p.pos = p.pos+1, __
return stuff
end
dofs = function (str, pos)
local oldp = p
p = {text=str, pos=(pos or 0)}
while 1 do
p.word = getword()
if not p.word then p = oldp; return end
p.wordpos = p.stuffpos
dof(p.word)
end
end
forths["#"] = getrestofline
--[[
forths["Pw"] = function () P(getword()) end
forths["Pq"] = function () P(getuntilquote()) end
forths["Prl"] = function () P(getrestofline()) end
s = " Pw a-word Pq until quote\" Prl rest of line "
P(s); dofs(s)
--]]
--%%%%
--%
--% «diagram» (to ".diagram")
--%
--%%%%
diagram = function (str)
diagramname = str
diagramstartlinen = linen or -2222
dxyorigx = 100
dxyorigy = 100
dxyscale = 15
nodes = {}
nnodes = 0
arrows = {}
narrows = 0
xs = {}
prevy = nil
end
diagramtoTeX = function ()
for i=1,nnodes do
local node = nodes[i]
if not node.tex then node.tex = node.tag end
if not node.TeX then node.TeX = unabbrev(node.tex) end
end
local bigstr = ""
for i=1,narrows do
bigstr = bigstr.." "..arrowtoTeX(arrows[i]).."\n"
end
return bigstr
end
-- (find-angg "dednat/dednat3.lua" "processing.a.file" "Tree redefined")
-- (find-angg "LATEX/edrx.sty" "ded")
-- TO DO: support \place, warn at redefinitions
enddiagram = function ()
local diagramdef = format("\\defdiag{%s}{%s\n%s}",
diagramname, optionalhyperlink(" % ", diagramstartlinen, ""),
diagramtoTeX())
print(diagramdef)
end
--%%%%
--%
--% «forthwords» (to ".forthwords")
--%
--%%%%
-- Note that "drop", "((", and "))" have already been defined.
forths["diagram"] = function ()
diagram(getword() or error("Missing diagram name"))
end
forths["enddiagram"] = enddiagram
forths["2Dx"] = function ()
getrestofline()
dxy2Dx(p.text, p.stuffpos)
end
forths["2D"] = function ()
getrestofline()
dxy2D(p.text, p.stuffpos)
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["--"] = function () pusharrow("--") end
forths["."] = function () pusharrow(".") end
settex = function (tag, str) nodes[tag].tex = str end
setTeX = function (tag, str) nodes[tag].TeX = str end
setp = function (tag, str) nodes[tag].placement = str end
setslide = function (tag, str) nodes[tag].slide = str end
setcurve = function (tag, str) nodes[tag].curve = str end
forths[".tex="] = function () ds[1].tex = getword() end
forths[".TeX="] = function () ds[1].TeX = getword() end
forths[".TeX=\""] = function () ds[1].TeX = getuntilquote() end
forths[".p="] = function () ds[1].placement = getword() end
forths[".slide="] = function () ds[1].slide = getword() end
forths[".curve="] = function () ds[1].curve = getword() end
forths[".label="] = function () ds[1].label = getword() end
forths[".label=\""] = function () ds[1].label = getuntilquote() end
--[[
diagram "miniadj"
dxy2Dx " 100 140 "
dxy2D " 140 a^L <= a "
dxy2D " - - "
dxy2D " | | "
dxy2D " v v "
dxy2D " 100 b => b^R "
PP("nodes =", nodes)
pushtag "a^L"; pushtag "a"; dof "<="
pushtag "a^L"; pushtag "b"; dof "|->"
pushtag "a"; pushtag "b^R"; dof "|->"
pushtag "b"; pushtag "b^R"; dof "=>"
PP("arrows =", arrows)
enddiagram()
--]]
--[[
dofs "diagram miniadj"
dofs "2Dx 100 140 "
dofs "2D 140 a^L <= a "
dofs "2D - - "
dofs "2D | | "
dofs "2D v v "
dofs "2D 100 b => b^R "
dofs "a^L a <= a^L b |-> a b^R |-> b b^R =>"
dofs "enddiagram"
--]]
--%%%%
--%
--% «diaghead» (to ".diaghead")
--%
--%%%%
-- (find-angg "dednat/dednat3.lua" "luahead")
-- Tell dednat3 to treat "%D" lines as strings to be dofs'd.
diagheadcode = function ()
dofs(untabify(linestr), 2)
end
if registerhead then
registerhead("%D", {code=diagheadcode})
end
--[[
diagram "miniadj"
dxy2Dx " 100 140 "
dxy2D " 140 a^L <= a "
dxy2D " - - "
dxy2D " | | "
dxy2D " v v "
dxy2D " 100 b => b^R "
dofs " a (( a^L => drop b |-> drop b^R => )) b^R |-> "
enddiagram()
--]]
--[[
diagram "limij"
dofs "2Dx 100 +60 +60 +60 "
dofs "2D 140 x <======= j=>x ====> i=>x <======= x "
dofs "2D - - - - "
dofs "2D | <-> | |-> | <-> | "
dofs "2D v v v v "
dofs "2D 100 lim_j.y_j ==> j=>y_j <== i=>y_j <== lim_i.y_j "
dofs ""
dofs "lim_j.y_j .TeX=\" \lim_j y_j\""
dofs "lim_i.y_j .TeX=\" \lim_i y_j\""
dofs " x (( j=>x <= drop i=>x => drop x <= drop lim_i.y_j |-> )) "
dofs " lim_j.y_j |-> drop j=>y_j => drop i=>y_j <= drop lim_i.y_j <="
dofs " (( j=>x j=>y_j |-> )) (( i=>x i=>y_j |-> )) "
enddiagram()
--]]
--[[
#*
cd ~/dednat/
lua50 diagxy.lua
#*
]]