Re: [NTG-context] Metafun: Finding intersection between characters

22 Sep 2018


      On Sat, 22 Sep 2018 13:45:17 +0200
Hans Hagen  wrote:
...
On 9/22/2018 12:08 PM, Floris van Manen wrote:
...
It does not seem to work for all character combinations.
e.g. B&T works, C&T works, C&M works, but N&T does not work.
not N&M
Why would that be?
Thanks
.Floris
...
On 22 Sep 2018, at 11:27, Hans Hagen mailto:j.hagen@xs4all.nl> wrote:
On 9/22/2018 10:35 AM, Henri Menke wrote:
...
Dear list,
Challanged by a very old TeX.SX question
https://tex.stackexchange.com/questions/180510
I wanted to calculate all the intersection points between two
characters.  Therefore I ripped off the \showshape macro to load the
outlines from the font and convert them to MetaPost paths.  Then I try
to find all intersections by cutting the path.
It somewhat works but for some reason, in the MWE below two intersection
points are missing.  I also have the feeling that my implementation is
extremely inefficient.  I would very much appreciate some hints by the
MetaPost experts!
Cheers, Henri
---
\startluacode
-- That's a simple reimplemetation of the showshape macro
function outlinepaths(character)
    local fontid      = font.current()
    local shapedata   = fonts.hashes.shapes[fontid] -- by index
    local chardata    = fonts.hashes.characters[fontid] -- by unicode
    local shapeglyphs = shapedata.glyphs or { }
    character = utf.byte(character)
    local c = chardata[character]
    if c then
        if not c.index then
            return {}
        end
        local glyph = shapeglyphs[c.index]
        if glyph and (glyph.segments or glyph.sequence) then
            local units  = shapedata.units or 1000
            local factor = 100/units
            local paths  = fonts.metapost.paths(glyph,factor)
            return paths
        end
    end
end
\stopluacode
\def\mpdefineoutlines#1#2{\ctxlua{
    local char = "\luaescapestring{#1}"
    local outlines = outlinepaths("#2")
    local len = \letterhash outlines
    tex.print("path " .. char .. "[];")
    tex.print(char .. "n := " .. len .. ";")
    for i, path in ipairs(outlines) do
        tex.print(char .. "[" .. i .. "] := " .. path .. ";")
    end
  }}
\starttext
\startMPpage
pair shift; shift := (1cm,-1cm);
numeric angle; angle := 5;
\mpdefineoutlines{B}{B}
\mpdefineoutlines{T}{T}
nofill B2;
nofill B3;
eofill B1 withcolor .5[blue,white];
fill T1 shifted (shift) rotated (angle) withcolor .5[red,white];
path r;
numeric n; n := 0;
for i = 1 upto Bn:
    for j = 1 upto Tn:
        r := B[i];
        forever:
            pair q;
            r := r cutbefore (T[j] shifted (shift) rotated (angle));
            exitif length cuttings = 0;
            r := subpath(epsilon, length r) of r;
            q = point 0 of r;
            n := n + 1;
            dotlabel.urt(textext("\tfx" & decimal n), q);
        endfor;
    endfor ;
endfor ;
\stopMPpage
\stoptext
You migh find more when you go top double mode .. anyway, these 
intersection calculations are not that accurate so you normally need 
to apply some overkill.
- a bit cleaned up outlinepath function
- use document namespace
- add helper for defineoutline
- do 4 runs over the shapes (probably too many now)
- more neutral fill code
It makes a nice example for the metafun (although then I'd do it 
slightly different). We need some rounding becaus eotherwise you get 
similar points (you can add a message(q) someplace).
\startluacode
function document.outlinepaths(character)
   local chardata  = fonts.hashes.characters[true] -- by unicode
   local shapedata = fonts.hashes.shapes[true] -- by index
   local c         = chardata[character]
   if c and c.index and shapedata then
       local shapeglyphs = shapedata.glyphs or { }
       local glyph       = shapeglyphs[c.index]
       if glyph and (glyph.segments or glyph.sequence) then
           local units  = shapedata.units or 1000
           local factor = 100/units
           return fonts.metapost.paths(glyph,factor)
       end
   end
   return { }
end
function document.defineoutline(char,target)
   local outlines = document.outlinepaths(char)
   local nofpaths = #outlines
   context("path %s[] ;",target)
   context("numeric %sn ; %sn := %s ;",target,target,nofpaths)
   for i=1,nofpaths do
       context("%s[%i] := %s ; ",target,i,outlines[i])
   end
end
\stopluacode
\def\mpdefineoutlines#1#2{\ctxlua{document.defineoutline(\number`#1,"#2")}}
\starttext
\startMPpage
pair shift ; shift := (1cm,-1cm);
numeric angle ; angle := 5;
\mpdefineoutlines{B}{B}
\mpdefineoutlines{T}{T}
for i=1 upto Bn - 1 : nofill B[i] ; endfor ;
eofill B[Bn] withcolor .5[blue,white] ;
for i=1 upto Tn :
   T[i] := T[i] shifted shift rotated angle ;
