[Date Index]
[Thread Index]
[Author Index]
Re: Text on a curve
*To*: mathgroup at smc.vnet.net
*Subject*: [mg104767] Re: [mg104758] Text on a curve
*From*: "David Park" <djmpark at comcast.net>
*Date*: Mon, 9 Nov 2009 05:44:59 -0500 (EST)
*References*: <12231782.1257682834657.JavaMail.root@n11>
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@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 at comcast.net
http://home.comcast.net/~djmpark/
From: Bill [mailto:WDWNORWALK at 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
Prev by Date:
**Re: Re: What is going on!?!**
Next by Date:
**Re: Mathematica skill level snippet(s)**
Previous by thread:
**Text on a curve**
Next by thread:
**Re: Text on a curve**
| |