Christmas coming & time for fun! Wolfram’s demonstrations give you a sense of the holiday season along some nice demonstrations. I particulary like the “Ornamental Holiday Decoration”
Manipulate[
Module[{level0, level1, level2},
level0 = C[spikey, 0];
level1 =
Flatten[daughterPolyhedra[C[spikey, 0], {d1, ω1, s1}, ρ s1]];
level2 =
Flatten[daughterPolyhedra[#, {d2, ω2, s2}, ρ s1 s2] & /@
Cases[level1, _C]];
Graphics3D[{EdgeForm[],
{Red, egc[level0]}, gg1 = {col1, egc[level1]},
gg2 = {col2, ControlActive[{}, egc[level2]]},
Directive[GrayLevel[0.2], Specularity[colc, 12]],
ecc[{level1, level2}]}, Boxed -> False,
ImageSize -> {400, 400}]],
"layer 1:",
{{d1, 1.5, "distance"}, -3, 3, ImageSize -> Tiny},
{{ω1, 0, "rotation"}, -Pi, Pi, ImageSize -> Tiny},
{{s1, 1/2, "size"}, 0, 1, ImageSize -> Tiny},
{{col1, Yellow, "color"}, Blue, ControlType -> None},
Delimiter,
"layer 2:",
{{d2, 1, "distance"}, -3, 3, ImageSize -> Tiny},
{{ω2, 0, "rotation"}, -Pi, Pi, ImageSize -> Tiny},
{{s2, 1/2, "size"}, 0, 1, ImageSize -> Tiny},
{{col2, Green, "color"}, Green, ControlType -> None},
Delimiter,
"connectors:",
{{ρ, 0.3, "radius"}, 0, 1, ImageSize -> Tiny},
{{colc, Brown, "color"}, Yellow, ControlType -> None},
AutorunSequencing -> {1, 3, 5, 7},
Initialization :> {
spikey =
MapAt[Developer`ToPackedArray,
MapAt[Developer`ToPackedArray, N[PolyhedronData["Spikey"]][[1]],
1], {2, 1}];
mirrorRotateAndShift[gc_GraphicsComplex,
n_, {distance_, angle_, size_}, ρ_] :=
With[{aux =
mirrorRotateAndShiftCF[gc[[1]], gc[[1, n]], distance, angle,
size]}, {C[GraphicsComplex[aux, gc[[2]]], n],
Cylinder[{gc[[1, n]], aux[[n]]}, ρ]}];
mirrorRotateAndShiftCF =
Compile[{{vertices, _Real, 2}, {rPoint, _Real, 1}, distance,
angle, size},
Module[{c = Cos[angle], s = Sin[angle], dirx, diry, dirz,
rPoint1, pCx, pCy,
V, parallelComponent, normalComponent, mp},
mp = (Plus @@ vertices)/Length[vertices];
dirz = #/Sqrt[#.#] &[rPoint - mp];
dirx = #/Sqrt[#.#] &[RandomReal[{-1, 1}, 3]];
dirx = #/Sqrt[#.#] &[dirx - dirx.dirz dirz];
diry = {-dirx[[3]] dirz[[2]] + dirx[[2]] dirz[[3]],
dirx[[3]] dirz[[1]] - dirx[[1]] dirz[[3]],
-dirx[[2]] dirz[[1]] +
dirx[[1]] dirz[[2]]};
rPoint1 = mp + size (rPoint - mp);
Table[V = mp + size (vertices[[k]] - mp);
normalComponent = (V - rPoint1).dirz dirz;
parallelComponent = (V - rPoint1) - normalComponent;
pCx = parallelComponent.dirx;
pCy = parallelComponent.diry;
rPoint + (c pCx + s pCy) dirx + (-s pCx + c pCy) diry +
distance dirz -
normalComponent,
{k, Length[vertices]}]],
CompileOptimizations -> False];
daughterPolyhedra[
C[gc_GraphicsComplex, m_], {distance_, angle_, size_}, ρ_] :=
Table[If[k === m, Sequence @@ {},
mirrorRotateAndShift[gc, k, {distance, angle, size}, ρ]], {k,
13, 32}];
egc[expr_] :=
Cases[Flatten[
Cases[Flatten[{expr}], _C] /. C -> List], _GraphicsComplex];
ecc[expr_] := Cases[Flatten[expr], _Cylinder];
}]
Hitting execution we get,
Play around with the sliders…
You can dive more into the christmas spirit here.
LinkedIn
Facebook
Youtube
Twitter