spatula.hs

{- stack script --resolver lts-23.15 
    --package linear
    --package waterfall-cad
    --extra-dep waterfall-cad-0.6.1.0
    --extra-dep opencascade-hs-0.6.1.0
-}

-- short-description: Lambda the Ultimate Kitchen Utensil 
--
-- description: With apologies to Guy Steele
import qualified Waterfall as W
import Linear
import Control.Lens ((^.))

import Data.Function ((&))
bladeThickness :: Double
bladeThickness = 3

blade :: W.Solid
blade = 
    let profile :: W.Path2D
        profile =
            W.closeLoop $
            W.pathFrom (V2 (-20) 0)
                [ W.lineRelative (V2 40 0)
                , W.lineRelative (V2 10 60)
                , W.arcViaTo (V2 0 70) (V2 (-30) 60)
                ]
        roundFn (s, e) | (nearZero (s ^. _xy - e ^. _xy)) && nearZero (s ^. _y) = Just 10
                       | otherwise = Nothing 
    in W.prism bladeThickness (W.makeShape profile) 
            & W.roundConditionalFillet roundFn

handleLongLeg :: V3 Double
handleLongLeg = V3 0 (-60) 15

handlePath :: W.Path
handlePath =
    let shortLeg = V3 0 (-30) 30
        joinL = 5
    in W.pathFrom (5 *^ unit _y)
            [ W.lineRelative shortLeg
            , W.bezierRelative (joinL *^ normalize shortLeg) (joinL *^ normalize shortLeg) (joinL *^ (normalize shortLeg + normalize handleLongLeg))
            , W.lineRelative handleLongLeg
            ]

handle :: W.Solid
handle = 
    W.sweep handlePath (W.scale2D (V2 10 7.5) W.centeredSquare)

grip :: W.Solid
grip = 
    let Just (_, e) = W.pathEndpoints handlePath
        gripD = normalize handleLongLeg ^* 30
        gripPath = W.line (e - gripD) (e + gripD)
    in W.sweep gripPath (W.scale2D (V2 16 12) W.centeredSquare)
        & W.roundFillet 4

hole :: W.Solid
hole = 
    let Just (_, e) = W.pathEndpoints handlePath
        holeD = normalize handleLongLeg
        holePath = W.line (e + holeD ^* 10) (e + holeD ^* 25)
    in W.sweep holePath (W.scale2D (V2 6 30) W.centeredSquare)
        & W.roundFillet 2.75

negativeMask :: W.Solid
negativeMask = 
    W.centeredCube 
        & W.translate (-0.5 *^ unit _z)
        & W.uScale 1000

text :: W.Font -> W.Solid
text font = 
    let lambda = 
            W.text font "λ"
                & W.rotate2D pi
                & W.prism 10
        Just (lo, hi) = W.axisAlignedBoundingBox lambda
        center = (lo + hi)/2
        intendedCenter = 35 *^ unit _y
        in lambda 
            & W.translate (intendedCenter - center)

spatula :: W.Font -> W.Solid
spatula font = (blade <> handle <> grip) `W.difference` (hole <> text font <> negativeMask)

main :: IO ()
main = do
    font <- W.fontFromPath "cmunrm.ttf" 72
    W.writeSTL 0.25 "spatula.stl" (spatula font)