fan-hinge.hs

{- stack script --resolver lts-22.6 
    --package linear
    --package waterfall-cad
    --extra-dep waterfall-cad-0.3.0.0
    --extra-dep opencascade-hs-0.3.0.0
-}

-- short-description: 2020 t-slot Fan mount
--
-- description: I built this simple joint to attach a PC fan to a length of 2020 t-slot.
--
-- image: https://doscienceto.it/blog/photos/fan-hinge-01.jpg
-- image: https://doscienceto.it/blog/photos/fan-hinge-02.jpg

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

baseDepth = 20
baseHeight = 8
hingeSegLength = (hingeLength / 3) - 0.15
hingeLength = 20
hingeDepth = 12
hingeBaseHeight = 8
baseSide = 12
baseLength = hingeLength + 2 * baseSide
fanDepth = 16

hingeBase :: Waterfall.Solid
hingeBase = 
    let cond (a, b) | a ^. _xy == b ^. _xy = Just 5
                    | a ^. _z > 0 = Just 2  
                    | otherwise =  Nothing
        b = Waterfall.centeredCube &
                Waterfall.translate (0.5 * unit _z) &
                Waterfall.scale (V3 baseDepth baseLength baseHeight) &
                Waterfall.roundConditionalFillet cond
        slotGuide = Waterfall.centeredCube &
            Waterfall.scale (V3 6 baseLength 1)
        baseHoles = mconcat [
                Waterfall.centeredCylinder &
                    Waterfall.scale (V3 1.5 1.5 100) & 
                    (<> (Waterfall.unitCylinder &
                        Waterfall.scale (V3 3 3 100) &
                        Waterfall.translate (unit _z ^* (baseHeight -2) ))) &
                    Waterfall.translate (unit _y ^* (i * (hingeLength/2 + baseSide/2)))
                    | i <- [-1, 1]
            ]
        hingeHalf =
            (( Waterfall.centeredCube &
                Waterfall.translate (0.5 * unit _z) &
                Waterfall.scale (V3 hingeDepth hingeSegLength (hingeBaseHeight + baseHeight)) 
            ) <>
            ( Waterfall.centeredCylinder & 
                Waterfall.scale (V3 (hingeDepth/2) (hingeDepth/2) hingeSegLength) & 
                Waterfall.rotate (unit _x) (pi/2) &
                Waterfall.translate (unit _z ^* (hingeBaseHeight + baseHeight))
            )) `Waterfall.difference`
            ( Waterfall.centeredCylinder & 
                Waterfall.scale (V3 1.5 1.5 100) & 
                Waterfall.rotate (unit _x) (pi/2) &
                Waterfall.translate (unit _z ^* (hingeBaseHeight + baseHeight))
            )
        hinge = mconcat [Waterfall.translate (unit _y ^* (i * hingeLength / 3 )) hingeHalf | i <- [-1, 1]]
    in (b {-- <> slotGuide --} <> hinge ) `Waterfall.difference` baseHoles
        
hingeTop :: Waterfall.Solid
hingeTop =
    let 
        midH = 14
        h = 20
        p = 
            Waterfall.pathFrom (V2 0 hingeDepth /2) 
                [ Waterfall.bezierTo (V2 midH (hingeDepth/2)) (V2 midH (fanDepth/2)) (V2 h (fanDepth/2))
                , Waterfall.lineTo (V2 h (negate fanDepth/2))
                , Waterfall.bezierTo (V2 midH (negate fanDepth/2)) (V2 midH (negate hingeDepth/2)) (V2 0 (negate hingeDepth/2))
                ]
        in Waterfall.translate (unit _z ^* (hingeBaseHeight + baseHeight)) $ Waterfall.rotate (unit _y) (negate pi/2) $
            (( p & Waterfall.closeLoop & Waterfall.fromPath 
                & Waterfall.prism hingeSegLength  
                & Waterfall.translate (negate $ unit _z ^* hingeSegLength /2)
                & Waterfall.rotate (unit _x) (pi/2)
            ) <>
            ( Waterfall.centeredCylinder & 
                Waterfall.scale (V3 (hingeSegLength/2) (hingeSegLength/2) fanDepth) & 
                Waterfall.rotate (unit _z) (pi/2) & 
                (`Waterfall.difference` (Waterfall.centeredCube & Waterfall.translate (negate $ unit _x * 0.5) & Waterfall.uScale 100)) &
                Waterfall.translate (unit _x ^* h)
            ) <>
            ( Waterfall.centeredCylinder & 
                Waterfall.scale (V3 (hingeDepth/2) (hingeDepth/2) hingeSegLength) & 
                Waterfall.rotate (unit _x) (pi/2) 
            )) `Waterfall.difference`
            (( Waterfall.centeredCylinder & 
                Waterfall.scale (V3 2 2 100) & 
                Waterfall.rotate (unit _z) (pi/2) & 
                Waterfall.translate (unit _x ^* h)
            ) <>
                ( Waterfall.centeredCylinder & 
                Waterfall.scale (V3 1.5 1.5 100) & 
                Waterfall.rotate (unit _x) (pi/2) 
            ))


main :: IO ()
main = do
    Waterfall.writeSolid 0.01 "hinge_combined.stl" (hingeBase <> hingeTop)
    Waterfall.writeSolid 0.01 "hinge_base.stl" hingeBase
    Waterfall.writeSolid 0.01 "hinge_top.stl" hingeTop