|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
-- This file:
-- https://anggtwu.net/LUA/DiagForth1.lua.html
-- https://anggtwu.net/LUA/DiagForth1.lua
-- (find-angg "LUA/DiagForth1.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
--
-- Supersedes: (find-dn6 "diagforth.lua")
--
-- (defun e () (interactive) (find-angg "LUA/DiagForth1.lua"))
-- (defun o () (interactive) (find-angg "LUA/DiagTeX1.lua"))
-- (defun oo () (interactive) (find-dn6 "diagforth.lua"))
--
-- «.forths» (to "forths")
-- «.forthe» (to "forthe")
-- «.DiagForth» (to "DiagForth")
-- «.dxyrun» (to "dxyrun")
-- «.2D-and-2Dx» (to "2D-and-2Dx")
-- «.2D-and-2Dx-tests» (to "2D-and-2Dx-tests")
-- «.metastack» (to "metastack")
-- «.metastack-tests» (to "metastack-tests")
-- «.diagram» (to "diagram")
-- «.enddiagram» (to "enddiagram")
-- «.head» (to "head")
-- «.head-D» (to "head-D")
-- «.nodes» (to "nodes")
-- «.ren» (to "ren")
-- «.arrows» (to "arrows")
-- «.arrow-modifiers» (to "arrow-modifiers")
-- «.relplace» (to "relplace")
require "DednatParse1" -- (find-angg "LUA/DednatParse1.lua")
require "DiagStacks1" -- (find-angg "LUA/DiagStacks1.lua")
-- «forths» (to ".forths")
-- «forthe» (to ".forthe")
forths = forths or VTable {}
forthe = forthe or VTable {} -- Defines "eating specs". See below.
-- ____ _ _____ _ _
-- | _ \(_) __ _ __ _| ___|__ _ __| |_| |__
-- | | | | |/ _` |/ _` | |_ / _ \| '__| __| '_ \
-- | |_| | | (_| | (_| | _| (_) | | | |_| | | |
-- |____/|_|\__,_|\__, |_| \___/|_| \__|_| |_|
-- |___/
--
-- The diagram language for "%D" lines has several kinds of
-- words that "eat text". These slides have some examples:
-- (find-dednatslides2018page 8 ".plabel= a L")
-- (find-dednatslides2018text 8 ".plabel= a L")
-- (find-dednatslides2018page 9 "eat text")
-- (find-dednatslides2018text 9 "eat text")
--
-- The class DiagForth implements the "outer interpreter" of that
-- diagram language. "Outer interpreters" are explained here:
-- (find-miniforthpage 1 "outer interpreter")
-- (find-miniforthtext 1 "outer interpreter")
-- For other important concepts, see:
-- (find-miniforthpage 3 ": SQUARE DUP * ;")
-- (find-miniforthtext 3 ": SQUARE DUP * ;")
-- (find-miniforthpage 8 "LIT, that eats bytecode")
-- (find-miniforthtext 8 "LIT, that eats bytecode")
--
-- In Dednat6 a word like ".plabel=", that eats the two following
-- words of text, had to be implemented like this:
--
-- forths[".plabel="] = function ()
-- local p, label = getword(), getword()
-- ds:pick(0).placement = p
-- ds:pick(0).label = label
-- end
--
-- In Dednat7 it can _also_ be implemented like this:
--
-- forthe[".plabel="] = "w,w"
-- forths[".plabel="] = function (p,label)
-- ds:pick(0).placement = p
-- ds:pick(0).label = label
-- end
--
-- We call the entry in `forthe[".plabel="]' the "eating spec" of the
-- word ".plabel=". Eating specs are handled by the method `getargs'
-- in the class DiagForth, that is called by the methods `dxyrun1' and
-- `dxyrun'; see the definition of the class DiagForth below.
--
-- Note that the definition of `dxyrun' in Dednat6 was very simple,
--
-- (find-dn6 "diagforth.lua" "dxyrun")
--
-- but in Dednat7 the code that corresponds to that is much more
-- complex. However, in Dednat6 defining "words that call other words"
-- was very hard, and in Dednat7 that are several easy ways to do
-- that. (TODO: examples.)
--
-- «DiagForth» (to ".DiagForth")
DiagForth = Class {
type = "DiagForth",
__index = {
w = function (df) return getword() or werror() end,
e = function (df) return getwordasluaexpr() end,
--
ews = function (df,chars)
local L = HTable {n=#chars}
for i=1,#chars do L[i] = df:w() end
for i=1,#chars do if chars[i] == "e" then L[i] = expr(L[i]) end end
return unpack(L)
end,
w_w = function (df) return df:ews({"w","w"}) end,
w_w_w = function (df) return df:ews({"w","w","w"}) end,
e_e = function (df) return df:ews({"e","e"}) end,
e_e_e = function (df) return df:ews({"e","e","e"}) end,
e_e_w = function (df) return df:ews({"e","e","w"}) end,
--
getargs = function (df,word)
local eatingspec = forthe[word]
if not eatingspec then return end
if type(eatingspec) == "function" then return eatingspec() end
if type(eatingspec) == "string" then
local methodname = eatingspec:gsub(",", "_")
if not df[methodname] then
error("Bad getargs method in "..word.." -> "..methodname)
end
return df[methodname](df)
end
error("Bad getargs in word: "..word)
end,
dxyrun1 = function (df,word)
if forths[word] then forths[word](df:getargs(word))
elseif nodes[word] then ds:push(nodes[word])
else error("Unknown word: "..word)
end
end,
dxyrun = function (df,str,pos_)
local oldvalues = pack(subj,startcol,endcol,word,pos)
setsubj(str, pos_ or 1)
while getword() do df:dxyrun1(word) end
subj,startcol,endcol,word,pos = unpack(oldvalues)
end,
},
}
-- «dxyrun» (to ".dxyrun")
dxyrun = function (str, pos_)
DiagForth{}:dxyrun(str,pos_)
end
-- ____ ____ _ ____ ____
-- |___ \| _ \ __ _ _ __ __| | |___ \| _ \__ __
-- __) | | | | / _` | '_ \ / _` | __) | | | \ \/ /
-- / __/| |_| | | (_| | | | | (_| | / __/| |_| |> <
-- |_____|____/ \__,_|_| |_|\__,_| |_____|____//_/\_\
--
-- See:
-- (find-dednatslides2018page 9 "2D and 2Dx eat")
-- (find-dednatslides2018text 9 "2D and 2Dx eat")
-- Note that both `2D' and `2Dx' are words that eat the rest of the
-- current line and that are implemented without eating specs!
-- Based on: (find-dn6 "diagforth.lua" "2D-and-2Dx")
-- See: (find-angg "LUA/DiagTikz1.lua" "2D-and-2Dx")
-- «2D-and-2Dx» (to ".2D-and-2Dx")
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 = VTable {}
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
-- «2D-and-2Dx-tests» (to ".2D-and-2Dx-tests")
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "DiagForth1.lua"
dxyrun "2Dx 100 +20 +20"
dxyrun "2D 100 A"
dxyrun "2D /|\\"
dxyrun "2D v v v"
dxyrun "2D +30 FA --> GA"
= xs
= nodes
--]==]
-- «metastack» (to ".metastack")
-- Based on: (find-dn6 "diagforth.lua" "metastack")
-- Uses: (find-angg "LUA/DiagStacks1.lua")
-- (find-angg "LUA/Stack1.lua" "Stack" "metastacks")
-- I stopped using `@' in 2020. See:
-- (find-LATEXgrep "grep --color=auto -nH --null -e ' @ ' *.tex")
forths["(("] = function () depths:meta_push() end
forths["))"] = function () depths:meta_pop() end
forthe["@"] = "e"
forths["@"] = function (offset) ds:push(depths:meta_at(offset)) end
-- «metastack-tests» (to ".metastack-tests")
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "DiagForth1.lua"
dxyrun "2Dx 100 +20 +20 +20 +20 +20 +20"
dxyrun "2D 100 A B C D E F G "
Stack.__index.tostring = mytostringv
dxyrun "A (( B C (( D E F G "
= ds --> A B C D E F G
dxyrun " @ 0 @ 2 "
= ds --> A B C D E F G D F
dxyrun " )) "
= ds --> A B C
dxyrun " )) "
= ds --> A
--]==]
-- ____ _
-- | _ \(_) __ _ __ _ _ __ __ _ _ __ ___
-- | | | | |/ _` |/ _` | '__/ _` | '_ ` _ \
-- | |_| | | (_| | (_| | | | (_| | | | | | |
-- |____/|_|\__,_|\__, |_| \__,_|_| |_| |_|
-- |___/
--
-- «diagram» (to ".diagram")
-- Based on: (find-dn6 "diagforth.lua" "diagram")
forths["diagram"] = function ()
diagramname = getword() or error("No diagram name")
xys = {}
lasty = nil
nodes = VTable {}
arrows = VTable {}
end
-- «enddiagram» (to ".enddiagram")
-- Uses: (find-angg "LUA/DiagTeX1.lua" "arrow_to_TeX")
-- (find-angg "LUA/DiagTeX1.lua" "diagxy_def_diag")
-- (find-dn6 "diagtex.lua" "arrows_to_defdiag")
forths["enddiagram"] = function ()
output(diagxy_def_diag(diagramname)) -- tf:hyperlink()
end
-- (find-dn6 "diagforth.lua" "diagram")
-- (find-dn6 "diagforth.lua" "enddiagram")
-- (find-dn6 "diagforth.lua" "nodes")
-- «head» (to ".head")
-- «head-D» (to ".head-D")
-- (find-dn6 "heads6.lua" "diag-head")
-- (find-angg "LUA/TreeSegs1.lua" "head")
registerhead = registerhead or function () return nop end
registerhead "%D" {
name = "diag",
action = function ()
local i,j,diaglines = tf:getblock()
for n=i,j do dxyrun(untabify(tf[n]), 3) end
end,
}
forths["#"] = function () getrestofline() end
-- «nodes» (to ".nodes")
-- Based on: (find-dn6 "diagforth.lua" "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
-- «ren» (to ".ren")
-- Based on: (find-dn6 "diagforth.lua" "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")
-- Based on: (find-dn6 "diagforth.lua" "arrows")
-- Uses: (find-angg "LUA/DiagTeX1.lua" "DxyArrow")
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["-"] = 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
-- «arrow-modifiers» (to ".arrow-modifiers")
-- Based on: (find-dn6 "diagforth.lua" "arrow-modifiers")
--
forthe[".p="] = "w"
forthe[".slide="] = "w"
forthe[".curve="] = "w"
forthe[".label="] = "w"
forthe[".plabel="] = "w,w"
forthe[".PLABEL="] = "w,w"
forths[".p="] = function (p) ds:pick(0).placement = p end
forths[".slide="] = function (slide) ds:pick(0).slide = slide end
forths[".curve="] = function (curve) ds:pick(0).curve = curve end
forths[".label="] = function (label) ds:pick(0).label = label end
forths[".plabel="] = function (p,label)
ds:pick(0).placement = p
ds:pick(0).label = label
end
forths[".PLABEL="] = function (lp,label)
ds:pick(0).lplacement = lp
ds:pick(0).label = label
end
-- Based on: (find-dn6 "diagforth.lua" "node-modifiers")
forthe["x+="] = "e"
forthe["y+="] = "e"
forthe["xy+="] = "e,e"
forths["x+="] = function (dx) ds:pick(0).x = ds:pick(0).x + dx end
forths["y+="] = function (dy) ds:pick(0).y = ds:pick(0).y + dy end
forths["xy+="] = function (dx,dy)
ds:pick(0).x = ds:pick(0).x + dx
ds:pick(0).y = ds:pick(0).y + dy
end
-- «relplace» (to ".relplace")
-- Based on: (find-dn6 "diagforth.lua" "relplace")
forthe["relplace"] = "e,e,w"
forths["relplace"] = function (dx,dy,TeX)
local x, y = ds:pick(0).x, ds:pick(0).y
ds:push(storearrow(DxyPlace {{x=x+dx, y=y+dy, tex=TeX}}))
end
-- (misp 51 "2-category-of-cats")
-- (misa "2-category-of-cats")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "DiagForth1.lua"
--]]
-- Local Variables:
-- coding: utf-8-unix
-- End: