This is some code I used to create several community ads for posts that are of interest to new users.
Feel free to use it any way you like—create your own ads, modify it, etc.
The code is in need of some cleanup, but hopefully easy enough to follow ...
Step 1 – our site logo
This code comes from this thread.
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}]}];
colour3[s_: GrayLevel[0.95, 0]] := 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_: "SunsetColors", a_?NumericQ, b_?NumericQ] :=
Polygon[v_] /;
Length[v] == 4 :> {ColorData[s, a - b Norm[PolygonCentroid[v]]],
Polygon[v]}
curve = Polygon[v_] :>
FilledCurve[
Line[Map[{10 - #, #}/10 &, Range[0, 10]].#] & /@
Partition[v, 2, 1, {1, 1}]];
bolicsn[n_] :=
v : {_?NumberQ, _} :> v Re[(ArcSin[2 Norm[v] - 1] + Pi/n)/2];
p7 = Polygon[Table[N[{Cos[t], Sin[t]}], {t, Pi/14, 2 Pi, 2 Pi/7}]];
logo = p7 /. triangulate /. moretriangles /. shrink /. shrink /.
shrink /. colour3[] /. colour4["SunsetColors", 1, 28/34];
Graphics[logo, ImageSize -> 400, Frame -> True]
Step 2 – shuffle it a bit
This idea and code is by @faleichik.
elems = SortBy[Cases[logo, {c__, Polygon[pts__]}, Infinity], First];
img = ImageCrop@
Rasterize[Graphics[logo2 = Thread[Rotate[elems, 3.0]]], "Image",
ImageResolution -> 4 72, Background -> None]
Step 3 – create background layer
backgroundLayer = Graphics[{
{
Opacity[0.3],
Inset[SetAlphaChannel[img, ImageMultiply[AlphaChannel[img], 0.4]],
Scaled[{0.65, 0.72}], Scaled[{0.5, 0.5}], 250]
},
{
FaceForm[None], EdgeForm@Directive[Black, AbsoluteThickness[2]],
Rectangle[Scaled[{0, 0}], Scaled[{1, 1}]]
}
},
PlotRange -> {{0, 300}, {0, 250}},
PlotRangePadding -> 0,
ImageMargins -> None, ImagePadding -> None,
ImageSize -> 300,
Background -> GrayLevel[0.95]
]
Step 4 – create text layer
vpos = 0.5;
textLayer =
Rasterize[
Graphics[
{
{
Black,
Text[
Style["New to Mathematica?", FontSize -> 26,
FontFamily -> "Arial Rounded MT Bold"],
Scaled[{0.5, 0.8}]
],
Text[
Framed[
TextCell[
"What are the most common pitfalls awaiting new users?",
FontFamily -> "Arial Rounded MT Bold",
FontSize -> 22],
FrameMargins -> None, FrameStyle -> None,
ImageSize -> (1 - 1/5) 300
],
Scaled[{0.04, vpos}],
{-1, 1}
]
}
},
PlotRange -> {{0, 300}, {0, 250}},
PlotRangePadding -> 0,
ImageMargins -> None, ImagePadding -> None,
ImageSize -> 300,
Background -> GrayLevel[0.95]
],
"Image",
ImageResolution -> 4 72
]
Step 5 – compose layers together
ad = Image[
ImageResize[
ImageCompose[
Rasterize[backgroundLayer, "Image", ImageResolution -> 4 72],
SetAlphaChannel[textLayer,
ColorNegate@
Erosion[ImageAdjust@ColorConvert[textLayer, "Grayscale"], 3]]
],
{600, 500}
],
Magnification -> 0.5
]
Result
