2
$\begingroup$

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:

enter image description here

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]]

enter image description here

$\endgroup$
  • 1
    $\begingroup$ Try something like {x,y} :> (0.7 + 0.025 x) {Cos[t + 0.05 y], Sin[t + 0.05 y]} $\endgroup$ – Simon Woods Feb 10 '17 at 20:16
2
$\begingroup$

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]]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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