Mdthbs

Our good friend hal made a logo for WL as part of a Community Ad:

The logo itself is much nicer than the bland Wolfram wolf, of course, but one has to wonder: what's the geometrical inspiration behind it and how could I make it in Mathematica?

The logo is indeed constructed geometrically from simple rules, but let me go a bit into detail. It took quite some time with pen and paper to figure out exactly what I wanted. I traced some pictures of real wolves and looking at these pictures, it became quite clear that their ears, cheekbones and nose are prominent features. Eyes are important too, but I want to use the logo for file-icons and therefore, it needs to be rather simple to make it look good in a 16x16 resolution.

After realizing that a detailed wolf won't work, I concentrated on the basics and after some hours, I had an idea to base everything on a circle with equally distributed points. My idea was to construct everything with lines going through these points. After many sketches, I came up with this (of course on paper):

Each of the corner points is either a point on the circle or an intersecting point of lines going through points on the circle. In grey, you see the underlying helping lines. The good thing is, that we need only 3 basic ingredients:

• the points on the circle


• a way to form a line equation


• functions for calculating the intersection between two lines

This can be given in Mathematica code as

dphi = 2 Pi/24;

p = Table[{Cos[phi], Sin[phi]}, {phi, -Pi/2, Pi/2, dphi}];



reflectY[{x_, y_}] := {-x, y};

line[{x1_, y1_}, {x2_, y2_}] := (y2 - [FormalY])*(x2 - x1) - (y2 - y1)*(x2 - [FormalX]);

point[l1_, l2_] := {[FormalX], [FormalY]} /. 

   First@Solve[{l1 == 0, l2 == 0}, {[FormalX], [FormalY]}];

After this, I only translated what I had on paper

poly1 = {

   p[[9]],

   point[line[p[[4]], p[[9]]], line[p[[-1]], reflectY[p[[10]]]]],

   p[[-1]],

   point[line[p[[-1]], p[[5]]], line[reflectY[p[[5]]], p[[9]]]]

   };

poly2 = {

   point[line[p[[1]], p[[9]]], line[reflectY[p[[2]]], p[[7]]]],

   point[line[reflectY[p[[2]]], p[[7]]], line[p[[10]], p[[9]]]],

   p[[9]]

   };

poly3 = {

   p[[2]], {0, 0}, reflectY[p[[2]]], point[line[p[[2]], p[[4]]], 

   line[reflectY@p[[2]], reflectY@p[[4]]]]

   };

These are the 3 polygons you see above and to get the full logo, we need to reflect top two polygons. However, this is basically all we need

Graphics[

 {

  RGBColor[0.780392, 0.329412, 0.313725],

  Polygon /@ {poly1, poly2, reflectY /@ poly1, reflectY /@ poly2, 

    poly3}

  },

 AspectRatio -> Automatic

 ]

And that's about it. Put a nice circle around it and start up Blender and you can easily create this