-- zdags..lua: an experimental extension to dednat5, using picture mode.
-- This file:
--   http://angg.twu.net/dednat5/zdags.lua.html
--   http://angg.twu.net/dednat5/zdags.lua
--                    (find-dn5 "zdags.lua")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
-- Version: 2011may16
-- License: GPL3
--


-- «.zdag_preamble»		(to "zdag_preamble")
-- «.simpledef»			(to "simpledef")
-- «.complexdef»		(to "complexdef")


require "eoo"         -- (find-dn5 "eoo.lua")
require "prefixes"    -- (find-dn5 "prefixes.lua")

-- (find-dn4ex "edrx08.sty" "dags")
-- (find-angg "LUA/canvas3.lua" "Scale")

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

-- «zdag_preamble»  (to ".zdag_preamble")
-- (find-angg "LUA/canvas3.lua" "defpictureFrom")
complexdef_preamble = [[
% (find-es "tex" "more-than-9-args")
\def\sa#1#2{\expandafter\def\csname myarg#1\endcsname{#2}}
\def\ga#1{\csname myarg#1\endcsname}
]]


-- \newdimen\mypictureunit
-- \setbox0=\hbox{\rm0}
-- \mypictureunit=.085\wd0
-- \mypictureunit=.084\wd0
-- %
-- \def\dagput(#1,#2)#3{\put(#1,#2){\hbox to 0pt{\hss\scriptsize#3\hss}}}
-- \def\dagpicture(#1,#2)(#3,#4)[#5]#6{{%
--   %\unitlength=.1ex%
--   %\setbox0\hbox{x}\unitlength=.1\wd0%
--   %\setbox0\hbox{x}\unitlength=.095\wd0%
--   %\setbox0\hbox{x}\unitlength=.090\wd0%
--   \unitlength=\mypictureunit
--   \lower #5\unitlength\hbox{%
--     \begin{picture}(#1,#2)(#3,#4)
--       #6
--     \end{picture}%
--   }}}



-- (find-angg "LUA/canvas3.lua" "simpledef")
-- (find-angg "LUA/canvas3.lua" "complexdef")



-- «Scale»  (to ".Scale")
Scale = Class {
  type    = "Scale",
  __index = {
    -- Defaults for a thin Zdag:
    sx =   6,     x0 = 1,
    sy = -12,  -- y0 = zdag.height,
    w0 =   2,     h0 = 0,
    xadj = 0,     yadj = 0,
    -- Methods:
    xytopxpy = function (s, x, y)
      return s.sx * (x - s.x0) + s.xadj, s.sy * (y - s.y0) + s.yadj end,
    whtopwph = function (s, w, h) return s.sx * w + s.w0, -s.sy * h + s.h0 end,
    put = function (s, x, y, mathbody)
        local px, py = s:xytopxpy(x, y)
        return format("    \\dagput(%3d,%3d){$%s$}\n", px, py, mathbody)
      end,
    puts = function (s, coords, ga)
        local T = {}
        for i,xy in ipairs(coords) do
          table.insert(T, s:put(xy[1], xy[2], ga(i)))
        end
        return table.concat(T)
      end,
    arrowxybody = function (s, coords, arrow)
        local src, tgt = arrow[1], arrow[2]
        local srcx, srcy = coords[src][1], coords[src][2]
        local tgtx, tgty = coords[tgt][1], coords[tgt][2]
        local x, y = (srcx + tgtx)/2, (srcy + tgty)/2
        local dx = tgtx - srcx
        local possiblebodies = {
          [-1] = "\\swarrow",
           [0] = "\\downarrow",
           [1] = "\\searrow",
        }
        local body = possiblebodies[dx]
        return x, y, body
      end,
    putarrows = function (s, zdag)
        local T = {}
        for i,arrow in ipairs(zdag.arrows) do
          table.insert(T, s:put(s:arrowxybody(zdag.coords, arrow)))
        end
        return table.concat(T)
      end,
    body = function (s, zdag, ga)
       return s:puts(zdag.coords, ga)
              .. (s.drawarrows and s:putarrows(zdag) or "")
      end,
    -- bodyandarrows = function (s, zdag, ga)
    --    return s:puts(zdag.coords, ga) .. s:putarrows(zdag)
    --   end,
    dagpicture = function (s, body)
        local plower = -s.sy * (s.lower or 0)
        local pw, ph = s:whtopwph(s.w, s.h)
        return format("  \\dagpicture(%d,%d)(-4,0)[%d]{\n%s  }%%\n",
                      pw, ph, plower, body)
      end,
    picture = function (s, zdag, ga)
        return s:dagpicture(s:body(zdag, ga))
      end,
    defpicture = function (s, zdag, name)
        local nargs = zdag.n
        local def, ga = nargstodefga(nargs)
        local body = s:picture(zdag, ga)
        return def(name, nargs, body) .. "%\n"
      end,
  },
}



