NOTE: I'm leaving this post here because it has the code, but I myself prefer @Verbeia's last version.
The ad!
Pieced together from existing bits, here's one possibility. This is a start.
Please upvote if you think it's ready to be used. Please do comment if you think something needs to be changed first (I'll update the post with the changes). Or even better: make the changes and post another variation. (Note that everything I used here is borrowed from other posts.)
The usual "Help this community grow" line (that's used by SE in their in-house ads) can seem a little boring, but I think it immediately makes it clear that this is not an advertisement for Mathematica the program, but for a Mathematica QA site.
Posting the ad on graduated SE sites
I am going to post it on Physics.SE, Math.SE and CrossValidated if it gets enough upvotes here (say, clearly more than the parent question). Instead I propose that the people who post the upvoted ads should be high rep users on the respective sites, so the ads are received better. @J.M. has high rep on Math.SE, @DavidZaslavsky is a mod on Physics and @whuber is a mod on CrossValidated. Are you willing to post these yourself, when the ads are ready (please reply in comments)? Finally what do you think about advertising on Theoretical CS as well?
Full code
Full code follows (copy, paste and evaluate). I chose to make it fully in Mathematica so everyone on this site can easily contribute and can easily change things. Upscaling and doing an ImageResize ensures that everything has a uniform, platform-independent smooth look and that the polygons in the logo are joined without white "cracks" inbetween them. Note that for now I used the font Candara which might not be present on your system (if you have Windows or Office (even on Mac), it's very likely you have it already).
p = Polygon[
Table[N[{Cos[t], Sin[t]}], {t, \[Pi]/10, 2 \[Pi], (2 \[Pi])/5}]];
triangulate =
Polygon[v_] :> (Polygon[Append[#, Mean[v]]] & /@
Partition[v, 2, 1, {1, 1}]);
moretriangles =
Polygon[{a_, b_, c_}] :>
With[{ab = (a + b)/2, bc = (b + c)/2,
ca = (c + a)/2}, {Polygon[{a, ab, ca}], Polygon[{ab, b, bc}],
Polygon[{c, ca, ab}], Polygon[{c, ab, bc}]}];
shrink = Polygon[{a_, b_, c_}] :>
With[{aa = (6 a + b + c)/8, bb = (a + 6 b + c)/8,
cc = (a + b + 6 c)/8}, {Polygon[{a, b, bb, aa}],
Polygon[{b, c, cc, bb}], Polygon[{c, a, aa, cc}],
Polygon[{aa, bb, cc}]}];
curve = Polygon[v_] :>
FilledCurve[
Line[Map[{10 - #, #}/10 &, Range[0, 10]].#] & /@
Partition[v, 2, 1, {1, 1}]];
f[r_] := Re[(ArcSin[2 r - 1] + \[Pi]/2)/2];
bolics = v : {_?NumberQ, _} :> f[Norm[v]] v;
colour3[s_: LightGray] := q : Polygon[{_, _, _}] :> {s, q}
PolygonCentroid[pts_?MatrixQ] :=
With[{dif = Map[Det, Partition[pts, 2, 1, {1, 1}]]},
ListConvolve[{{1, 1}}, Transpose[pts], {-1, -1}].dif/(3 Total[dif])]
colour4[s_: "SouthwestColors"] :=
Polygon[v_] /;
Length[v] == 4 :> {ColorData[
s, (7 Norm[PolygonCentroid[v], 2] - 2)/4], Polygon[v]}
logo = Graphics[
p /. triangulate /. moretriangles /. shrink /. shrink /.
colour3[] /. colour4[] /. curve /. bolics]
logosize = 5;
logoposition = 11.5;
ad = Show[logo, Axes -> False, Frame -> True, FrameTicks -> False,
PlotRange -> 1/logosize {{-11, 11}, {0, 25} - logoposition},
Epilog -> {Text[Style["\!\(\*
StyleBox[\"Mathematica\",\nFontSlant->\"Italic\"]\).SE",
FontWeight -> Bold, FontSize -> Scaled[1/10],
FontFamily -> "Candara"], Scaled[{0.5, 0.09}]],
Text[
Style["Help this community grow!",
FontSize -> Scaled[1/(10 Sqrt[2])], FontFamily -> "Candara",
FontColor -> Gray], Scaled[{0.5, 0.89}]]}];
adimg = ImageResize[
Rasterize[ad, "Image", ImageResolution -> 3 72], {220, 250}]
