{-|
<<models/2d-booleans.glb>>
-}
module TwoDBooleansExample 
( twoDBooleansExample
) where

import qualified Waterfall.TwoD.Shape as Shape
import qualified Waterfall.Booleans as Booleans
import Waterfall.TwoD.Transforms (translate2D)
import Waterfall.Solids (prism, Solid)
import Linear (V2 (..))

twoDBooleansExample :: Solid
twoDBooleansExample :: Solid
twoDBooleansExample = 
    let offsetSquare :: Shape
offsetSquare = V2 Double -> Shape -> Shape
forall a. Transformable2D a => V2 Double -> a -> a
translate2D (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 Double
0.5 Double
0.5) Shape
Shape.centeredSquare
        complexShape :: Shape
complexShape = Shape -> Shape -> Shape
forall a. Boolean a => a -> a -> a
Booleans.difference 
            (Shape -> Shape -> Shape
forall a. Boolean a => a -> a -> a
Booleans.union Shape
Shape.unitCircle Shape
offsetSquare)
            (Shape -> Shape -> Shape
forall a. Boolean a => a -> a -> a
Booleans.intersection Shape
Shape.unitCircle Shape
offsetSquare)
    in Double -> Shape -> Solid
prism Double
0.2 Shape
complexShape