-- «simpledef»  (to ".simpledef")
simpledef = function (name, nargs, body)
    local ha, han
    ha  = function (myn) return format("#%d", myn) end
    han = function (np)  return mapconcat(ha, seq(1, np)) end
    return format("\\def\\%s%s{%%\n%s}", name, han(nargs), body)
  end
simplega = function (myn) return format("#%d", myn) end

-- «complexdef»  (to ".complexdef")
complexdef = function (name, nargs, body)
    local ha, han, sa, saf, san, na, bg, da, dal
    ha  = function (hn)      return format("#%d", hn) end
    han = function (np)      return mapconcat(ha, seq(1, np)) end
    sa  = function (myn, hn) return format("\\sa{%d}{#%d}", myn, hn) end
    saf = function (n)
        return function (hn) return sa(5*n + hn, hn) end
      end
    san = function (n, np)   return mapconcat(saf(n), seq(1, np)) end
    na  = function (n)       return format("\\%s%s", name, ("@"):rep(n)) end
    bg  = function (n)       return n==0 and "\\begingroup" or "" end
    da = function (n)
        return format("\\def%s%s{%s%%\n", na(n), han(5), bg(n))
            .. format("  %s%s}\n",        san(n, 5), na(n + 1))
      end
    dal = function (n, np)
        return format("\\def%s%s{%%\n", na(n), han(np))
            .. format("  %s%%\n",       san(n, np))
            .. body
            .. "  \\endgroup}\n"
      end
    local T = {}
    local np = nargs
    tinsert(T, "\\makeatletter\n")  -- hacky
    for n=0,10000 do                -- hacky
      if np > 5
      then tinsert(T, da(n)); np = np - 5
      else tinsert(T, dal(n, np)); break
      end
    end
    tinsert(T, "\\makeatother\n")   -- hacky
    return table.concat(T, "")
  end
complexga = function (myn) return format("\\ga{%d}", myn) end

nargstodefga = function (nargs)
    if nargs <= 9 then
      return simpledef, simplega
    else
      return complexdef, complexga
    end
  end


-- dump-to: tests
--[==[
-- «complexdef-tests»  (to ".complexdef-tests")
* (eepitch-lua51)
* (eepitch-kill)
* (eepitch-lua51)
require "zdags"
= simpledef ("nam",   9, "% body\n")
  --> \def\nam#1#2#3#4#5#6#7#8#9{%
  --  % body
  --  }
= complexdef("name", 10, "% body\n")
  --> \makeatletter
  --  \def\name#1#2#3#4#5{\begingroup%
  --    \sa{1}{#1}\sa{2}{#2}\sa{3}{#3}\sa{4}{#4}\sa{5}{#5}\name@}
  --  \def\name@#1#2#3#4#5{%
  --    \sa{6}{#1}\sa{7}{#2}\sa{8}{#3}\sa{9}{#4}\sa{10}{#5}%
  --  %body
  --    \endgroup}
  --  \makeatother

--]==]

-- Local Variables:
-- coding:             raw-text-unix
-- ee-anchor-format:   "«%s»"
-- End: