flag.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: A Flag, with the text "flag" on it
--
-- description: A Flag, with the text "flag" on it
-- description: 
-- description: This was used as a "flavour image" for a [blog post](../posts/2024-01-23-ffi.html) 
-- description: on Haskell FFI

import qualified Waterfall
import Linear
import Data.Function ((&))

flag :: Waterfall.Font -> Waterfall.Solid 
flag font = 
    let poleR = 0.05
        post = Waterfall.scale (V3 poleR poleR 1) Waterfall.unitCylinder
        base = Waterfall.scale (V3 0.1 0.1 0.05) Waterfall.unitCylinder
        nWaves = 3
        waveLength = 0.2
        flagPath = 
            Waterfall.fromPath2D $ Waterfall.pathFrom zero
                [ let y = (fromIntegral i + 1) * waveLength
                      sense = if even i then Waterfall.Clockwise else Waterfall.Counterclockwise
                   in Waterfall.arcTo sense 0.2 (V2 0 y)
                |  i <- [(0 :: Integer)..nWaves]
                ]
        fabricHeight = 0.2
        fabricThickness = 0.01
        fabricLength = (fromIntegral nWaves + 1) * waveLength
        text = 
            Waterfall.text font "flag" &
                Waterfall.prism 1 &
                Waterfall.translate (-0.5 *^ unit _z) &
                Waterfall.rotate (unit _z) (pi/2) &
                Waterfall.rotate (unit _y) (pi/2) &
                Waterfall.translate ((fabricLength * 0.45) *^ unit _y)
        flagXSection =
            Waterfall.centeredSquare &
                Waterfall.scale2D (V2 fabricThickness fabricHeight) &
                Waterfall.rotate2D (-3*pi/16)
        flagCutout = 
            Waterfall.centeredCube &
                Waterfall.rotate (unit _x) (pi/4) &
                Waterfall.uScale fabricHeight &
                Waterfall.translate (fabricLength *^ unit _y) 
        poleWraparound = 
            let r = fabricThickness + poleR 
            in Waterfall.scale (V3 r r fabricHeight) Waterfall.centeredCylinder
        fabricElevation = 0.875
        flagFabric =
            Waterfall.translate (fabricElevation *^ unit _z)
                (poleWraparound <> 
                    (Waterfall.sweep flagPath flagXSection `Waterfall.difference` 
                        (flagCutout <> text)))
     in mconcat [post, base, flagFabric]

main :: IO ()
main = do 
    font <- Waterfall.fontFromSystem "monospace" Waterfall.Regular 0.15
    Waterfall.writeSTL 0.001 "flag.stl" (flag font)