9

This is a thread where you can share your Mathematica code, graphics template, or whatever other source material that you used to create a community ad (if you wish to do so).

The purpose is to make it easier for others to create similar ads, or to update your ad in the future if the need arises. For example, between 2015 and 2016 the size requirement for ads has changed. As a result, our site was left only with a few ads, as the authors of the old ones didn't have time to update them. Such problems can be mitigated by working together and sharing our source material.

| |
7

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

| |
5

This is the code I used to make a community ad for the tag. Feel free to use it any way you wish, make more ads, improve it, etc.

SeedRandom[42];
pts = RandomReal[1, {100, 2}];
Do[ (* Lloyd relaxation *)
 pts = RegionCentroid /@ MeshPrimitives[
    VoronoiMesh[pts, {{0, 1}, {0, 1}}],
    2
    ],
 {5}
 ]

(* radial brightness falloff *)

funRad[{x_, y_}] := .7 - 1.1 Sqrt[(x - .5)^2 + (y - .5)^2]

(* cut off this much at the edges of the square image; target aspect ratio: 250/300 *)
dx = 0.1;
dy = (1 - (1 - 2 dx) 25/30)/2;

SeedRandom[44]
mesh = DelaunayMesh[pts~Join~Tuples[{0, 1}, 2]];
font = Sequence[FontWeight -> Plain, 
   FontFamily -> "Arial Rounded MT Bold"];
s = 0.0055; (* text shadow offset *)
a = 1.4; (* vertical shadow offset correction *)
g = Graphics[
  {
   Append[#, 
      VertexColors -> (ColorData["FuchsiaTones"][#] &) /@ (RandomReal[
           0.2 {-1, 1}, 3] + funRad@RegionCentroid[#])] & /@ 
    MeshPrimitives[mesh, 2],
   {
    Text[Style["Art with\nMathematica?", Black, font, FontSize -> 36, 
      LineSpacing -> {0.8, 0}], Scaled[{0.5, 0.7} + {s, -a s}]],
    Text[Style["Art with\nMathematica?", White, font, FontSize -> 36, 
      LineSpacing -> {0.8, 0}], Scaled[{0.5, 0.7}]],

    Text[Style[
      "\[LeftDoubleBracket]generative-art\[RightDoubleBracket]", 
      Black, font, FontSize -> 24, LineSpacing -> {0.75, 0}], 
     Scaled[{0.5, 0.33} + {s, -a s}]],
    Text[Style[
      "\[LeftDoubleBracket]generative-art\[RightDoubleBracket]", 
      White, font, FontSize -> 24, LineSpacing -> {0.75, 0}], 
     Scaled[{0.5, 0.33}]]
    },
   {
    EdgeForm@Directive[Black, AbsoluteThickness[3]], FaceForm[None],
    Rectangle[Scaled[{0, 0}], Scaled[{1, 1}]]
    }
   },
  PlotRange -> {{dx, 1 - dx}, {dy, 1 - dy}},
  ImageSize -> {300, 250}
  ]

(* convert to 2x resolution image and antialias at an extra 2x *)
img = ImageResize[
  Rasterize[g, "Image", ImageResolution -> 4 72],
  {600, 500}
  ]

| |
  • This one used to be a separate post. I deleted that to bring all community ad stuff into the same thread. – Szabolcs Jul 14 '16 at 10:42
3

This is the code for the PackageData as of 15/7/2016. This ad is served from Wolfram Cloud and is regenerated every time it is loaded. That's why the code below returns a link to Wolfram Cloud rather than the graphics itself.

packages = Import["http://packagedata.net/index.php/api/packages", "JSON"];
sortedPackages = SortBy[packages, DateList["timestamp" /. #] &];
indexedPackages = MapThread[Prepend[#2, "nr" -> #] &, {Range@Length[sortedPackages], sortedPackages}];
filteredPackages = Select[indexedPackages, StringLength["name" /. #] < 25 &];

hexToRGB = RGBColor @@ (IntegerDigits[ToExpression@StringReplace[#, "#" -> "16^^"], 256, 3]/255.) &;

CloudDeploy[
 APIFunction[{}, With[{package = RandomChoice[filteredPackages]},
    Graphics[{
      hexToRGB["#dff0d8"],
      EdgeForm[{Thick, Darker@hexToRGB["#dff0d8"]}],
      Rectangle[{0, 400}, {600, 500}],
      Black,
      Text[
       Style["PackageData.net"
        , FontFamily -> "Courier"
        , FontSize -> 40
        ], {310, 450}],
      hexToRGB["#d9edf7"],
      EdgeForm[{Thick, Darker@hexToRGB["#d9edf7"]}],
      Rectangle[{20, 20}, {580, 380}],
      Black,
      Text[
       Style["Package nr. " <> ToString["nr" /. package]
        , FontFamily -> "Courier"
        , FontSize -> 30
        ], {300, 330}],
      Black,
      Thick,
      Line[{{100, 300}, {500, 300}}],
      Text[
       Style[StringTake["name" /. package, UpTo[25]]
        , FontFamily -> "Courier"
        , FontSize -> 30
        ], {300, 250}],
      Text[
       Style[StringRiffle[Take["keywords" /. package, UpTo[2]], ", "]
        , FontFamily -> "Courier"
        , FontSize -> 20
        ], {300, 200}],
      Text[
       Style["Click to learn more"
        , FontFamily -> "Courier"
        , FontSize -> 30
        ], {300, 100}]
      }, ImageSize -> {600, 500}, PlotRange -> {{0, 600}, {0, 500}}]
    ] &, "PNG"], Permissions -> "Public"]

Ad

| |

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .