2
$\begingroup$

Well, the question is obvious: how can I create the following e-seal (with the rotated wrapped text, inserted image etc) with Mathematica?

enter image description here

The central image is the following

enter image description here

So, the following issues should be solved:

(1). How to embed an image inside circles.

(2). How to wrap text along a circle with a specific radius and orientation. Any good ideas?!

Here is my try

g1 = Circle[{0, 0}, 1.3];
g2 = Circle[{0, 0}, 1.6];
g3 = Circle[{0, 0}, 1.7];
plot = Graphics[{{Thickness[0.008], g1}, {Thickness[0.008], g2}, {Thickness[0.018], g3}, Inset[img, {0, 0}]}];
Show[plot, ImageSize -> 300]

enter image description here

Now two main things are missing:

(a) The wrapped text inside the circles.

(b) A way to rotate the central image and control its relative size.

Any suggestions?

$\endgroup$
  • 2
    $\begingroup$ Possible duplicate? And, while this is not a duplicate, it seems to be filled with good ideas. $\endgroup$ – aardvark2012 Nov 2 '17 at 10:19
  • $\begingroup$ @aardvark2012 Well, this is not a simple duplicate, since it involves much more complex tasks. $\endgroup$ – Vaggelis_Z Nov 2 '17 at 11:54
  • $\begingroup$ It's not "much more complex". The rest is just creating circles with Graphics and inserting the image into it using Inset. I think you should show us what you have tried because I have a hard time believing that with a reputation score of more than 3000 and after having asked over 150 questions, you do not know how to even get started on this. Maybe others don't feel the same way, but I would really like to see an attempt here so that I can see what the issues really are that need solving, or otherwise I am inclined to consider it a duplicate. $\endgroup$ – C. E. Nov 2 '17 at 12:17
  • $\begingroup$ @C.E. You are absolutely right, I should have posted a try by myself (please see the edit). $\endgroup$ – Vaggelis_Z Nov 2 '17 at 13:27
  • $\begingroup$ @Vaggelis_Z Much better, thank you. $\endgroup$ – C. E. Nov 2 '17 at 13:33
6
$\begingroup$

Credit goes to this answer in the linked thread, but I used a somewhat simpler geometric transformation to wrap the text around a circle.

Maybe this will get you started (updated to include rotation of central image, clear and reload all symbols):

Clear[a, plot, intermediate]

pts = Point[1.45 ({Cos@#, Sin@#} & /@ {-Pi/2 + 1/2, 3 Pi/2 - 1/2})]
g1 = Circle[{0, 0}, 1.3, {-Pi/2 + 1/2, 3 Pi/2 - 1/2}];
g2 = Circle[{0, 0}, 1.6];
g3 = Circle[{0, 0}, 1.7];
plot[a_] = 
  Graphics[{{Thickness[0.008], g1}, {Thickness[0.008], 
     g2}, {Thickness[0.018], g3}, 
    Inset[img, {0, 0}, Center, 2, {Cos[a], Sin[a]}]}];

intermediate[a_] = Show[plot[a], ImageSize -> 300]
Clear[text]

text[txt_, p1_, p2_, p3_, p4_] :=
 With[{l = text[txt]},
  {{l /. {x_Real, y_Real} :> (p1 + y)/
       p2 {Sin[1/p3 x + p4], Cos[1/p3 x + p4]}}}]
text[txt_String] := 
 text[txt] = 
  Cases[First[
    First[ImportString[
      ExportString[
       Style[txt, Bold, FontFamily -> "Calibri", FontSize -> 12], 
       "PDF"], "TextMode" -> "Outlines"]]], 
   FilledCurve[a__] :> {EdgeForm[Black], Gray, FilledCurve[a]}, 
   Infinity]

Manipulate[
 Show[{intermediate[p5], 
   Graphics[{PointSize[Large], pts}, PlotRange -> 2], 
   Graphics[text["This is a test", p1, p2, p3, p4]]}], {{p1, 33}, 1, 
  50}, {{p2, 27}, 1, 50}, {{p3, 22}, 1, 40}, {{p4, -1}, -Pi, Pi}, {p5,
   0, 2 Pi}]

enter image description here

To get the text to wrap around the other way, you can do the following:

text2[txt_, p1_, p2_, p3_, p4_] :=
 With[{l = text[txt]},
  {{l /. {x_Real, y_Real} :> (p1 + y)/
       p2 {-Sin[1/p3 x + p4], Cos[1/p3 x + p4]}}}]
Manipulate[
 Show[{intermediate[p5], 
   Graphics[{PointSize[Large], pts}, PlotRange -> 2], 
   Graphics[text2["Test", p1, p2, p3, p4]]}], {{p1, -38.4}, -50, 
  50}, {{p2, -27}, -50, 50}, {{p3, 22}, 1, 40}, {{p4, 2.8}, -Pi, 
  Pi}, {p5, 0, 2 Pi}]

This is just a slightly modified geometric transformation.

The Manipulate is just a means to play around with the parameters, once you find appropriate values, you can stick Graphics[{text[...], text[...], text2[...]}] inside theShow` with appropriate numeric values and export the result.

$\endgroup$
  • $\begingroup$ pts is not defined somewhere in the code! $\endgroup$ – Vaggelis_Z Nov 2 '17 at 15:37
  • $\begingroup$ @Vaggelis_Z fixed (near the top of the code block) $\endgroup$ – LLlAMnYP Nov 2 '17 at 15:46
  • $\begingroup$ That's almost perfect! However the most difficult part is still missing. That is the text at the bottom between the two dots, where the text splits into two lines. I have no idea how to achieve this. $\endgroup$ – Vaggelis_Z Nov 2 '17 at 15:52
  • 1
    $\begingroup$ @Vaggelis_Z added that as well and a short pointer on how to proceed. Time to head home, I'm sure there's enough info to get to your desired result now. $\endgroup$ – LLlAMnYP Nov 2 '17 at 16:01
3
$\begingroup$

A lazy method for regenerating the shamrock would be to start from the image in the OP and use FourierCurve[] on the result of applying ImageMesh[] to it:

(* https://mathematica.stackexchange.com/a/23302 *)
PolygonCentroid[pts_?MatrixQ] := With[{dif = Map[Det, Partition[pts, 2, 1, {1, 1}]]}, 
       ListConvolve[{{1, 1}}, Transpose[pts], {-1, -1}].dif/(3 Total[dif])]

FourierCurve[x_, m_, t_, tol_: 0.01] := Module[{rat = Rationalize[#, tol] &, fc},
  fc = Take[Chop[Fourier[x, FourierParameters -> {-1, 1}]], Min[m, Ceiling[Length[x]/2]]];
  2 rat[Abs[fc]].Cos[Pi (2 Range[0, Length[fc] - 1] t - rat[Arg[fc]/Pi])]]

img = Import["https://i.stack.imgur.com/dllfB.png"];
p1 = ConnectedMeshComponents[ImageMesh[ColorNegate[img]]];

sh = MeshCoordinates[p1[[1]]]; st = MeshCoordinates[p1[[2]]];
ph = PolygonCentroid[sh]; pt = PolygonCentroid[st];

ParametricPlot[Evaluate[{ph + (FourierCurve[#, 30, t] & /@ (Transpose[sh] - ph)), 
                         pt + (FourierCurve[#, 30, t] & /@ (Transpose[st] - pt))}],
               {t, 0, 1}, Axes -> None, Frame -> True, PlotPoints -> 75]

shamrock

$\endgroup$
  • 1
    $\begingroup$ Nice but this is not what I want. I don't want to recreate the image with Mathematica. I just want to use the original image and place it inside some circles and wrapped text! $\endgroup$ – Vaggelis_Z Nov 2 '17 at 11:22
  • $\begingroup$ Then your question is indeed a dupe of the first question linked in the comments. $\endgroup$ – J. M. will be back soon Nov 2 '17 at 11:23
  • 1
    $\begingroup$ It's not really a duplicate because that question only deals with the wrapped text, while the present problem has more issues (e.g., placement of a figure, wrapped text, etc). So this is a much more complex question. $\endgroup$ – Vaggelis_Z Nov 2 '17 at 11:30

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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