Message Boards Message Boards

[GIF] Infinitely happy holidays w/ shaped text

enter image description here

There are probably many approaches to geometric shaping of a text. Can you suggest an idea or a reference? Because text can be easily transformed into a graphical or geometric object in WL, we could use functions such as TransformedRegion, GeometricTransformation, ImageEffect, etc. We can also imagine creating a region and somehow confining the text to it. But text is intended to be readable (mostly), so its linearity should be preserved more or less. This leads to the known simple idea:

  1. Direct text along a curve
  2. Modulate text size locally as you go along the curve

A few nice solutions to the 1st part are given in the discussion Movable text on a curve. I will closely recreate one approach (by Michael E2) a bit updating it and introducing the 2nd part of modulation. We will build the animation you can see above at the top of this post. We start from transforming some text into a graphical object:

txtbase = ImportString[ExportString[
"infinitely happy holidays to you and yours and may all your wishes come true", "PDF"], "PDF"];
txt = First@First@txtbase;

Next is defining some range which is raw length of our text scaled by some factor to fit nicely on a given curve:

xRange = -Subtract @@ First[PlotRange /. First@AbsoluteOptions[txtbase, PlotRange]]/2.4 

And here is the curve which I shape as Infinity:

c[t_] := {2 Cos[2 ? t], Sin[4 ? t]};
ParametricPlot[c[t], {t, 0, 1}]

We need its total arclength which can be found old school or a new V10 way:

totalarclength = NIntegrate[Sqrt[c'[t].c'[t]], {t, 0, 1}]
(*12.194446940169746`*)
totalarclength = ArcLength[N@c[t], {t, 0, 1}]
(*12.194446940169746`*)

Let's find how parametric variable $t$ depends on arclength $s$ and define a normal:

invarclength = 
  NDSolveValue[{D[t[s], s] Sqrt[c'[t[s]].c'[t[s]]] == 1, t[0] == 0}, t, {s, 0, totalarclength}];

NN[t_] := {{0, -1}, {1, 0}}.c'[t]/Sqrt[c'[t].c'[t]];

This is the function that will transform text:

maptext[s_, \[CapitalDelta]n_] := 
  With[{t = invarclength[Mod[s, totalarclength]]}, c[t] + \[CapitalDelta]n NN[t]]; 

This lets you play with parameters and modulation that we defined as a simple $Sin$ function:

Manipulate[Show[
  ParametricPlot[c[t], {t, 0, 1}, PlotStyle -> Directive[Red, Opacity[.2], Dashed]],
  Graphics[Dynamic@{txt /. {x_Real, y_Real} :> maptext[-fs x/xRange - s0, 
  -fs (1 + .5 Sin[20 x/xRange - s0]) y/ xRange + \[CapitalDelta]N]}],
  PlotRange -> {{-2.1, 2.1}, {-1.1, 1.1}}, Axes -> False,  ImageSize -> 800],
 {{\[CapitalDelta]N, .15}, -1, 1}, {{s0, 0}, 0, totalarclength}, {{fs, 5, "font scale"}, 0.1, 5}]

enter image description here

In the attached notebook you can find a bit more code to make effects like shadows and produce the animation above. Share your thoughts on how you would shape text! I also encourage you to improve this or/and package your function as something like ShapedText[...] so we can share it more easily. This method here needs some integrity to include, for example, splines and depend on more clear parameters - especially for modulation. Happy holidays!

enter image description here

Attachments:
POSTED BY: Vitaliy Kaurov
5 Replies

Nicely done! Good explanation!

POSTED BY: Sander Huisman

Cool! Just a note: I think you left out the definition txt = txtbase[[1, 1]].

POSTED BY: Michael Rogers

Yep, I missed that, thanks @Michael Rogers - I added it.

POSTED BY: Vitaliy Kaurov

Your interest, Vitaliy, inspired me to revisit the old code, as I've learned a bit more about packed arrays and speed. I think we can speed this up a bit and make it a more effective interactive demonstration.

There are two important ways to speed up a graphics demonstration, GraphicsComplex and using vectorized and compiled functions to transform the (packed) array of coordinates.

