regular-polyhedral-compound-tree-ornaments.hs
Tree ornaments made from the Regular Polyhedral Compounds
These are:
- Compound of Five Cubes
- Compound of Two Tetrahedra
- Compound of Five Tetrahedra
- Compound of Ten Tetrahedra
- Compound of Five Octahedra
These are provided as whole models, as well as split horizontally with a joining cube, to allow printing them with minimal overhangs.
The “Compound of Five Cubes” is also provided as a “clipped” model, where one of the sides has been truncated. The ornament has been aranged with this face to the bottom, so it can be printed in a single piece. None of the other ornaments have a orientation that lends itself to printing in one piece like this.
#!/usr/bin/env stack
{- stack script --resolver lts-23.15
--package linear
--package waterfall-cad
--package lattices
--extra-dep waterfall-cad-0.6.1.0
--extra-dep opencascade-hs-0.6.1.0
-}
-- short-description: "Regular Polyhedral Compound" tree ornaments
--
-- description: Tree ornaments made from the [Regular Polyhedral Compounds](https://en.wikipedia.org/wiki/Polytope_compound#Regular_compounds)
-- description:
-- description: These are:
-- description:
-- description: * [Compound of Five Cubes](https://en.wikipedia.org/wiki/Compound_of_five_cubes)
-- description: * [Compound of Two Tetrahedra](https://en.wikipedia.org/wiki/Stellated_octahedron)
-- description: * [Compound of Five Tetrahedra](https://en.wikipedia.org/wiki/Compound_of_five_tetrahedra)
-- description: * [Compound of Ten Tetrahedra](https://en.wikipedia.org/wiki/Compound_of_ten_tetrahedra)
-- description: * [Compound of Five Octahedra](https://en.wikipedia.org/wiki/Compound_of_five_octahedra)
-- description:
-- description: These are provided as whole models,
-- description: as well as split horizontally with a joining cube,
-- description: to allow printing them with minimal overhangs.
-- description:
-- description: The "Compound of Five Cubes" is also provided as a "clipped" model,
-- description: where one of the sides has been truncated.
-- description: The ornament has been aranged with this face to the bottom,
-- description: so it can be printed in a single piece.
-- description: None of the other ornaments have a orientation that lends itself
-- description: to printing in one piece like this.
--
-- image: https://doscienceto.it/blog/photos/tree-ornament-five-cubes.jpg
-- image: https://doscienceto.it/blog/photos/tree-ornament-two-tetrahedra.jpg
-- image: https://doscienceto.it/blog/photos/tree-ornament-five-tetrahedra.jpg
-- image: https://doscienceto.it/blog/photos/tree-ornament-ten-tetrahedra.jpg
-- image: https://doscienceto.it/blog/photos/tree-ornament-five-octahedra.jpg
import qualified Waterfall as W
import Linear
sideLength :: Double
sideLength = 40
phi :: Double
phi = (1 + sqrt 5) / 2
rotateIntoPlace = W.rotate (V3 1 1 0) (unangle (V2 1 (sqrt 2)) - pi)
. W.rotate (unit _z) (-pi/4)
rotateBack = W.rotate (unit _z) (pi/4)
. W.rotate (V3 1 1 0) (pi - unangle (V2 1 (sqrt 2)))
addHoop :: W.Solid -> W.Solid
addHoop compound =
let Just (_, V3 _ _ h) = W.axisAlignedBoundingBox compound
hoop =
W.translate (h *^ unit _z)
. W.rotate (unit _x) (pi/2)
$ W.torus 6 2
in compound <> hoop
compoundOfFive :: W.Solid -> W.Solid
compoundOfFive =
let axis = V3 1 phi 0
angle = 2 * pi / 5
theta = unangle (V2 1 phi)
tetrahedron = rotateIntoPlace W.tetrahedron
in mconcat . take 5 . iterate (W.rotate axis angle)
rotateCubes = W.rotate (unit _y) ((unangle (V2 2 (sqrt 3)))/2)
rotateBackCubes = W.rotate (unit _y) (unangle (V2 1 phi) - (unangle (V2 2 (sqrt 3)))/2)
fiveCubes :: W.Solid
fiveCubes = rotateCubes $ compoundOfFive W.centeredCube
-- make the cubes a little smaller, because otherwise they're huge
-- using sqrt 2 as a scale factor makes the face diagonal of the cubes
-- the same length as the tetrahedron edge
fiveCubesOrnament :: W.Solid
fiveCubesOrnament = addHoop $ W.uScale (sideLength/sqrt 2) fiveCubes
-- The compound of five cubes is special amongst these ornaments
-- because one of their sides is _relatively_ flat
-- they can be printed in one piece
-- this clips a little part of one flat surface of the cubes
-- which makes that lie on the build plate better
clip :: Double -> W.Solid -> W.Solid
clip h s =
let Just (V3 _ _ lo, _) = W.axisAlignedBoundingBox s
mask =
W.translate ((lo+h) *^ unit _z)
. W.uScale 100
. W.translate (0.5 *^ unit _z) $ W.centeredCube
in mask `W.intersection` s
clippedFiveCubesOrnament :: W.Solid
clippedFiveCubesOrnament = clip 0.5 . rotateBackCubes $ fiveCubesOrnament
fiveTetrahedra :: W.Solid
fiveTetrahedra = rotateBack . compoundOfFive . rotateIntoPlace $ W.tetrahedron
fiveTetrahedraOrnament :: W.Solid
fiveTetrahedraOrnament = addHoop $ W.uScale sideLength fiveTetrahedra
tenTetrahedra :: W.Solid
tenTetrahedra =
let mirror s = s <> W.mirror (unit _z) s
in rotateBack . mirror. compoundOfFive . rotateIntoPlace $ W.tetrahedron
tenTetrahedraOrnament :: W.Solid
tenTetrahedraOrnament = addHoop $ W.uScale sideLength tenTetrahedra
twoTetrahedraOrnament :: W.Solid
twoTetrahedraOrnament = addHoop $ W.uScale sideLength (W.tetrahedron <> W.rotate (unit _y) (pi) W.tetrahedron)
octahedra :: W.Solid
octahedra =
let axis = V3 1 phi 0
angle = 2 * pi / 5
theta = unangle (V2 1 phi)
in compoundOfFive W.octahedron
fiveOctahedraOrnament :: W.Solid
fiveOctahedraOrnament = addHoop $ W.uScale sideLength octahedra
split :: W.Solid -> W.Solid
split s =
let mask =
W.uScale 100
. W.translate (0.5 * unit _z)
$ W.centeredCube
hole = W.uScale 8 W.centeredCube
joiner = W.uScale 7.5 W.unitCube
top = (W.intersection mask s) `W.difference` hole
bottom = W.rotate (unit _x) pi (s `W.difference` (mask <> hole))
Just (V3 x0 _ _, V3 x1 _ _) = W.axisAlignedBoundingBox top
Just (V3 x2 _ _,_) = W.axisAlignedBoundingBox bottom
in (W.translate ((5 + x1 - x2) *^ unit _x) bottom)
<> top
<> W.translate ((x0 - 10) *^ unit _x) joiner
main :: IO ()
main =
let write = W.writeSTL 0.1
in -- The whole ornaments
write "compound-of-five-cubes-ornament.stl" fiveCubesOrnament
<> write "compound-of-two-tetrahedra-ornament.stl" twoTetrahedraOrnament
<> write "compound-of-five-tetrahedra-ornament.stl" fiveTetrahedraOrnament
<> write "compound-of-ten-tetrahedra-ornament.stl" tenTetrahedraOrnament
<> write "compound-of-five-octahedra-ornament.stl" fiveOctahedraOrnament
-- The clipped five cubes ornament
<> write "compound-of-five-cubes-ornament-clipped.stl" (clippedFiveCubesOrnament)
-- The split ornaments (for easier printing)
<> write "compound-of-five-cubes-ornament-split.stl" (split fiveCubesOrnament)
<> write "compound-of-two-tetrahedra-ornament-split.stl" (split twoTetrahedraOrnament)
<> write "compound-of-five-tetrahedra-ornament-split.stl" (split fiveTetrahedraOrnament)
<> write "compound-of-ten-tetrahedra-ornament-split.stl" (split tenTetrahedraOrnament)
<> write "compound-of-five-octahedra-ornament-split.stl" (split fiveOctahedraOrnament)