Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Edit: This is apparently only a problem on a mac running OSX.

I am trying to use the 'stretchText' function by Jens. But when I use it in manipulate, the output keeps updating without changing anything.

This is the simplest example in which the problems occurs:

Manipulate[
 choice;

 Graphics[{
   stretchText["{", {0, 0}, {.1, 1}]
   }],

 {{choice, "b"}, {"a", "b"}},

 Initialization -> {
   stretchText[char_, pos_, scale_, angle_ : 0] := 
     Module[{g, coords, xMin, xMax, yMin, yMax}, 
      g = First@
        First@ImportString[ExportString[char, "PDF"], 
          "TextOutlines" -> True]; 
      coords = 
       Apply[Join, 
        Cases[g, FilledCurve[___, p_] :> Flatten[p, 1], 
         Infinity]]; {{xMin, xMax}, {yMin, yMax}} = 
       Map[{Min[#], Max[#]} &[#] &, Transpose[coords]]; 
      Rotate[Inset[
        Graphics[g, PlotRange -> {{xMin, xMax}, {yMin, yMax}}, 
         If[ListQ[scale], AspectRatio -> Full, 
          AspectRatio -> Automatic]], pos, {xMin, yMin}, scale], 
       angle]];
   }]

What can I do to stop the endless updating?

share|improve this question
add comment

1 Answer

up vote 5 down vote accepted

The problem seems to lie somewhere in some part of the PostScript/PDF conversion system that is tagged for dynamic updating. I'm not sure why it is that way. One workaround is to cache (memoize) the text as it is converted, like this:

Clear[getCurve];
getCurve[s_String] := getCurve[s] = 
   First@First@
     ImportString[ExportString[s, "PDF"], "TextOutlines" -> True];

Manipulate[

 choice;
 stretchText["{", {0, 0}, {.1, 1}, 0], {{choice, "b"}, {"a", "b"}},

 {{stretchText, stretchText}, None}, 
 Initialization :> {stretchText[char_, pos_, scale_, angle_] := 
     Module[{g, coords, xMin, xMax, yMin, yMax, r},
      g = getCurve[char];
      coords = 
       Apply[Join, Cases[g, FilledCurve[_, p_] :> Flatten[p, 1], Infinity]];
      {{xMin, xMax}, {yMin, yMax}} = Map[{Min[#], Max[#]} &[#] &, Transpose[coords]];
      Graphics@
       Rotate[Inset[
         Graphics[g, PlotRange -> {{xMin, xMax}, {yMin, yMax}}, 
          If[ListQ[scale], AspectRatio -> Full, 
           AspectRatio -> Automatic]], pos, {xMin, yMin}, scale], 
        angle]];}]

Edit: There was an unnecessary Dynamic@ in front of stretchText["{",...] I removed.

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.