plant-tags.hs

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

-- short-description: Plant Tags
--
-- description: I’m growing tomatoes this year; three varieties: Costoluto – Moneymaker – Tiny Tim’s.
-- description:
-- description: I printed a bunch of tags to help tell these apart.
--
-- image: https://doscienceto.it/blog/photos/plant-tags-01.jpg
-- image: https://doscienceto.it/blog/photos/plant-tags-02.jpg
-- image: https://doscienceto.it/blog/photos/plant-tags-03.jpg

import qualified Waterfall
import Linear
import Data.Maybe (fromMaybe)

outerBoundingBox :: (V3 Double, V3 Double) -> (V3 Double, V3 Double)
outerBoundingBox (lo, hi) = let b = 2 in ( lo - V3 b b 0, hi + V3 50 b 0)

innerBoundingBox :: (V3 Double, V3 Double) -> (V3 Double, V3 Double)
innerBoundingBox (lo, hi) = let b = 1 in ( lo - V3 b b (-1), hi + V3 60 b 1)

bevelZ = Waterfall.roundConditionalFillet (\(V3 _ _ z1, V3 _ _ z2) -> if z1 /= z2 then Just 2 else Nothing )

tag :: String -> IO Waterfall.Solid
tag s = do
    let filename = "/home/joseph/.fonts/Montserrat-VariableFont_wght.ttf"
    font <- Waterfall.fontFromSystem "sans-serif" Waterfall.Regular 12
    let t = Waterfall.prism 2 $ Waterfall.text font s
    let bb = fromMaybe (error "unable to generate AABB") . Waterfall.axisAlignedBoundingBox $ t   

    let bb1 = bevelZ . Waterfall.aabbToSolid . outerBoundingBox $ bb
    let bb2 = bevelZ . Waterfall.aabbToSolid . innerBoundingBox $ bb

    return $ (bb1 `Waterfall.difference` bb2) <> t 

main :: IO ()
main = do
    let res = 0.1
    Waterfall.writeSTL res "costoluto.stl" =<< tag "Costoluto"
    Waterfall.writeSTL res "tiny-tims.stl" =<< tag "Tiny Tim's"
    Waterfall.writeSTL res "moneymaker.stl" =<< tag "Moneymaker"