On 22 Sep 2018, at 11:27, Hans Hagen <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

--

-----------------------------------------------------------------
Hans Hagen | PRAGMA ADE
Ridderstraat 27 | 8061 GH Hasselt | The Netherlands
tel: 038 477 53 69 | www.pragma-ade.nl | www.pragma-pod.nl
-----------------------------------------------------------------
___________________________________________________________________________________
If your question is of interest to others as well, please add an entry to the Wiki!

maillist : ntg-context@ntg.nl / http://www.ntg.nl/mailman/listinfo/ntg-context
webpage : http://www.pragma-ade.nl / http://context.aanhet.net
archive : https://bitbucket.org/phg/context-mirror/commits/
wiki : http://contextgarden.net
___________________________________________________________________________________