quest-two-mount.hs

{- stack script --resolver lts-23.15 
    --package linear
    --package waterfall-cad
    --extra-dep waterfall-cad-0.6.0.0
    --extra-dep opencascade-hs-0.6.0.0
-}
-- short-description: Hook used to hang a Meta Quest 2 controller to a vertical length of 2020 t-slot.
--
-- image: https://doscienceto.it/blog/photos/meta-quest-stand-01.jpg
-- image: https://doscienceto.it/blog/photos/meta-quest-stand-02.jpg
-- image: https://doscienceto.it/blog/photos/meta-quest-stand-03.jpg

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

baseDims = V3 20 45 5
questR = 40
questT = 28 + 1 
questAngle = 15 * pi / 180
hookEndT = 5
screwClearance = 7
hookThickness = 6

mount :: Waterfall.Solid
mount = 
    let 
        cond (a, b) | a ^. _xy == b ^. _xy = Just 5
                    | a ^. _z > 0 = Just 2  
                    | otherwise =  Nothing
        base = 
            Waterfall.centeredCube 
                & Waterfall.translate (0.5 *^ unit _z)
                & Waterfall.scale baseDims
                & Waterfall.roundConditionalFillet cond
        hookS = V3 questR questR (questT*4)
        hookT = V3 hookThickness hookThickness 0
        hookH = (baseDims ^. _z) + questT + hookEndT
        hookShaft = Waterfall.centeredCylinder 
            & Waterfall.scale hookS
            & (`Waterfall.difference` (Waterfall.centeredCylinder & Waterfall.scale ((hookS - hookT) * V3 1 1 2)))
            & Waterfall.translate (questR *^ unit _y)
            & Waterfall.rotate (unit _x) questAngle
            & Waterfall.intersection (Waterfall.centeredCube & Waterfall.translate (0.5 *^ unit _z) & Waterfall.scale (baseDims & _z .~ hookH))
        hookEnd = Waterfall.centeredCylinder 
            & Waterfall.scale (hookS + V3 hookEndT hookEndT 0)
            & (`Waterfall.difference` (Waterfall.centeredCylinder & Waterfall.scale ((hookS - hookT) * V3 1 1 2)))
            & Waterfall.translate (questR *^ unit _y)
            & Waterfall.rotate (unit _x) questAngle
            & Waterfall.intersection (
                Waterfall.centeredCube 
                    & Waterfall.translate (negate 0.5 *^ unit _z) 
                    & Waterfall.scale (baseDims & _z .~ hookEndT) 
                    & Waterfall.translate (hookH *^ unit _z)
                )
        hook = (hookEnd <> hookShaft) & Waterfall.translate (7 *^ unit _y)
        baseHoles = mconcat [
                Waterfall.centeredCylinder &
                    Waterfall.scale (V3 1.5 1.5 100) & 
                    (<> (Waterfall.unitCylinder &
                        Waterfall.scale (V3 3 3 100) &
                        Waterfall.translate (unit _z ^* (2) ))) &
                    Waterfall.translate (unit _y ^* (i * ((baseDims ^. _y)/2 - screwClearance)))
                    | i <- [-1, 1]
            ]
     in (base <> hook) `Waterfall.difference` baseHoles
main :: IO ()
main = Waterfall.writeSolid 0.01 "quest-two-mount.stl" mount