To create a GraphicsComplex, we have to collect all the coordinates from txt in an array and map each pair of coordinates to its index in the array. Nearest[array -> Automatic] is a fast and easy way to do this.

coords = Cases[txt, {_Real, _Real}, Infinity];
nf = Nearest[coords -> Automatic]; (* for remapping coordinates to GraphicsComplex indices *)
txt2 = txt /. p : {_Real, _Real} :> First@nf[p];

Now the coordinates are stored in coords and txt2 consist of all the graphics primitives needed to draw the text at whatever points are specified by coords. To transform the text, we need only transform coords. The primitives txt2 never have to be changed. This is the source of the speed up. First, GraphicsComplex is handled very efficiently in rendering by the front end. Next, all that is left to do is to efficiently transform the coordinates.

To do that we want to take advantage of the fact that many basic numerical functions are vectorized (operate on vectors) efficiently or are Listable. If we can refactor the code to treat all the x-coordinates as a vector and all the y-coordinates as a vector, we can take advantage of this strength of Mathematica. These operations are especially fast on packed arrays, which you can read about in the documentation or in this article by Rob Knapp, http://library.wolfram.com/infocenter/Demos/391/.

We can speed up the unit normal NN by precomputing the derivative of c and compiling the resulting expression. It is vectorized in the sense that it takes as an argument a vector of "times" t (along the parametrization) and returns an array consisting of the normal at each time. (See note below about other minor changes.) The only change to maptext that is needed for it to take vector arguments is to transpose the result of c[{t1, t2, ..}]. With a vector t input, c[t] returns coordinates in the form {{x1, x2, ..}, {y1, y2, ..}}. Finally we separate the coordinates of the text into two vectors xx and yy for convenience.

Clear[NN, maptext];
Block[{t},    (* protect t during evaluation of definition *)
  NN = Compile[{{t, _Real, 1}}, Transpose@#] &@
    Block[{Abs = Sqrt[#^2] &}, Normalize@Cross[c'[t]]]  (* evaluate this expression before compiling *)
  ];
maptext[s_, ?n_] := With[{t = invarclength[Mod[s, totalarclength]]}, Transpose@c[t] + ?n NN[t]];
{xx, yy} = Transpose[coords];

Now maptext with vector arguments in terms of xx and yy returns the transformed coordinates. It is passed to GraphicsComplex as the first argument wrapped in Dynamic, since it is the only computation that needs dynamic updating. (And since all the points need updating, this is about as efficient a design as one can get, I think.)

Manipulate[
 Show[ParametricPlot[c[t], {t, 0, 1}, PlotStyle -> Directive[Red, Opacity[.2], Dashed]], 
  Graphics[GraphicsComplex[
    Dynamic[maptext[-fs xx / xRange - s0, -fs (1 + .5 Sin[20 xx / xRange - s0]) yy / xRange + ?N]],
    txt2]], 
   PlotRange -> {{-2.1, 2.1}, {-1.1, 1.1}}, Axes -> False, ImageSize -> 800],
 {{?N, .15}, -1, 1}, {{s0, 0}, 0, totalarclength}, {{fs, 5, "font scale"}, 0.1, 5}]

The response of this is so fast on my laptop that I prefer to hold down the Option (Alt) key while moving the s0 slider.

Note: Cross[{x, y}] rotates the vector 90 degrees to {-y, x}, the same as {{0, -1}, {1, 0}} . {x, y}. By temporarily setting Abs = Sqrt[#^2]&, the result of Normalize is automatically simplified. It's just an alternative to c'[t]/Sqrt[c'[t].c'[t]], which differentiates c three times; if repeated many times (there are over 5000 points in txt), it would slow things a bit, about 0.22 sec. on my machine to do 15000 differentiations. The code above computes the expression for NN just once, before the Manipulate is evaluated, so it makes little difference. The compiled functions would be the same.

POSTED BY: Michael Rogers

This is very skillful and instructive, @Michael Rogers, thank you for taking the time and sharing this !

POSTED BY: Vitaliy Kaurov
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract