microphone_mount.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: This is a mount that clips under the corner of a desk
-- short-description: and holds a GS56S microphone.
-- image: https://doscienceto.it/blog/photos/microphone-mount-01.jpg

import qualified Waterfall
import Linear 

slotT :: Double 
slotT = 36

tableMount :: Waterfall.Solid
tableMount = 
  let tableR = 120 / (sqrt 2)
      tableD = 18
      width = 20
      mountT = 4
      barD = slotT + width
      outerCyl = let r = tableR + mountT in Waterfall.translate (unit _z ^* (-mountT))$ Waterfall.scale (V3 r r (tableD + mountT * 2)) Waterfall.unitCylinder
      innerCyl = Waterfall.scale (V3 tableR tableR tableD) Waterfall.unitCylinder
      upperMask = let r = tableR - 20 in Waterfall.scale (V3 r r 100) Waterfall.unitCylinder
      cyl = outerCyl `Waterfall.difference` (innerCyl `Waterfall.union` upperMask)
      screwHole = 
        Waterfall.scale (V3 1.5 1.5 100) Waterfall.centeredCylinder 
            `Waterfall.union` (Waterfall.rotate (unit _x) pi$  Waterfall.uScale 100 $ Waterfall.unitCone)

      bar xCo = 
        Waterfall.intersection cyl $ 
          Waterfall.translate (V3 xCo 0 0) $
            (`Waterfall.difference` (Waterfall.translate (V3 0 (width/2) 0) screwHole)) $
              Waterfall.scale (V3 width (tableR*2) 100) $
                Waterfall.translate (unit _y ^* 0.5) $ 
                  Waterfall.centeredCube
      bars = mconcat [bar x | x <- [barD/2, -barD/2]]
   in bars  

microphoneHolder :: Waterfall.Solid
microphoneHolder = 
  let outerR = 75/2
      outerHoleR = 54/2
      innerHoleR = 50/2
      t = 16
      plateaxD = 4
      outerCyl = Waterfall.roundFillet 4 $ Waterfall.scale (V3 outerR outerR t) $ Waterfall.unitCylinder
      outerHole = Waterfall.translate (unit _z ^* plateaxD) $ Waterfall.scale (V3 outerHoleR outerHoleR t) $ Waterfall.unitCylinder
      throughHole = Waterfall.scale (V3 innerHoleR innerHoleR (t*3)) Waterfall.centeredCylinder
      basicShape = outerCyl `Waterfall.difference` (throughHole `Waterfall.union` outerHole )
      slot = Waterfall.scale (V3 slotT (outerR*2) (t*4)) $ Waterfall.translate (unit _y ^* 0.5) Waterfall.centeredCube
   in basicShape `Waterfall.difference` slot

connectors :: Waterfall.Solid
connectors = 
  let 
    outerR = 75/2
    t = 16
    r = 5
    start = V3 outerR 0 t
    h = 65
    end =  (V3 outerR 0 h)
    path = Waterfall.arcVia start (V3 (100/2) 0 (h/2 + t/2)) end
    oneConnector = 
        Waterfall.sweep path (Waterfall.uScale2D 5 Waterfall.unitCircle) `Waterfall.union` 
        (Waterfall.translate start (Waterfall.uScale r Waterfall.unitSphere)) `Waterfall.union` 
        (Waterfall.translate end (Waterfall.uScale r Waterfall.unitSphere))
  in Waterfall.translate (V3 0 0 (-0.5)) $ mconcat [Waterfall.rotate (unit _z) angle oneConnector | angle <- [fromIntegral i * (pi/4)  | i <- [3..5] <> [7..9] ]]

microphoneMount :: Waterfall.Solid
microphoneMount = tableMount `Waterfall.union` (Waterfall.translate (V3 0 50 (-70)) (microphoneHolder `Waterfall.union` connectors))


partA :: Waterfall.Solid
partA = microphoneMount `Waterfall.intersection` (Waterfall.scale (V3 slotT 500 500) Waterfall.centeredCube)

partB :: Waterfall.Solid
partB = microphoneMount `Waterfall.intersection` (Waterfall.translate (unit _x ^* (slotT/2)) $ Waterfall.uScale 500 $ Waterfall.translate (unit _x ^* 0.5) Waterfall.centeredCube)

main :: IO ()
main = do 
    let stlRes = 0.1
    Waterfall.writeSTL stlRes "microphone_mount.stl" microphoneMount
    putStrLn "finished whole"
    Waterfall.writeSTL stlRes "microphone_mount_A.stl" partA
    putStrLn "finished part A"
    Waterfall.writeSTL stlRes "microphone_mount_B.stl" partB
    putStrLn "finished part B"