flag.hs
A Flag, with the text “flag” on it
This was used as a “flavour image” for a blog post on Haskell FFI
#!/usr/bin/env stack
{- 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: 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
= Waterfall.scale (V3 poleR poleR 1) Waterfall.unitCylinder
post = Waterfall.scale (V3 0.1 0.1 0.05) Waterfall.unitCylinder
base = 3
nWaves = 0.2
waveLength =
flagPath $ Waterfall.pathFrom zero
Waterfall.fromPath2D let y = (fromIntegral i + 1) * waveLength
[ = if even i then Waterfall.Clockwise else Waterfall.Counterclockwise
sense in Waterfall.arcTo sense 0.2 (V2 0 y)
| i <- [(0 :: Integer)..nWaves]
]= 0.2
fabricHeight = 0.01
fabricThickness = (fromIntegral nWaves + 1) * waveLength
fabricLength =
text "flag" &
Waterfall.text font 1 &
Waterfall.prism -0.5 *^ unit _z) &
Waterfall.translate (pi/2) &
Waterfall.rotate (unit _z) (pi/2) &
Waterfall.rotate (unit _y) (* 0.45) *^ unit _y)
Waterfall.translate ((fabricLength =
flagXSection &
Waterfall.centeredSquare V2 fabricThickness fabricHeight) &
Waterfall.scale2D (-3*pi/16)
Waterfall.rotate2D (=
flagCutout &
Waterfall.centeredCube pi/4) &
Waterfall.rotate (unit _x) (&
Waterfall.uScale fabricHeight *^ unit _y)
Waterfall.translate (fabricLength =
poleWraparound let r = fabricThickness + poleR
in Waterfall.scale (V3 r r fabricHeight) Waterfall.centeredCylinder
= 0.875
fabricElevation =
flagFabric *^ unit _z)
Waterfall.translate (fabricElevation <>
(poleWraparound `Waterfall.difference`
(Waterfall.sweep flagPath flagXSection <> text)))
(flagCutout in mconcat [post, base, flagFabric]
main :: IO ()
= do
main <- Waterfall.fontFromSystem "monospace" Waterfall.Regular 0.15
font 0.001 "flag.stl" (flag font) Waterfall.writeSTL