Text Mapping Very Slow

Question

I want to change the transformation in the following code (from Dr. belisarius here) so that the word "circle" goes outward from the rightmost position of the circle and rotates counterclockwise as does my handwritten "circle" in the graph:

The code of Dr. belisarius:

Module[{l = 
Cases[First[First[ImportString[ExportString[Style["CIRCLE", Bold, FontFamily -> "Courier", 
     FontSize -> 12], "PDF"], "TextMode" -> "Outlines"]]], 
FilledCurve[a__] :> {EdgeForm[Black], Yellow, FilledCurve[a]}, Infinity]}, 
Animate[Graphics[{Red, Circle[{0, 0}, 1.5], {l /. {x_Real, y_Real} :> 
   y^(1/10) { Sin[t + 1/100 Norm[x, y]], 
              Cos[t + 1/100 Norm[x, y]]}}}], {t, 0, 2 Pi}, 
AnimationRunning -> False, SaveDefinitions -> True]]

In other words, instead of the mapping

{x,y}:> 
y^(1/10) { Sin[t + 1/100 Norm[x, y]], 
          Cos[t + 1/100 Norm[x, y]]}}}], {t, 0, 2 Pi}

what is the mapping that will make the text read outward from the center of the circle?

Using FindGeometricTransform I can get the transformation but not in a general form. If I put FindGeometricTransform in the code then it is excruciatingly slow. Any ideas? Slow code:

Module[{l = 
   Cases[First[
     First[ImportString[
       ExportString[
        Style["CIRCLE", Bold, FontFamily -> "Courier", 
         FontSize -> 12], "PDF"], "TextMode" -> "Outlines"]]], 
    FilledCurve[a__] :> {EdgeForm[Black], Yellow, FilledCurve[a]}, 
    Infinity]},
 Animate[Graphics[{Red, Circle[{0, 0}, 30], {l /. {x_Real, y_Real} :>
       FindGeometricTransform[{
           RotationMatrix[t].{20, 0}, RotationMatrix[t].{30, 0}, 
           RotationMatrix[t + b].{30, 0}, 
           RotationMatrix[t + b].{20, 0}},
          {{0, 3}, {32, 3}, {32, 8}, {0, 8}}][[2]]@{x, y}}}, 
   Axes -> True], {t, 0, 2 Pi}, {{b, Pi/24}, Pi/64, Pi/2}, 
  AnimationRunning -> False, SaveDefinitions -> True]]

Try something like {x,y} :> (0.7 + 0.025 x) {Cos[t + 0.05 y], Sin[t + 0.05 y]} — Simon Woods, Feb 10 '17 at 20:16

score 2 · Accepted Answer · edited Feb 12 '17 at 14:04

Pursuant to Simon Woods's answer, this works nicely:

Module[{l = 
   Cases[First[
     First[
      ImportString[
       ExportString[
        Style["CIRCLE", 
         Bold, FontFamily -> "Courier", 
         FontSize -> 12], "PDF"], "TextMode" -> "Outlines"]]], 
    FilledCurve[a__] :> {EdgeForm[Black], Yellow, FilledCurve[a]}, 
    Infinity]},
 Animate[Graphics[{Red, Circle[{0, 0}, 2], {l /. {x_Real, y_Real} :>
       (0.7 + 0.025 x) {Cos[t + 0.05 b y], Sin[t + 0.05 b y]}}}, 
   Axes -> True],
 {t, 0, 2 Pi},
 {{b, .5}, .01, 1}, 
  AnimationRunning -> False, SaveDefinitions -> True]]

Text Mapping Very Slow

1 Answers1