endfor ;
for i=1 upto Tn - 1 : nofill T[i] ; endfor ;
eofill T[Tn] withcolor .5[red,white] ;
pair found[] ;
boolean isnew ;
numeric n ; n := 0 ;
pair rq ;
def GoForIt(expr how) =
   path r ;
   for i = 1 upto Bn :
       for j = 1 upto Tn :
           r := B[i] ;
           forever:
               pair q ;
               if how = 1 :
                   r := r cutbefore T[j] ;
               elseif how = 2 :
                   r := r cutbefore reverse T[j] ;
               elseif how = 3 :
                   r := reverse r cutbefore T[j] ;
               else :
                   r := reverse r cutbefore reverse T[j] ;
               fi ;
               exitif length cuttings = 0 ;
               r := subpath(epsilon, length r) of r ;
               q = point 0 of r ;
               isnew := true ;
               rq := round(q);
               for f=1 upto n :
                   if found[f] = rq :
                       isnew := false ;
                       exitif true ;
                   fi ;
               endfor ;
               if isnew :
                   n := n + 1 ;
                   drawdot q withpen pencircle scaled 4 ;
                   draw textext("\strut\ttbf " & decimal n) ysized 3 
shifted q withcolor white ;
                   found[n] := rq ;
               fi ;
           endfor;
       endfor ;
   endfor ;
enddef ;
for i=1 upto 4 : GoForIt(i) ; endfor ;
\stopMPpage
\stoptext
Ok, a different approach then (probably still not all points as we need 
to loop over segments but better) .. no more time now.
It also shows that we don't need lua/tex juggling as we already can have 
the paths in mp. (For sure now someone can complain that this is not 
well documented.)
\starttext
\startMPdefinitions
% will be added to metafun:
def filloutlinetext(expr o) =
         draw image (
             save n, m ; numeric n, m ; n := m := 0 ;
             for i within o :
                 n := n + 1 ;
             endfor ;
             for i within o :
                 m := m + 1 ;
                 if n = m :
                     eofill
                 else :
                     nofill
                 fi pathpart i ;
             endfor ;
         )
     enddef ;
def drawoutlinetext(expr o) =
         draw image (
             % nicer for properties
             for i within o :
                 draw pathpart i ;
             endfor ;
         )
     enddef ;
def outlinetexttopath(text o, p, n) =
         scantokens("numeric " & str n &   ";") ;
         scantokens("path "    & str p & "[];") ;
         n := 0 ;
         for i within o : p[incr(n)] := pathpart i ; endfor ;
     enddef ;
\stopMPdefinitions
\startMPdefinitions
% outlinetexttopath(Bo)(B)(Bn) ;
     %
     % Bn := listsize(T)
def showoverlapinoutlines(expr first, second) =
path p_i, p_j, s_i, s_j ;
         numeric n_i, n_j, index ;
         pair found ;
         index := 0 ;
         for i within first :
             for j within second :
                 p_i := pathpart i ; n_i := length(p_i) ;
                 p_j := pathpart j ; n_j := length(p_j) ;
                 for ii = 0 upto n_i - 1 :
                     s_i := subpath(ii,ii+1) of p_i ;
                     for jj = 0 upto n_j - 1 :
                         s_j := subpath(jj,jj+1) of p_j ;
                         found := s_i intersection_point s_j ;
                         if intersection_found :
                             index := index + 1 ;
                             drawdot found withpen pencircle scaled 4 
withtransparency (1,.5);
                             draw textext("\strut\ttbf " & decimal 
index) ysized 3 shifted found withcolor white withtransparency (1,.5);
                         fi ;
                     endfor ;
                 endfor ;
             endfor ;
         endfor ;
enddef ;
\stopMPdefinitions
\startMPpage
picture first  ; first  := outlinetext.p("N") ; first  := first 
scaled 10 ;
     picture second ; second := outlinetext.p("T") ; second := second 
scaled 10 ;
second := second rotatedaround(center second, 5) shifted (1,-1) ;
filloutlinetext(first ) withcolor .5[blue,white] ;
     filloutlinetext(second) withcolor .5[red,white] ;
drawoutlinetext(first ) ;
     drawoutlinetext(second) ;
showoverlapinoutlines(first, second) ;
\stopMPpage
\startMPdefinitions
def showoverlap(expr f, s) =
         picture first  ; first  := outlinetext.p(f) ; first  := first 
scaled 10 ;
         picture second ; second := outlinetext.p(s) ; second := second 
scaled 10 ;
filloutlinetext(first ) withcolor .5blue ;
         drawoutlinetext(first ) ;
filloutlinetext(second) withcolor .5red  ;
         drawoutlinetext(second) ;
showoverlapinoutlines(first, second) ;
     enddef ;
\stopMPdefinitions
\startMPpage
     showoverlap("N","T") ;
\stopMPpage
\startMPpage
     showoverlap("\$","Q") ;
\stopMPpage
\startMPpage
     showoverlap("\tttf ABC","\tttf PQR") ;
\stopMPpage
\stoptext
Take a look, also, at the crossingunder macro in mp-tool.mpiv

Alan

Re: [NTG-context] Metafun: Finding intersection between characters

Alan Braslau