From: Bill on
Text on a curve


Hi:

Using the following Mathematica 6.0.1 code, I get a nice picture as follows:

Module[{f, fs, t}, f[t_] = {Cos[t] + Sin[t], Sin[t]};
fs[t_] = D[f[t], t] // N;
h = Graphics[Rotate[Style[Text["
T"], 14], 90 Degree]];
Show[Graphics[{Arrowheads[{{Automatic, Automatic, h}}], {Red,
Arrow /@
MapThread[{#1 +
0.001 #2, (#1 -
2 #2)} &, {f /@ #, ({-1, 1} Reverse[#]/21) & /@ (#/
Sqrt[#.#] & /@ (fs /@ #))} &[#]]}, {Thickness[0.005], {Blue,
Line[f /@ #]}}} &[
Table[\[Rho], {\[Rho], 0.0, 2*Pi // N, 2*Pi/26 // N}]]],
AspectRatio -> Automatic, Axes -> True,
PlotRange -> {{-1.6, 1.6}, {-1.6, 1.6}}, ImageSize -> 500]]

Question: How can the code be modified to place selected letters at different positions, forming a sentence around the curve, such as:

~Typing onto a curve



Thanks,

Bill

From: David Park on
Here is a solution using the Presentations package. A fuller solution with
more detailed explanation should appear in a few days on Peter Linday's
site:

http://blackbook.mcs.st-and.ac.uk/~Peter/djmpark/html/

at the University of St Andrews School of Mathematics and Statistics:

http://www.mcs.st-and.ac.uk/

There are both Mathematica notebooks and PDF files there for solutions to
various MathGroup questions.

To put text around a curve it is probably best to use a unit speed
parametrization for the curve, to use a mono-space character font, and to
confine the text to portions of the curve where it will read right side up
and left to right. For those who have Presentations, here is a solution:

Needs["Presentations`Master`"]

curve[t_] := {Cos[t] + Sin[t], Sin[t]}
v[t_] = Simplify[Norm[curve'[t]], t \[Element] Reals]
curvelength = NIntegrate[v[t], {t, 0, 2 \[Pi]}]

ClearAll[t];
First(a)NDSolve[{t'[s] == 1/v[t[s]], t[0] == 0}, t, {s, 0, curvelength}];
t[s_] = t[s] /. %

unitspeed[s_] = curve[t[s]]

Module[
{string = "We were asked to wrap some text around a curve.",
characters, numchar, point, tangent, normal, txt},
characters = Characters[string];
numchar = Length[characters];
(* Define the position, tangent and normal for character i *)
point[i_] := unitspeed[Rescale[i, {1, numchar}, {5.0, 0.5}]];
tangent[i_] := unitspeed'[Rescale[i, {1, numchar}, {5.0, 0.5}]];
normal[i_] := Normalize[Reverse[tangent[i]] {-1, 1}];

Draw2D[
{{Blue, Thick, ParametricDraw[unitspeed[s], {s, 0, curvelength}]},
Table[
(* Character at its position along the curve *)
txt =
Text[Style[characters[[i]], 14, Bold, FontFamily -> "Courier"],
point[i]];
(* Rotate so the character baseline is along the tangent *)
txt = txt // RotationTransformOp[{{1, 0}, -tangent[i]}, point[i]];
(* Translate a fixed distance along the normal away from the \
curve *)
txt // TranslateOp[-.1 normal[i]], {i, 1, numchar}]},
Frame -> True,
PlotRangePadding -> .2,
ImageSize -> 300]
]


David Park
djmpark(a)comcast.net
http://home.comcast.net/~djmpark/




From: Bill [mailto:WDWNORWALK(a)aol.com]

Text on a curve


Hi:

Using the following Mathematica 6.0.1 code, I get a nice picture as follows:

Module[{f, fs, t}, f[t_] = {Cos[t] + Sin[t], Sin[t]};
fs[t_] = D[f[t], t] // N;
h = Graphics[Rotate[Style[Text["
T"], 14], 90 Degree]];
Show[Graphics[{Arrowheads[{{Automatic, Automatic, h}}], {Red,
Arrow /@
MapThread[{#1 +
0.001 #2, (#1 -
2 #2)} &, {f /@ #, ({-1, 1} Reverse[#]/21) & /@ (#/
Sqrt[#.#] & /@ (fs /@ #))} &[#]]}, {Thickness[0.005],
{Blue,
Line[f /@ #]}}} &[
Table[\[Rho], {\[Rho], 0.0, 2*Pi // N, 2*Pi/26 // N}]]],
AspectRatio -> Automatic, Axes -> True,
PlotRange -> {{-1.6, 1.6}, {-1.6, 1.6}}, ImageSize -> 500]]

Question: How can the code be modified to place selected letters at
different positions, forming a sentence around the curve, such as:

~Typing onto a curve



Thanks,

Bill



From: dh on


Bill wrote:

> Text on a curve

>

>

> Hi:

>

> Using the following Mathematica 6.0.1 code, I get a nice picture as follows:

>

> Module[{f, fs, t}, f[t_] = {Cos[t] + Sin[t], Sin[t]};

> fs[t_] = D[f[t], t] // N;

> h = Graphics[Rotate[Style[Text["

> T"], 14], 90 Degree]];

> Show[Graphics[{Arrowheads[{{Automatic, Automatic, h}}], {Red,

> Arrow /@

> MapThread[{#1 +

> 0.001 #2, (#1 -

> 2 #2)} &, {f /@ #, ({-1, 1} Reverse[#]/21) & /@ (#/

> Sqrt[#.#] & /@ (fs /@ #))} &[#]]}, {Thickness[0.005], {Blue,

> Line[f /@ #]}}} &[

> Table[\[Rho], {\[Rho], 0.0, 2*Pi // N, 2*Pi/26 // N}]]],

> AspectRatio -> Automatic, Axes -> True,

> PlotRange -> {{-1.6, 1.6}, {-1.6, 1.6}}, ImageSize -> 500]]

>

> Question: How can the code be modified to place selected letters at different positions, forming a sentence around the curve, such as:

>

> ~Typing onto a curve

>

>

>

> Thanks,

>

> Bill

>

Hi Bill,

you need to declare a different arrowhead for each arrow. E.g.:



Module[{f, fs, t}, f[t_] = {Cos[t] + Sin[t], Sin[t]};

fs[t_] = D[f[t], t] // N;



h = Graphics[

Rotate[Style[Text["\n" <> #], {0, 100}, 14], 90 Degree]] & /@

Characters["Typing onto a curve works "];

i = 0;

Show[Graphics[{{Red, {Arrowheads[{{Automatic, Automatic, h[[++i]]}}],

Arrow[#]} & /@

MapThread[{#1 +

0.001 #2, (#1 -

2 #2)} &, {f /@ #, ({-1, 1} Reverse[#]/21) & /@ (#/

Sqrt[#.#] & /@ (fs /@ #))} &[#]]}, {Thickness[

0.005], {Blue, Line[f /@ #]}}} &[

Table[\[Rho], {\[Rho], 0.0, 2*Pi // N, 2*Pi/26 // N}]]],

AspectRatio -> Automatic, Axes -> True,

PlotRange -> {{-1.6, 1.6}, {-1.6, 1.6}}, ImageSize -> 500]]





Daniel



From: DrMajorBob on
For those who, like myself, might have searched for the "Text on a curve"
solution at the links below...

It is already posted at the first link, at the bottom of the page. Posts
go from oldest to newest, it appears. I expected the opposite (oddly
enough), so I initially thought the solution hadn't been posted yet.

The examples are individually amazing, and as a group they cover many of
the hardest graphics issues we're likely to encounter. Even if you don't
have Presentations, they illustrate a lot of useful mathematics on curves
and surfaces.

(On a less helpful note... I found no clue where David's solutions might
be found at the second link.)

Bobby

On Mon, 09 Nov 2009 04:44:59 -0600, David Park <djmpark(a)comcast.net> wrote:

> Here is a solution using the Presentations package. A fuller solution
> with
> more detailed explanation should appear in a few days on Peter Linday's
> site:
>
> http://blackbook.mcs.st-and.ac.uk/~Peter/djmpark/html/
>
> at the University of St Andrews School of Mathematics and Statistics:
>
> http://www.mcs.st-and.ac.uk/
>
> There are both Mathematica notebooks and PDF files there for solutions to
> various MathGroup questions.
>
> To put text around a curve it is probably best to use a unit speed
> parametrization for the curve, to use a mono-space character font, and to
> confine the text to portions of the curve where it will read right side
> up
> and left to right. For those who have Presentations, here is a solution:
>
> Needs["Presentations`Master`"]
>
> curve[t_] := {Cos[t] + Sin[t], Sin[t]}
> v[t_] = Simplify[Norm[curve'[t]], t \[Element] Reals]
> curvelength = NIntegrate[v[t], {t, 0, 2 \[Pi]}]
>
> ClearAll[t];
> First(a)NDSolve[{t'[s] == 1/v[t[s]], t[0] == 0}, t, {s, 0, curvelength}];
> t[s_] = t[s] /. %
>
> unitspeed[s_] = curve[t[s]]
>
> Module[
> {string = "We were asked to wrap some text around a curve.",
> characters, numchar, point, tangent, normal, txt},
> characters = Characters[string];
> numchar = Length[characters];
> (* Define the position, tangent and normal for character i *)
> point[i_] := unitspeed[Rescale[i, {1, numchar}, {5.0, 0.5}]];
> tangent[i_] := unitspeed'[Rescale[i, {1, numchar}, {5.0, 0.5}]];
> normal[i_] := Normalize[Reverse[tangent[i]] {-1, 1}];
> Draw2D[
> {{Blue, Thick, ParametricDraw[unitspeed[s], {s, 0, curvelength}]},
> Table[
> (* Character at its position along the curve *)
> txt =
> Text[Style[characters[[i]], 14, Bold, FontFamily -> "Courier"],
> point[i]];
> (* Rotate so the character baseline is along the tangent *)
> txt = txt // RotationTransformOp[{{1, 0}, -tangent[i]}, point[i]];
> (* Translate a fixed distance along the normal away from the \
> curve *)
> txt // TranslateOp[-.1 normal[i]], {i, 1, numchar}]},
> Frame -> True,
> PlotRangePadding -> .2,
> ImageSize -> 300]
> ]
>
>
> David Park
> djmpark(a)comcast.net
> http://home.comcast.net/~djmpark/
>
>
>
>
> From: Bill [mailto:WDWNORWALK(a)aol.com]
>
> Text on a curve
>
>
> Hi:
>
> Using the following Mathematica 6.0.1 code, I get a nice picture as
> follows:
>
> Module[{f, fs, t}, f[t_] = {Cos[t] + Sin[t], Sin[t]};
> fs[t_] = D[f[t], t] // N;
> h = Graphics[Rotate[Style[Text["
> T"], 14], 90 Degree]];
> Show[Graphics[{Arrowheads[{{Automatic, Automatic, h}}], {Red,
> Arrow /@
> MapThread[{#1 +
> 0.001 #2, (#1 -
> 2 #2)} &, {f /@ #, ({-1, 1} Reverse[#]/21) & /@ (#/
> Sqrt[#.#] & /@ (fs /@ #))} &[#]]}, {Thickness[0.005],
> {Blue,
> Line[f /@ #]}}} &[
> Table[\[Rho], {\[Rho], 0.0, 2*Pi // N, 2*Pi/26 // N}]]],
> AspectRatio -> Automatic, Axes -> True,
> PlotRange -> {{-1.6, 1.6}, {-1.6, 1.6}}, ImageSize -> 500]]
> Question: How can the code be modified to place selected letters at
> different positions, forming a sentence around the curve, such as:
> ~Typing onto a curve
> Thanks,
> Bill
>
>
>


--
DrMajorBob(a)yahoo.com