%D \module
%D   [      file=s-lan-04,
%D        version=2011.05.01,
%D          title=\CONTEXT\ Style File,
%D       subtitle=Language Environment 4,
%D         author=Hans Hagen,
%D           date=\currentdate,
%D      copyright={PRAGMA ADE \& \CONTEXT\ Development Team}]
%C
%C This module is part of the \CONTEXT\ macro||package and is
%C therefore copyrighted by \PRAGMA. See mreadme.pdf for
%C details.

%D For Mojca.

\startluacode
    local a_colormodel   = attributes.private('colormodel')

    local nodecodes      = nodes.nodecodes
    local nodepool       = nodes.pool
    local disc           = nodecodes.disc
    local glyph          = nodecodes.glyph
    local quads          = fonts.hashes.quads
    local newkern        = nodepool.kern
    local newrule        = nodepool.rule
    local newglue        = nodepool.glue

    local get_attribute  = node.has_attribute

    local tracers        = nodes.tracers
    local colortracers   = tracers and tracers.colors
    local setnodecolor   = colortracers.set

    local function identify(head,marked)
        local current, prev = head, nil
        while current do
            local id = current.id
            local next = current.next
            if id == disc then
                if prev and next.id == glyph then -- catch other usage of disc
                    marked[#marked+1] = prev
                end
            elseif id == glyph then
                prev = current
            end
            current = next
        end
    end

    local function strip(head,marked)
        for i=1,#marked do
            local prev = marked[i]
            nodes.remove(head,prev.next,true)
        end
    end

    local function mark(head,marked,what,how)
        for i=1,#marked do
            local prev = marked[i]
            local font = prev.font
            local quad = quads[font]
            head, prev = node.insert_after(head,prev,newkern(-quad/40))
            if what then
                local rule = newrule(quad/20,.75*quad,0)
                head, prev = node.insert_after(head,prev,rule)
                setnodecolor(rule,how,get_attribute(prev,a_colormodel))
            else
                local rule = newrule(quad/20,0,.5*quad)
                head, prev = node.insert_after(head,prev,rule)
                setnodecolor(rule,how,get_attribute(prev,a_colormodel))
            end
            head, prev = node.insert_after(head,prev,newkern(-quad/40))
            head, prev = node.insert_after(head,prev,newglue(0))
        end
    end

    local language_one, language_two, tag_one, tag_two

    function nodes.showhyphens(head)
        local marked_1, marked_2 = { }, { }
        if language_one then
            for n in node.traverse_id(glyph,head) do
                n.lang = language_one
            end
            lang.hyphenate(head,node.slide(head))
            identify(head,marked_1)
            strip(head,marked_1)
        end
        if language_two then
            for n in node.traverse_id(glyph,head) do
                n.lang = language_two
            end
            lang.hyphenate(head,node.slide(head))
            identify(head,marked_2)
            strip(head,marked_2)
        end
        if tag_one then
            mark(head,marked_1,true,"hyphenation:"..tag_one)
        end
        if tag_two then
            mark(head,marked_2,false,"hyphenation:"..tag_two)
        end
        return head, true
    end

    function languages.startcomparepatterns(list)
        local list = utilities.parsers.settings_to_array(list)
        tag_one = list[1]
        tag_two = list[2]
        language_one = tag_one and languages.getnumber(tag_one)
        language_two = tag_two and languages.getnumber(tag_two)
    --  nodes.tasks.appendaction("processors","words","nodes.showhyphens")
        nodes.tasks.appendaction("processors","before","nodes.showhyphens")
        nodes.tasks.enableaction("processors","nodes.showhyphens")
    end

    function languages.stopcomparepatterns()
        nodes.tasks.disableaction("processors","nodes.showhyphens")
    end

\stopluacode

\unprotect

\def\startcomparepatterns[#1]%
  {\bgroup
   \language\zerocount
   \setupalign[\v!nothyphenated]%
   \ctxlua{languages.startcomparepatterns("#1")}}

\def\stopcomparepatterns
  {\ctxlua{languages.stopcomparepatterns()}%
   \egroup}

\protect

\definecolor[hyphenation:en] [r=.8]
\definecolor[hyphenation:de] [g=.8]
\definecolor[hyphenation:nl] [b=.8]

\doifnotmode{demo}{\endinput}

\starttext

    \startcomparepatterns[en,de]
        \input tufte\par
    \stopcomparepatterns

    \startcomparepatterns[de,nl]
        \input tufte\par
    \stopcomparepatterns

\stoptext