Many years later, as watching Arvind Gupta folding a 3-D flexagon, I was to remember that distant day when my father brought me a cube that I was to know it is called Yoshimoto Cube.

This 3-D flexagon is very easy to be flexed to reveal hidden faces. Let’s make one, with the help of Mathematica.

The empty template:

    Graphics[{ {Gray, Dotted,
       {
          With[{x1 = Max[0, #], y1 = Max[0, Quotient[-#, 2]]},
           Line[{ {x1, y1}, {Min[# + 8, 8],
              Quotient[Min[# + 8, 8] - x1, 2] + y1}}]],
          With[{x1 = Max[0, #], y1 = 4 + Quotient[Min[#, 0], 2]},
           Line[{ {x1, y1}, {Min[# + 8, 8],
              y1 - Quotient[Min[# + 8, 8] - x1, 2]}}]]
          } & /@ Range[-6, 6, 2]
       },
      Gray,
      Line[{ {#, 0}, {#, 4} }] & /@ Range[0, 8],
      Line[{ {0, #}, {8, #} }] & /@ {0, 1, 3, 4}}]

template

Drawing is a mission impossible to me. So I have to rotate and mask then translate pictures to fill them into these triangles. A face composed of 6 (or 12) triangles is not a plane, but I just rotate a picture by times of pi/3 rad, so overlap occurs on borders.

    trianglesA = {Quotient[# + 1, 2] 2 \[Pi]/3,
         If[EvenQ@#, Polygon[{{0, 0}, {1, 1/2}, {0, 1}}],
          Polygon[{{0, 0}, { -1, 1/2}, {0, 1}}]],
         {0 + Quotient[# + 1, 2] 2, 1}} & /@ Range[0, 5];
    trianglesB = {Quotient[#, 2] 2 \[Pi]/3,
         If[OddQ@#, Polygon[{{0, 0}, {1, 1/2}, {0, 1}}],
          Polygon[{{0, 0}, { -1, 1/2}, {0, 1}}]],
         {1 + Quotient[#, 2] 2, 3/2}} & /@ Range[0, 5];
    trianglesC = {Quotient[# + 1, 2] 2 \[Pi]/3,
         If[EvenQ@#, Polygon[{{0, 0}, {1, 1/2}, {0, 1}}],
          Polygon[{{0, 0}, { -1, 1/2}, {0, 1}}]],
         {0 + Quotient[# + 1, 2] 2, 2}} & /@ Range[0, 5];
    trianglesD1 = {Quotient[#, 2] 2 \[Pi]/3,
         If[OddQ@#, Polygon[{{0, 0}, {1, 1/2}, {0, 1/2}}],
          Polygon[{{0, 0}, { -1, 1/2}, {0, 1/2}}]],
         {1 + Quotient[#, 2] 2, 5/2}} & /@ Range[0, 5];
    trianglesD2 = {Quotient[#, 2] 2 \[Pi]/3,
         If[OddQ@#, Polygon[{{0, 1/2}, {1, 1/2}, {0, 1}}],
          Polygon[{{0, 1/2}, { -1, 1/2}, {0, 1}}]],
         {1 + Quotient[#, 2] 2, 1/2}} & /@ Range[0, 5];
    trianglesD = trianglesD1~Join~trianglesD2;
    $MAXSIZE = 500; (* HD not prefered *)
    makeBraid[pic_, triangles_] := Module[
       {size, newpic, masks, braid},
       size = Max@ImageDimensions[pic];
       newpic = ImageCrop[pic, {size, size}];
       size = Min[size, $MAXSIZE];
       newpic = ImageResize[newpic, size];
       masks = {#[[1]],
           Rasterize[
            Graphics[{White, EdgeForm[White], #[[2]]},
             Background -> Black, PlotRange -> {{ -1, 1}, { -1, 1}}],
            ImageSize -> size], #[[3]]} & /@ triangles;
       braid = {SetAlphaChannel[
            ImageRotate[newpic, #[[1]], Full], #[[2]]], #[[3]]} & /@ masks;
       Inset[#[[1]], #[[2]], Automatic, {2, 2}] & /@ braid
       ];
    makeIt[pics_List] := Module[
       {primitives},
       primitives =
        MapThread[
         makeBraid, {
          pics, {trianglesA, trianglesB, trianglesC, trianglesD}}];
       Graphics[{
         primitives,
         {Red, Dotted,
          {
             With[{x1 = Max[0, #], y1 = Max[0, Quotient[-#, 2]]},
              Line[{{x1, y1}, {Min[# + 8, 8],
                 Quotient[Min[# + 8, 8] - x1, 2] + y1}}]],
             With[{x1 = Max[0, #], y1 = 4 + Quotient[Min[#, 0], 2]},
              Line[{{x1, y1}, {Min[# + 8, 8],
                 y1 - Quotient[Min[# + 8, 8] - x1, 2]}}]]
             } & /@ Range[-6, 6, 2]
          },
         Gray,
         Line[{{#, 0}, {#, 4}}] & /@ Range[0, 8],
         Line[{{0, #}, {8, #}}] & /@ {0, 1, 3, 4}},
        PlotRange -> {{0, 7.9}, { -0.1, 4.1}}]
       ];

Here is a not-so-awesome example:

demo