|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
-- This file:
-- http://angg.twu.net/SRF/srfb.lua.html
-- http://angg.twu.net/SRF/srfb.lua
-- (find-angg "SRF/srfb.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
--
-- (defun a () (interactive) (find-angg "SRF/srfa.lua"))
-- (defun b () (interactive) (find-angg "SRF/srfb.lua"))
require "srfa" -- (find-angg "SRF/srfa.lua")
-- «.TwoD» (to "TwoD")
-- «.TwoD-tests» (to "TwoD-tests")
-- «.Pict2e» (to "Pict2e")
-- «.Pict2e-tests» (to "Pict2e-tests")
-- «.Points» (to "Points")
-- «.Points-tests» (to "Points-tests")
-- «.SD» (to "SD")
-- «.SD-tests» (to "SD-tests")
-- ____ ____ _ ____ ____
-- |___ \| _ \__ __ __ _ _ __ __| | |___ \| _ \
-- __) | | | \ \/ / / _` | '_ \ / _` | __) | | | |
-- / __/| |_| |> < | (_| | | | | (_| | / __/| |_| |
-- |_____|____//_/\_\ \__,_|_| |_|\__,_| |_____|____/
--
-- «TwoD» (to ".TwoD")
-- The class TwoD implements something equivalent to the words "2D"
-- and "2Dx" of dednat6 in a way that is slightly more flexible and
-- much easier to understand.
-- See:
-- (find-dn6 "diagforth.lua" "2D-and-2Dx")
TwoD = Class {
type = "TwoD",
new = function ()
return TwoD {xs = HTable {}, maxcol = 1}
end,
__tostring = function (td) return td:xstostring() end,
__index = {
prefix1 = "%D 2Dx",
prefix2 = "%D 2D",
eraseprefix = function (td, line, prefix)
return line:replace(0, (" "):rep(#prefix))
end,
--
-- td:xstostring() prints the table td.xs in a nice format.
--
drawxk = function (td, lines, col)
for k=1,#lines do
if #lines[k] < col then return k end
end
end,
drawx = function (td, lines, col, x)
local k = td:drawxk(lines, col)
if not k then
table.insert(lines, td.prefix1)
k = #lines
end
lines[k] = lines[k]:replace(col-1, tostring(x))
return lines
end,
drawxs = function (td)
local lines = {td.prefix1}
for col=1,td.maxcol do
if td.xs[col] then
lines = td:drawx(lines, col, td.xs[col])
end
end
return lines
end,
xstostring = function (td)
return table.concat(td:drawxs(), "\n")
end,
--
-- TODO: write a better td:error() -
-- one that shows the current line.
error = function (td, str) error(str) end,
--
-- td:do2Dx() is used like this:
-- td:do2Dx("%D 2Dx 100 +20")
-- td:do2Dx("%D 2Dx +10 ")
-- It parses the given lines and sets the table td.xs.
--
lastx = function (td, col)
for c = col-1,1,-1 do
if td.xs[c] then return td.xs[c] end
end
td:error("2Dx error: can't use a relative x here")
end,
toabsolutex = function (td, word, col)
local sign, strn = word:match("^([-+]?)([0-9.]+)$")
if not sign then td:error("2Dx error: Not a number") end
local n = tonumber(strn)
if sign == "" then return n end
if sign == "+" then return td:lastx(col) + n end
if sign == "-" then return td:lastx(col) - n end
end,
dowordx = function (td, word, col)
local absolutex = td:toabsolutex(word, col)
td.maxcol = max(td.maxcol, col)
td.xs[col] = absolutex
end,
do2Dx = function (td, line)
line = td:eraseprefix(line, td.prefix1)
for col,word in line:gmatch("()(%S+)") do
td:dowordx(word, col)
end
return td
end,
--
-- td:do2D() is used like this:
-- td:do2Dx("%D 2Dx 100 +15 +15")
-- td:do2D ("%D 2D 100 A ", f)
-- td:do2D ("%D 2D / \ ", f)
-- td:do2D ("%D 2D +20 B ----- C ", f)
-- It only processes the lines that start with a number, and it
-- runs f(x, y, tag) for every tag that has both an x coordinate
-- and a y coordinate. If f is nil then it run PP.
--
getlasty = function (td)
return td.lasty or td:error("2D error: can't use a relative y here")
end,
firstxin = function (td, col, width)
for i=col,col+(width-1) do if td.xs[i] then return td.xs[i] end end
end,
do2D = function (td, line, f)
local colwords = {}
line = td:eraseprefix(line, td.prefix2)
for col,word in line:gmatch("()(%S+)") do
table.insert(colwords, {col, word})
end
if #colwords == 0 then return end
local sign, strn = colwords[1][2]:match("^([-+]?)([0-9.]+)$")
if not sign then return end
local n, y = tonumber(strn), nil
if sign == "" then y = n end
if sign == "+" then y = td:getlasty() + n end
if sign == "-" then y = td:getlasty() - n end
for i=2,#colwords do
local col,tag = colwords[i][1], colwords[i][2]
local x = td:firstxin(col, #tag)
if x then (f or PP)(x, y, tag) end
end
td.lasty = y
end,
},
}
-- «TwoD-tests» (to ".TwoD-tests")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfb.lua"
td = TwoD.new()
td:do2Dx("%D 2Dx 100 +20")
td:do2Dx("%D 2Dx +10")
= td
= td.maxcol
= td.xs
td = TwoD.new()
td:do2Dx("%D 2Dx 100 +15 +15")
td:do2D ("%D 2D 100 A ")
td:do2D ("%D 2D / \ ")
td:do2D ("%D 2D +20 B ----- C ")
td:do2D ("%D 2D +10 ALongName ")
--]]
-- ____ _ _ ____
-- | _ \(_) ___| |_|___ \ ___
-- | |_) | |/ __| __| __) / _ \
-- | __/| | (__| |_ / __/ __/
-- |_| |_|\___|\__|_____\___|
--
-- «Pict2e» (to ".Pict2e")
--
Pict2e = Class {
type = "Pict2e",
new = function () return Pict2e {lines = {}} end,
from = function (o)
if otype(o) == "Pict2e" then return Pict2e {lines = copy(o.lines)} end
if type(o) == "string" then return Pict2e {lines = {o}} end
if type(o) == "table" then return Pict2e {lines = copy(o)} end
error("From?")
end,
__tostring = function (p) return p:tostring("%") end,
__mul = function (prefix, p)
local f = function (li) return prefix..li end
return Pict2e {lines = map(f, p.lines)}
end,
__add = function (a, b)
a = Pict2e.from(a)
b = Pict2e.from(b)
for _,li in ipairs(b.lines) do table.insert(a.lines, li) end
return a
end,
__index = {
tostring = function (p, suffix)
local f = function (li) return li..(suffix or "") end
return mapconcat(f, p.lines, "\n")
end,
tolatex = function (p) return p:tostring("%") end,
color = function (p, color)
return ("{\\color{"..color.."}") + (" " * p) + "}"
end,
},
}
-- «Pict2e-tests» (to ".Pict2e-tests")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfb.lua"
p2 = Pict2e {lines = {"A", "B"}}
= Pict2e.from "A"
= Pict2e.from {"A", "B"}
= Pict2e.from( Pict2e.from {"A", "B"} )
p2 = Pict2e.from {"A", "B"}
= " " * p2
= p2 + p2
= p2 + "C"
= p2 + {"C", "D"}
= "0" + p2
= {"0", "1"} + p2
= p2:color("red")
--]]
-- ____ _ _
-- | _ \ ___ (_)_ __ | |_ ___
-- | |_) / _ \| | '_ \| __/ __|
-- | __/ (_) | | | | | |_\__ \
-- |_| \___/|_|_| |_|\__|___/
--
-- «Points» (to ".Points")
Points = Class {
type = "Points",
new = function () return Points {} end,
__tostring = function (pts) return pts:tostring() end,
__index = {
tostring = function (pts, sep)
return mapconcat(tostring, pts, sep or "")
end,
add = function (pts, pt)
table.insert(pts, pt)
return pts
end,
adds = function (pts, pts2)
for _,pt in ipairs(pts2) do table.insert(pts, pt) end
return pts
end,
rev = function (pts)
local pr = Points.new()
for i=#pts,1,-1 do
table.insert(pr, pts[i])
end
return pr
end,
--
pict2e = function (pts, prefix)
return Pict2e.from(prefix .. tostring(pts))
end,
Line = function (pts) return pts:pict2e("\\Line") end,
polygon = function (pts) return pts:pict2e("\\polygon") end,
region0 = function (pts) return pts:pict2e("\\polygon*") end,
region = function (pts, color) return pts:region0():color(color) end,
},
}
-- «Points-tests» (to ".Points-tests")
--[[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfb.lua"
pts = Points {v(1,2), v(3,4), v(5,6)}
= pts
= pts:rev()
pts:add(pts:rev())
= pts
--]]
-- ____ ____ _ _ _ _
-- / ___|| _ \ _ ___| |_ _ __(_)_ __ __ _ __| (_) __ _ __ _ ___
-- \___ \| | | (_) / __| __| '__| | '_ \ / _` | / _` | |/ _` |/ _` / __|
-- ___) | |_| |_ \__ \ |_| | | | | | | (_| | | (_| | | (_| | (_| \__ \
-- |____/|____/(_) |___/\__|_| |_|_| |_|\__, | \__,_|_|\__,_|\__, |___/
-- |___/ |___/
--
-- «SD» (to ".SD")
-- See: (find-books "__cats/__cats.el" "marsden-ctusd")
-- (find-ctusdpage 9 "Naturality")
-- (find-ctusdtext 9 "Naturality")
-- https://arxiv.org/pdf/1401.7220.pdf#page=9
-- Status: prototype, very incomplete.
Path.prependtopath "~/LATEX/dednat6/?.lua"
require "picture" -- (find-dn6 "picture.lua")
SD = Class {
type = "SD",
new = function ()
return SD {
nodes = VTable {},
extrapts = VTable {},
regions = VTable {}, -- drawn first
wires = VTable {}, -- drawn second
dots = VTable {}, -- drawn third
texts = VTable {}, -- drawn fourth
}
end,
__index = {
--
addnode = function (sd, x, y, tag)
sd_nodes[tag] = V(x, y)
end,
readnodes0 = function (sd, bigstr)
local pat = "([A-Za-z0-9]+)=%(([0-9]+),([0-9]+)%)"
for tag,x,y in bigstr:gmatch(pat) do
sd.nodes[tag] = v(tonumber(x), tonumber(y))
end
return sd
end,
ats_to_vs = function (sd, str, globalvar)
return expr(sd:ats_to_vs0(str, globalvar))
end,
ats_to_vs0 = function (sd, str, globalvar)
globalvar = globalvar or "sd.nodes"
return (str:gsub("@(%w+)", globalvar.."[\"%1\"]"))
end,
setextrapts = function (sd, tag1, tag2, ptsstr)
local pts = sd:ats_to_vs(ptsstr)
sd.extrapts[tag1.."-"..tag2] = Points(pts)
sd.extrapts[tag2.."-"..tag1] = Points(pts):rev()
end,
pathtopoints = function (sd, path)
local tags = {}
for tag in path:gmatch("([A-Za-z0-9]+)") do
table.insert(tags, tag)
end
local pts = Points {sd.nodes[tags[1]]}
for i=2,#tags do
local oldtag = tags[i-1]
local newtag = tags[i]
local extrapts = sd.extrapts[oldtag.."-"..newtag]
if extrapts then pts:adds(extrapts) end
pts:add(sd.nodes[newtag])
end
-- falta fechar
return pts
end,
--
Line = function (sd, path)
return sd:pathtopoints(path):Line()
end,
polygon = function (sd, path)
return sd:pathtopoints(path):polygon()
end,
region = function (sd, path, color)
return sd:pathtopoints(path):region(color)
end,
},
}
sd_nodes0 = [=[
A0=(0,6) - A1=(2,6) - A2=(4,6) - A3=(6,6)
| | | |
| M1=(2,4) | |
| | / |
| M2=(2,2) - |
| | \ |
B0=(0,0) - B1=(2,0) - B2=(4,0) - B3=(6,0)
]=]
-- «SD-tests» (to ".SD-tests")
--
--[==[
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
dofile "srfb.lua"
sd = SD.new()
sd:readnodes0(sd_nodes0)
PPP(v(2,3))
= sd.nodes
= sd:ats_to_vs0("@B1")
= sd:ats_to_vs("@B1")
= sd:ats_to_vs("@B1+v(0.1, 0.2)")
= sd:setextrapts("M2", "A2", "{@M2+v(0.8, 0.2), @M2+v(1.2, 0.6)}")
= sd:setextrapts("M2", "B2", "{@M2+v(0.8, -0.2), @M2+v(1.2, -0.6)}")
= sd.extrapts["M2-A2"]
= sd.extrapts["A2-M2"]
= sd:pathtopoints("M2-A2")
= sd:region("M2-A2-A1", "blue")
path1 = "A0-A1-B1-B0"
path2 = "A1-A2-M2"
path3 = "B1-B2-M2"
path4 = "A2-M2-B2-B3-A3"
= " " * (
sd:region(path1, "yellow") +
sd:region(path2, "blue") +
sd:region(path3, "blue") +
sd:region(path4, "green") +
sd:polygon(path1) +
sd:polygon(path2) +
sd:polygon(path3) +
sd:polygon(path4)
)
--]==]
-- (find-dn6 "diagforth.lua" "newnode:at:")