How can I wrap text around a circle?

For example: the text in the sectors of this chord plot.

Perhaps one could use FilledCurve[] and then apply a GeometricTransformation[]?

  • $\begingroup$ Would a fixed-width font be acceptable? $\endgroup$
    – Mr.Wizard
    Commented May 18, 2012 at 14:44
  • $\begingroup$ Yes, assume courier. $\endgroup$
    – M.R.
    Commented May 18, 2012 at 14:57

6 Answers 6


The following response borrows shamelessly from Mr.Wizard:

  Graphics[{{Dashed, If[circle, Circle[{0, 0}, r], {}]},
      Rotate[Text[Style[#, FontFamily -> "Courier", fs], #2], 
      90° - #3] &, {txt, {-r Cos[#], r Sin[#]} & /@ (range =
      Range[0, arc, arc/(Length@txt - 1)]), range}], θ, {0,
  ContentSelectable -> True,
  PlotRange -> 3,
  PlotRangePadding -> .5,
  ImageSize -> {500, 400}, Axes -> axes],
  {{fs, 20, "font size"}, 5, 50, Appearance -> "Labeled"},
  {{r, 2, "radius"}, 0.1, 3, Appearance -> "Labeled"},
  {{arc, 2.5, "arc length"}, 0, 2 π, Appearance -> "Labeled"},
  {{θ, 0, "location on arc"}, 0, 2 π},
  {{circle, True}, {True, False}},
  {{axes, True}, {True, False}},
  Initialization :> {txt = "This is some text to wrap" // Characters;}

curved text

Note: "Arc length" is based on the unit circle. $2 \pi$, or approximately 6.28 corresponds to a $360^\circ$ arc on the unit circle. The actual full arc length will be $2\pi r$.

  • 3
    $\begingroup$ Nice extension! (I wish we had a collaboration feature as this really should replace my answer, yet both of us deserve some credit.) $\endgroup$
    – Mr.Wizard
    Commented May 18, 2012 at 16:32
  • $\begingroup$ Thanks. I was going to post my code in a comment under your response but I wanted to include a screen shot. You deserve most of the credit for having the key insights. $\endgroup$
    – DavidC
    Commented May 18, 2012 at 16:51

This places a string on the outside of a unit circle. It works for variable width fonts.

circularText[str_, ang : {a0_, a1_} : {0, 2 Pi}, scale:(_?NumericQ): 1] := 
 Module[{text, curves, pts, xrange, ymin, xrlst, subgroups, maxwidth, centers},
  (* transform string to FilledCurves *)
  text = ImportString[
     ExportString[Style[str, Bold, FontFamily -> "Helvetica", FontSize -> 12], "PDF"], 
     "TextMode" -> "Outlines"][[1, 1]];
  {curves, pts} = 
   Flatten[Cases[text, FilledCurve[a_, b_] :> {a, b}, 
     Infinity], {{2}, {1, 3}}];

  (* Find coordinate range for each character *)
  xrlst = {Min[#1], Max[#1]} & /@ pts[[All, All, 1]];
  xrange = {Min[xrlst[[All, 1]]], Max[xrlst[[All, 2]]]};
  ymin = Min[pts[[All, All, 2]]];

  (* collect curves whose xrange overlap. They indicate letters with holes. *)
  subgroups = Gather[Range[Length[xrlst]],
    (IntervalMemberQ[#1, #2] || 
         IntervalMemberQ[#2, #1]) & @@ {Interval[xrlst[[#1]]], 
       Interval[xrlst[[#2]]]} &];
  xrlst = (Interval @@ xrlst[[#]])[[1]] & /@ subgroups;

  (* calculate maximum width of all letters, and centers of each letter *)
  maxwidth = Max[xrlst[[All, 2]] - xrlst[[All, 1]]];
  centers = Mean /@ xrlst;

  (* translate and rescale points *)
  pts = MapIndexed[
    pts[[#1]] /. {a_, b_?NumericQ} :> {a - centers[[#2[[1]]]], b - ymin}/maxwidth/
          Length[subgroups] (a1 - a0) scale + {0, 1} &, subgroups];

  (* plot text *)
     Rotate[FilledCurve[#1, #2], #3, {0, 0}] &, {curves[[#]] & /@ 
       subgroups, pts, -Rescale[centers, xrange, ang]}]}]]

Here, str is the string you want to place along the circle, and scale is the scaling of the text.


string = "The brown fox jumped over the lazy dog";


Mathematica graphics


I've adapted the code. You can now specify an arc along which you want to place the text, for example

circularText[string, {-Pi/4, Pi}]

Mathematica graphics

  • 3
    $\begingroup$ So... this is a slow fox and not a quick one? $\endgroup$
    – rm -rf
    Commented May 18, 2012 at 17:29
  • $\begingroup$ @R.M Speed is relative anyway. $\endgroup$
    – Heike
    Commented May 18, 2012 at 17:36
  • 1
    $\begingroup$ @Heike, very nice. How to change the orientation of the text? I mean, how to write from left to right passing trough south? $\endgroup$
    – Sigur
    Commented Oct 31, 2014 at 13:07

Here is a starting point:

txt = "This is some text to warp." // Characters;
arc = 1;
range = Range[0, arc, arc/(Length@txt - 1)];
coords = {-Cos[#], Sin[#]} & /@ range;
   Rotate[Text[Style[#, FontFamily -> "Courier"], #2], 90° - #3] &,
   {txt, coords, range}]

Mathematica graphics

  • $\begingroup$ @R.M thanks for the edit; I wish there was a robust and convenient method for doing that. $\endgroup$
    – Mr.Wizard
    Commented May 18, 2012 at 17:10
  • $\begingroup$ I agree... I make these changes very often on the site, and I've partly automated my work with a vim script that does the replacements when it's a big code block with lots of \[blah] (see my edit here for example). For smaller ones like this and David's, I do it by hand. I keep that question in mind, because if I can fix some pending issues with what I have now and turn my script to a nicely wrapped function in mma, it'll be a robust answer, because vim is extremely portable and you can find/install it for any OS. Some day I'll get to it... $\endgroup$
    – rm -rf
    Commented May 18, 2012 at 17:23
  • $\begingroup$ Thanks everyone, this works great! $\endgroup$
    – M.R.
    Commented May 18, 2012 at 17:54

My solution, which does not try to place the letters, but rather transform the space they inhabit. This has an extra feature/bug/property that parallel lines in the letters may no longer be parallel after the transformation.

WrapText[str_, transformation_] := Module[{text},
  text = Style[str, Bold, FontFamily -> "Helvetica", FontSize -> 12, LineBreakWithin -> False];
    ImportString[ExportString[text, "PDF"], 
       "TextMode" -> "Outlines"][[1, 1]],
     FilledCurve[a__] :> FilledCurve[a],
     Infinity] /. transformation 

To run it we need to supply the appropriate transformation (it may be necessary to fiddle with the constants a bit):

transformationCircle = {x_Real, y_Real} :> {Cos[-x/(12 Pi)]*(y + 2), Sin[-x/(12 Pi)]*(y + 2)}; 
WrapText["The quick brown fox jumps over the lazy dog", transformationCircle]

Will produce:

The quick brown fox jumps over the lazy dog

It can do more funky stuff though:

transformationSpiral = {x_Real, y_Real} :> {Cos[-x/(12 Pi)]*(y + 4 + x/18),  Sin[-x/(12 Pi)]*(y + 4 + x/18)};
WrapText["All human beings are born free and equal in dignity and rights. They are endowed with reason and conscience and should act towards one another in a spirit of brotherhood.", transformationSpiral]

Results into:

The Universal Declaration of Human Rights


Modifying an example from the help on FilledCurve[]:

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

enter image description here

  • $\begingroup$ +1 What's nice about FilledCurve is that it can be used for any shape of curve. $\endgroup$
    – DavidC
    Commented May 18, 2012 at 16:23

Here's an approach that works alright with both fixed width and proportional fonts, and gives you some flexibility when it comes to the style of the text. It uses the common, hacky trick of rasterizing the text beforehand to work out the approximate sizes of the letters, and it uses the Framed option to rasterize all the letters at once so we can pick the frames out of the ImageData using cases (which is much, much faster than rasterizing the letters one by one).

sizes[text_String, style_] :=
 With[{data =
        Framed[Text[Style[#1, style]], FrameStyle -> Magenta] &,
        Characters@text], " "],
   pixel = List @@ (N@Magenta) 
  With[{row = Part[data, First@First@Position[data, pixel, 2, 1]]},
   Part[Length /@ Split[row], Span[1, All, 2]]]]

The frames are magic pink to make them even easier to pick out. Then all that remains is to draw the text on the circle. I use the relative sizes of the letters to work out the angles, and use Scaled with the FontSize option to Style to make the letters the right size in the graphics. I also introduced some (hard-coded) fudge factors to make things look OK and not get cut off; playing with them some more (or better, setting up a Manipulate to do it interactively!) may get you results you like better.

circularize[text_String, style_: "Subtitle"] :=
 With[{sizes = sizes[text, style], n = StringLength@text, 
   imageSize = 400},
    angles = 2 Pi (Accumulate@sizes - First@sizes)/Total[sizes],
    scale = 0.8*2 Pi/n
       Text[Style[#1, style, FontSize -> Scaled[scale]], 
        Through[{Sin, Cos}@#2]], -#2] &,
     {Characters@text, angles}]]

EDIT because this answer is useless without pics!

enter image description here


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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