Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

ornamental curve

How do I go about approximating this ornamental curve? Note that the curve has somewhat variable thickness as typical in calligraphy, which I would also like to replicate.

The excellent reference Handbook and Atlas of Curves by E.V. Shikin (1995) contains many tempting directions, including curve families with singular points, but none that resemble this particular closed curve, and it doesn't deal with thickness.

A single function describing the curve is desirable but piecewise definition and splines are acceptable.

share|improve this question
    
What have you tried? –  rm -rf Oct 21 '12 at 0:45
1  
I did a reverse image search on Google, I couldn't find the name of the design, but here are some more examples: goo.gl/N77lG –  Guillochon Oct 21 '12 at 0:52
    
Cubic splines can represent each of the 4 loops, which can then be assembled. See demonstrations.wolfram.com/SimpleSplineCurves –  David Carraher Oct 21 '12 at 0:54
1  
Nevermind, I found a font containing the symbol: ufonts.com/fonts/poetica-supp-ornaments.html –  Guillochon Oct 21 '12 at 0:54
1  
"This curve" is actually two curves. –  Rahul Narain Oct 21 '12 at 1:32
show 5 more comments

3 Answers

up vote 22 down vote accepted

Update

With the approach described in detail below and the function given by J. M. in his answer, we can additionally introduce points to the lines which vary randomly in their size. This gives the look and feel of a pen not drawing with constant thickness due to outrunning ink:

ParametricPlot[{{Cos[t] (2 + 7 Cos[2 t] - Cos[4 t])/8, Sin[t]^3 (3 - 2 Cos[2 t])/4}, 
   3/2 {1, Cos[t]} Sin[t]/(1 + Cos[t]^2)}, {t, 0, 2 Pi},
   Axes -> None, PlotRangePadding -> 0.1,
   Background -> ColorData["Legacy", "Antique"], PlotStyle -> Black, 
  PlotPoints -> 500, MaxRecursion -> 0] /. Line[pts_] :>
  (With[{thick = (Abs@
          Sin[Mod[ArcTan @@ Subtract @@ # + 3/4 Pi, 
            2 Pi]])}, {PointSize[thick*0.035 + RandomReal[.007]], 
       Thickness[thick*.031 + 0.004], Line[#], Point[First[#]]}] & /@ 
    Partition[pts, 2, 1])

Mathematica graphics

This is far from being perfect, but considering the fact that we only used ParametricPlot and some transformation on the Lines, it looks quite nice.

Answer

In calligraphy the variation of the thickness comes from the fountain pen and it is related to how you hold it. In the simplest case, you don't change the angle of the pen in your hand during writing and then the thickness is only dependent on the direction of your line.

With this you have 3 parameters. First one is the base-thickness which is the thinnest line you can draw. Second, you have the max-thickness which is reached when you draw a line with the full width of your pen. When you keep your pen constant in your hand and you draw a circle, then thick and thin parts change smoothly. Let us try to implement this in Mathematica.

A curve in Mathematica is often just a set of many lines. If you have two points, which are connected through a line, you can calculate its direction with the help of ArcTan[x,y]. Since the ArcTan gives values between $[-\pi/2,\pi/2]$ we need to transform this a bit to get a smooth transition of angles in all directions.

In the following we extract the points from the Line[{p1,p2,p3,..}] directives and partition them in groups of two like {{p1,p2},{p2,p3},{p3,p4},..}. We calculate the angle of the first point to the second of every tuple and use this angle to adjust the thickness of every single line

p1 = ParametricPlot[{Cos[phi], Sin[phi]}, {phi, 0, 2 Pi}];
p1 /. Line[pts_] :> 
({Thickness[(Abs@Sin[Mod[ArcTan @@ Subtract @@ #, 2 Pi]])*0.02], Line[#]} & /@ 
    Partition[pts, 2, 1])

Mathematica graphics

With your ornament you can do the same once you have found the formulas. Let me help you with the part of your curve which looks like $\infty$. This can easily expressed in parametric form

$$ f(t) = \left\{2\cos\left(\frac{t}2\right), \sin(t)\right\} $$

infty = ParametricPlot[{2 Cos[1/2 t], Sin[t]}, {t, 0, 4 Pi}]

Mathematica graphics

Now, following our approach from above and including it into a Manipulate we get:

Manipulate[
 Show[infty /. 
   Line[pts_] :> ({Thickness[(Abs@Sin[
             Mod[ArcTan @@ Subtract @@ # + direction, 2 Pi]])*
           maxThickness + baseThickness], Line[#]} & /@ 
      Partition[pts, 2, 1]),
  PlotRange -> {{-3, 3}, {-2, 2}}, AspectRatio -> Automatic, 
  Axes -> False],
 {direction, 0, 2 Pi},
 {{baseThickness, 0.005}, 0, 0.02},
 {{maxThickness, 1/50.}, 1/100., 1/30.}
 ]

Mathematica graphics

share|improve this answer
1  
Nice solution. For a pen held at fixed orientation, the thickness of the stroke should be proportional to $\lvert\sin\theta\rvert$ rather than $\sin\theta/2$ though. –  Rahul Narain Oct 21 '12 at 2:38
    
@RahulNarain Already fixed, thanks. –  halirutan Oct 21 '12 at 2:46
1  
The curve halirutan used here is the lemniscate of Gerono. –  J. M. Oct 21 '12 at 4:11
add comment

As a starting point:

ParametricPlot[{
                (* modified hypotrochoid *)
                {Cos[t] (2 + 7 Cos[2 t] - Cos[4 t])/8, Sin[t]^3 (3 - 2 Cos[2 t])/4},
                (* lemniscate of Bernoulli *)
                3/2 {1, Cos[t]} Sin[t]/(1 + Cos[t]^2)},
                {t, 0, 2 Pi}, Axes -> None, Background -> ColorData["Legacy", "Mint"],
                PlotStyle -> Directive[ColorData["Legacy", "OliveDrab"],
                                       AbsoluteThickness[3]]
               ]

composite curve

Further styling (e.g. with halirutan's method) is left as an exercise to the reader.

share|improve this answer
    
I read that as "modified hypnotoad" o-0 –  rm -rf Oct 21 '12 at 5:37
2  
@rm: damn, even you are not immune to the effects of your Gravatar... :D –  J. M. Oct 21 '12 at 5:39
add comment

If you want to get complete command over the symbol and make it available to various types of geometrical transformations and text styling, you could use FilledCurve function. If splines work for you, FilledCurve may come handy too. If you have or will install the font Poetica Supp Ornaments mentioned in the comments by @Guillochon, then you could turn the character into a graphics:

text = First[First[ImportString[ExportString[Style["L", 
         FontFamily -> "Poetica"], "PDF"], "PDF"]]];

enter image description here

You can now do some styling with it

Graphics[{Gray, Translate[text, .5 {1, 1}], Red, text}, Frame -> True]

enter image description here

or advanced transformations and morphing:

lst = Module[{l = Cases[text, FilledCurve[a__] :> {EdgeForm[Black], Darker[Red], 
      FilledCurve[a]}, Infinity]}, Table[Graphics[{l /. {x_Real, y_Real} :> 
      {x 6 Cos[x/12 + t], y 6 Sin[x/12 + t]}}, Frame -> False, PlotRange -> All, 
     ImageSize -> {400, 400}], {t, 0, 2 \[Pi], .1}]];

Export["L.gif", lst]

enter image description here

share|improve this answer
    
Hmm.. I love Linux.. especially for it's font handling. –  halirutan Oct 21 '12 at 2:45
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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