permutive-ornament.hs

#!/usr/bin/env stack
{- stack script --resolver lts-22.6 
    --package linear
    --package lens
    --package waterfall-cad
    --extra-dep waterfall-cad-0.4.0.0
    --extra-dep opencascade-hs-0.4.0.0
-}

import qualified Waterfall
import Linear
import Control.Lens ((^.))
import Data.Function ((&))


permutiveLogo :: Waterfall.Solid
permutiveLogo = 
    let cyl = Waterfall.unitCylinder 
        ratio = 17/20
        dist = -24/20
        cube = Waterfall.unitCube 
            & Waterfall.scale (V3 ratio ratio 1) 
            & Waterfall.translate (V3 dist dist 0)
     in (cyl <> cube) `Waterfall.difference` (cyl `Waterfall.intersection` cube)

center :: Waterfall.Solid -> Waterfall.Solid
center s = 
    let Just (lo, hi) = Waterfall.axisAlignedBoundingBox s
    in Waterfall.translate (negate (lo + hi)/2) s

circle :: Waterfall.Path2D
circle = Waterfall.pathFrom (unit _x)
                [ Waterfall.arcViaTo (unit _y) (negate $ unit _x)
                , Waterfall.arcViaTo (negate $ unit _y) (unit _x)
                ]

ornament :: Waterfall.Font -> Waterfall.Solid
ornament font = 
    let t = center . Waterfall.prism 2 . Waterfall.text font 
        t1 = t "Permutive"
        t2 = t "Tim Cube"
        logo =
            permutiveLogo &
                center &
                Waterfall.scale (V3 32 32 8) &
                Waterfall.translate (unit _y ^* 48)

        logos = (logo <> t2) : replicate 3 (logo <> t1)
        positionedLogos = mconcat
            [ l & Waterfall.rotate (unit _x) (-pi/2)
                & Waterfall.translate (unit _y ^* 64)
                & Waterfall.rotate (unit _z) (i * pi/2)
                | (i, l) <- zip [0..] logos
            ]
        cube = Waterfall.centeredCube & 
            Waterfall.scale (V3 128 128 130) &
            Waterfall.roundFillet 20 &
            (`Waterfall.difference` (Waterfall.centeredCube & Waterfall.uScale 128 & Waterfall.translate (unit _z ^* (126)))) &
            Waterfall.translate (unit _z ^* (-38))
        hoop = Waterfall.sweep (Waterfall.fromPath2D . Waterfall.uScale2D 3 $ circle) (Waterfall.fromPath circle)
        positionedHoop = hoop &
            Waterfall.uScale 5 &
            Waterfall.rotate (unit _x) (pi/2) &
            Waterfall.translate (unit _z ^* (-110))
    in (cube `Waterfall.difference` positionedLogos) <> positionedHoop


main :: IO ()
main = do
    font <- Waterfall.fontFromPath "Moderat-Bold.ttf" 16
    Waterfall.writeSTL 0.25 "permutive-ornament.stl" (ornament font)