Wadler's Blog

A tumblr of amazing images, all created via Mathematica.

Mathematica code:

Rot80 = 
 Table[
  Table[
   RotationTransform[a, {1, 1, 0}, {0, 0, 0}][Tuples[{-1, 1}, 3][[v]]],
  {v, 1, 8, 1}],
{a, 0, 2 Pi,  Pi/80}]

Edge := {1, 2, 4, 3, 7, 8, 6, 5, 1, 3, 4, 8, 7, 5, 6, 2}

CubeTrail[h_, op_, N_, s_, r_, z_, t_, PR_, IS_, C_] :=
 Graphics[
  Table[
   Scale[
    Translate[
     {AbsoluteThickness[h], Opacity[op], 
      If[C == 1, Black, White],
      Line[
       Table[
        {Rot80[[1 + Mod[t, 80]]][[Edge[[e]]]][[1]],
         Rot80[[1 + Mod[t, 80]]][[Edge[[e]]]][[2]]},
        {e, 1, 16, 1}]]},
     r{Cos[2 Pi*(n*t/80 + k)/N], Sin[2 Pi*(n*t/80 + k)/N]}],
    z^n, r{Cos[2 Pi*(n*t/80 + k)/N], Sin[2 Pi*(n*t/80 + k)/N]}],
   {k, 1, N, 1},
   {n, 1, s, 1}],
  PlotRange -> PR, ImageSize -> 500, 
  Background -> If[C == 0, Black, White]]

Manipulate[P = {h, op, N, s, r, z, t, PR, IS, C};
 CubeTrail[h, op, N, s, r, z, t, PR, 500, 0],
{{h, 1}, 0, 20}, {op, 1, 0}, 
{{N, 4}, 1, 16, 1}, {s, 1, 100, 1}, 
{{r, 3.5}, 0, 10}, {z, 1, 0},
{{PR, 5}, 1, 5}, {C, 0, 1, 1},
{t, 0, 100, 1}]

P ={1.5, 1, 4, 8, 3.8, 0.75, 0, 5, 500, 0}

Manipulate[
CubeTrail[P[[1]],P[[2]],P[[3]],P[[4]],P[[5]],P[[6]],t,P[[8]],500,0],
{t, 1, 80, 1}]