Warning: this is an htmlized version!
The original is here, and
the conversion rules are here.
-- canvas2.lua
-- Eduardo Ochs, 2010dec28
-- This file: (find-angg "LUA/canvas2.lua")
--    http://angg.twu.net/LUA/canvas2.lua
--    http://angg.twu.net/LUA/canvas2.lua.html

-- «.Class»	(to "Class")


-- (find-es "lua5" "setvbuf")
io.stdout:setvbuf("no")  -- sync errors

-- Basic functions.

string.trim = function (str)
    local nspaces = string.reverse(str):match("[ \t]*()") - 1
    return string.sub(str, 1, #str - nspaces)
  end
string.adjustto = function (str, len)
    str = string.sub(str, 1, len)
    if #str < len then str = str .. string.rep(" ", len - #str) end
    return str
  end
string.replace = function (str, other, pos)
    local left = string.sub(str, 1, pos - 1)
    if #left < pos - 1 then left = left .. string.rep(" ", pos - #left - 1) end
    local right = string.sub(str, pos + #other)
    return left .. other .. right
  end
table.transpose = function (T)
    local TT = {}
    for k,v in pairs(T) do TT[v] = k end
    return TT
  end
table.swaps = function (T, swaps)
    if swaps then
      for _,ab in ipairs(swaps) do
        local a, b = ab[1], ab[2]
        T[a], T[b] = T[b], T[a]
      end
    end
    return T
  end
table.size = function (T)
    for i=1,10000000 do if T[i] == nil then return i-1 end end
  end
table.negsize = function (T)
    if not T[1] then return nil end
    for i=1,-10000000,-1 do if T[i] == nil then return i+1 end end
  end
table.assert = function (T, n, filler)
    if n >= 1 then 
      for i=1,n do T[i] = T[i] or filler end
    else
      for i=1,n,-1 do T[i] = T[i] or filler end
    end
  end
table.replace1 = function (T, str, x, y)
    table.assert(T, y, "")
    T[y] = string.replace(T[y], str, x)
    return T
  end
table.replacemany = function (T, otherT, x, y)
    for i=table.negsize(otherT),table.size(otherT) do
       table.replace1(T, otherT[i], x, i+(y or 1)-1)
    end
    return T
  end

string.tocanvas = function (str, initialy)
    local T = {}
    for i,li in ipairs(splitlines(str)) do  
      table.replace1(T, li, 1, i+(initialy or 1)-1)
    end
    return T
  end
canvastostring = function (T)
    return table.concat(T, "\n", table.negsize(T), table.size(T))
  end


-- Tests for the basic functions.

assert(string.trim("abcd  ") == "abcd")
assert(string.trim("abcde") == "abcde")

assert(string.adjustto("abcdef", 4) == "abcd")
assert(string.adjustto("abcdef", 8) == "abcdef  ")

assert(string.replace("abcdef", "CD", 3) == "abCDef")
assert(string.replace("ab",     "CD", 3) == "abCD")
assert(string.replace("a",      "CD", 3) == "a CD")

assert(table.concat(table.transpose({on=1, tw=2, th=3}), " ") == "on tw th")
assert(table.concat(table.swaps({10, 20, 30, 40}, {{3, 4}})) == "10204030")

A = {[-5]=-50, [-3]=-30, [-2]=-20, [-1]=-10, [0]=0, 10, 20, 30, 40, 50, nil, 70}
assert(table.negsize(A) == -3)
assert(table.size(A)    ==  5)

strA = "-1\n0\n1\n2"
strB = "a\nb\nc"
assert(strA:tocanvas(-1)[-1] == "-1")
assert(canvastostring(strA:tocanvas(-1)) == strA)

CA = strA:tocanvas(-1)
CB = strB:tocanvas(0)
assert(canvastostring(table.replacemany(CA, CB, 3, 1)) == "-1\n0 a\n1 b\n2 c")
CA = strA:tocanvas(-1)
CB = strB:tocanvas(0)
assert(canvastostring(table.replacemany(CA, CB, 2, -1)) == " a\n-b\n0c\n1\n2")





-- «Class»  (to ".Class")
-- A very simple object system.
-- For detailed documentation see:
--   (find-dn6 "eoo.lua")
--   (find-blogme4file "eoo.lua")
-- The metatable of each object points to its class,
-- and classes are callable, and act as creators.
-- New classes can be created with, e.g.:
--   Circle = Class { type = "Circle", __index = {...} }
-- then:
--   Circle {size = 1}
-- sets the metatable of the table {size = 1} to Circle,
-- and returns the table {size = 1} (with its mt modified).

-- Based on: (find-angg "LUA/tostring.lua")
-- See also: (find-angg ".emacs.templates" "class")

Class = {
    type   = "Class",
    __call = function (class, o) return setmetatable(o, class) end,
  }
setmetatable(Class, Class)

otype = function (o)
    local mt = getmetatable(o)
    return mt and mt.type or type(o)
  end

Canvas = Class {
  type    = "Canvas",
  __index = {
    miny = function (C) return table.negsize(C) end,
    maxy = function (C) return table.size(C) end,
    width = function (C)
        local w = 0
        for y=C:miny(),C:maxy() do w = math.max(w, #C[y]) end
        return w
      end,
    tostring = function (C) return canvastostring(C) end,
    draw = function (C, obj, x, y)
        if type(obj) == "string" then table.replace1(C, obj, x, y)
        elseif type(obj) == "table" then table.replacemany(C, obj, x, y)
        end
        return C
      end
  },
}

CanvasFrom = function (str, initialy)
    return Canvas(string.tocanvas(str, initialy))
  end


-- Tests

C = Canvas {[0]="0", "1", "2"}
assert(C:tostring() == "0\n1\n2")
assert(C:miny() == 0)
assert(C:maxy() == 2)
CA, CB = CanvasFrom("0\n1\n2", 0), CanvasFrom("a\nb\nc", 1)
CA, CB = CanvasFrom("0\n1\n2", 0), CanvasFrom("a\nb\nc", 1)
CC     = CA:draw(CB, 4, 1)
assert(CC:tostring() == "0\n1  a\n2  b\n   c")
assert(CC:width()    == 4)




-- The shapes of my DAGs can be described more easily with strings.
-- For example, the "Reh" dag has its four nodes placed like this:
--    1
--   2 3
--   4
-- Its arrows are {{1, 2}, {1, 3}, {2, 4}}, and this can be extracted
-- from the string with the function shapetoarrows, below.
-- Once we have the list of arrows we have a way to calculate the
-- interior of an arbitray subset of {1, 2, 3, 4}, and once we have
-- the interior and binstrings[4] = {"0000", "0001", ...} we can 
-- obtain all the open subsets of {1, 2, 3, 4}, by calculating the
-- interior of all the arbitrary subsets.

binstrings = {}
binstrings[1] = {"0", "1"}
for i=2,7 do
  binstrings[i] = {}
  for _,v in ipairs(binstrings[i-1]) do
    table.insert(binstrings[i], v.."0")
    table.insert(binstrings[i], v.."1")
  end
end
assert(binstrings[6][63] == "111110")

cton = function (c) return tonumber(c, 36) end
intoshape = function (shape, short)
    local f = function (c) return short:sub(cton(c), cton(c)) end
    return (shape:gsub("(%w)", f))
  end
shapetoarrows = function (shape)
    local lines = splitlines(shape)
    local arrows = {}
    local coords = {}
    local f = function (c1, c2)
        if c1 and c2  then table.insert(arrows, {c1, c2}) end
      end
    for y=1,#lines-1 do
      for x=1,#lines[y] do
        local c  = cton(lines[y]:sub(x, x))
        local sw = cton(lines[y+1]:sub(x-1, x-1))
        local s  = cton(lines[y+1]:sub(x,   x))
        local se = cton(lines[y+1]:sub(x+1, x+1))
        f(c, sw)
        f(c, s)
        f(c, se)
      end
    end
    for y=1,#lines do
      for x=1,#lines[y] do
        local c  = cton(lines[y]:sub(x, x))
	if c then coords[c] = {x, y} end
      end
    end
    return arrows, coords
  end
arrowstostring = function (arrows)
    return table.concat(map(table.concat, arrows), " ")
  end
interior = function (short, arrows)
    local T = split(short, ".")
    for i=#arrows,1,-1 do
      local src, tgt = arrows[i][1], arrows[i][2]
      if (not T[src]) or (not T[tgt]) then
        PP("Too short!", short, arrows)
      end
      if T[src] > T[tgt] then T[src] = T[tgt] end
    end
    return table.concat(T, "")
  end
binstrings = {}
binstrings[1] = {"0", "1"}
for i=2,14 do
  binstrings[i] = {}
  for _,v in ipairs(binstrings[i-1]) do
    table.insert(binstrings[i], v.."0")
    table.insert(binstrings[i], v.."1")
  end
end

-- Tests.

reh_shape = [[
 1
2 3
4]]
reh_arrows, reh_coords = shapetoarrows(reh_shape)
assert(intoshape(reh_shape, "abcd") == " a\nb c\nd")
assert(arrowstostring(reh_arrows) == "12 13 24")
assert(interior("1001", reh_arrows) == "0001")
assert(binstrings[6][1]  == "000000")
assert(binstrings[6][63] == "111110")



-- Calculate the topology.

shapenvertices = function (shape)   -- count the digits
    return #(string.gsub(shape, "%W", ""))
  end
weightof = function (short)         -- count the "1"s
    return #(string.gsub(short, "[^1]", ""))
  end
opensetsfor = function (shape)
    local arrows    = shapetoarrows(shape)
    local nvertices = shapenvertices(shape)
    local classicaltruthvals = binstrings[nvertices]
    local opensets = {}
    local rankedopensets = {}
    for w=0,nvertices do rankedopensets[w] = {} end
    for _,short in ipairs(classicaltruthvals) do
      if short == interior(short, arrows) then
        table.insert(opensets, short)
        table.insert(rankedopensets[weightof(short)], 1, short)
      end
    end
    local ctoopenset, opensettoc = {}, {}
    local c = 0
    for w=nvertices,0,-1 do
      for _,openset in ipairs(rankedopensets[w]) do
        c = c + 1
        ctoopenset[c] = openset
        opensettoc[openset] = c
      end
    end
    return opensets, rankedopensets, ctoopenset, opensettoc
  end

-- Tests.
-- (find-sh "lua51 ~/LUA/canvas2.lua")

assert(shapenvertices(reh_shape) == 4)
assert(weightof("1100111"), 5)
reh_opens, reh_ranked, c_to_rehopen, rehopen_to_c = opensetsfor(reh_shape)
assert(table.concat(reh_opens, " ") == "0000 0001 0010 0011 0101 0111 1111")
assert(table.concat(reh_ranked[2], " ") == "0101 0011")



-- Tools for printing Heyting algebras.
-- They don't always print the right diagrams without human intervention...
-- but these tools save a lot of work.

texargs = {[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",
}

primesketch = function (shape, xscale, yscale)
    local opens, ranked, ctoop, optoc = opensetsfor(shape)
    local C = Canvas {""}
    for y=0,#ranked do
      for x=1,#ranked[y] do
        local short = ranked[y][x]
        local long = intoshape(shape, short)
        local D = CanvasFrom(long)
        C:draw(D, (x - 1) * xscale + 1, -y * yscale)
      end
    end
    return C
  end
primesketch2 = function (shape, biggershape, xscale, yscale, swaps)
    local opens, ranked, ctoopen, opentoc = opensetsfor(shape)
    local _, coords = shapetoarrows(biggershape)
    ctoopen = table.swaps(ctoopen, swaps)
    opentoc = table.transpose(ctoopen)
    local C = Canvas {""}
    for c,openset in ipairs(ctoopen) do
      local xy = coords[c]
      local x, y = xy[1], xy[2]
      local bigx, bigy = (x - 1) * xscale + 1, (y - 1) * yscale
      local D = CanvasFrom(intoshape(shape, openset))
      C:draw(D, bigx, bigy)
    end
    return C
  end
Shape = Class {
  type    = "Shape",
  __index = {
    into = function (Sh, short) return intoshape(Sh.sh, short) end,
    intoc = function (Sh, short) return CanvasFrom(Sh:into(short)) end,
    primesketch = function (Sh, xscale, yscale)
        return primesketch(Sh.shape, xscale, yscale)
      end,
    primesketch2 = function (Sh, BiggerSh, xscale, yscale, swaps)
        return primesketch2(Sh.shape, BiggerSh.shape, xscale, yscale, swaps)
      end,
    printsketch = function(Sh, xscale, yscale)
        print("Topology for "..Sh.name.." (sketch, ranked):")
        print(Sh:primesketch(xscale, yscale):tostring())
      end,
    printsketch2 = function(Sh, BiggerSh, xscale, yscale, swaps)
        print("Topology for "..Sh.name.." (as "..BiggerSh.name.."):")
        print(Sh:primesketch2(BiggerSh, xscale, yscale, swaps):tostring())
      end,
    texdef = function (Sh, lower)
        local out = ""
        local printf = function (...) out = out..format(...) end
        local w, h = Sh.width, Sh.height
        local pw = 6 * w + 2
        local ph = 12 * h
        local name = Sh.name
        local args = texargs[Sh.nvertices]
        local plower = (lower or 0) * 12
        printf("\\def\\dag%s%s{%%\n", name, args)
        printf("  \\dagpicture(%d,%d)(-4,0)[%d]{\n", pw, ph, plower)
        for i,xy in ipairs(Sh.coords) do
          local x, y = xy[1], xy[2]
          local px, py = (x-1)*6, (h-y)*12
          printf("    \\dagput(%3d,%3d){$#%d$}\n", px, py, i)
        end
        printf("  }}\n")
        return out
      end,
    texcomment = function (Sh)
        return "% "..Sh.shape:gsub("\n", "\n%% ")
      end,
    texbhbox = function (Sh)
        local testargs = texargs[Sh.nvertices]:gsub("#", "")
        return format("%s: $\\bhbox{\\dag%s %s}$", Sh.name, Sh.name, testargs)
      end,
    textest = function (Sh, lower)
        printf("%%\15\n")
        printf("%% (eedn4a-bounded)\n")
        printf("%s\n", Sh:texdef(lower))
        printf("\\edrxcolors\n")
        printf("\\def\\bhbox{\\bicolorhbox}\n")
        printf("%s\n", Sh:texbhbox())
        printf("%%\15\n")
      end,
  },
}
ShapeFrom = function (name, shape)
    local arrows, coords = shapetoarrows(shape)
    local nvertices = shapenvertices(shape)
    local opens, ranked, ctoopen, opentoc = opensetsfor(shape)
    local C = CanvasFrom(shape, 1)
    local width, height = C:width(), #C
    return Shape {
      name = name,
      shape = shape,
      arrows = arrows,
      coords = coords,
      opensets = opens,
      rankedopensets = ranked,
      width = width,
      height = height,
      nvertices = nvertices,
      shape = shape,
    }
  end

-- Tests.


Reh = ShapeFrom("Reh", [[
 1
2 3
4]])

Pot32 = ShapeFrom("Pot32", [[
 1
 2
3 4
 5 6
  7]])

-- Reh:printsketch(6, 4)
-- Pot32:printsketch(10, 6)
-- Reh:printsketch2(Pot32, 6, 4)

Lguill = ShapeFrom("Lguill", [[
 1 2
3 4
 5 6]])

-- PP(Lguill)

Lguill_prime = ShapeFrom("Lguill_prime", [[
  1
 2 3
  4 5
 6 7
8 9
 A B
  C]])

-- Lguill:printsketch(6, 4)
-- Lguill_prime:printsketch(6, 7)
-- Lguill:printsketch2(Lguill_prime, 4, 4)
Lguill:printsketch2(Lguill_prime, 4, 4, {{4, 5}})

-- Lguill = lguill_shape)



--[[
Topology for Lguill (as Lguill_prime):
         1 1
        1 1
         1 1

     1 0     0 1
    1 1     1 1
     1 1     1 1

         0 0     0 1
        1 1     0 1
         1 1     1 1

     0 0     0 0
    1 0     0 1
     1 1     1 1

 0 0     0 0
1 0     0 0
 1 0     1 1

     0 0     0 0
    0 0     0 0
     1 0     0 1

         0 0
        0 0
         0 0
--]]






-- print(primesketch2(reh_shape, bigpot_shape, 6, 4):tostring())

-- Reh = ShapeFrom("Reh", reh_shape)
-- PP(Reh)
-- print(Reh:primesketch(5, 5):tostring())
-- PP(Lguill)
-- print(Lguill:primesketch(5, 5):tostring())



-- (eejump 10)
-- (eejump 11)

-- Local Variables:
-- coding:  raw-text-unix
-- modes:   (fundamental-mode lua-mode)
-- End: