module SweepExample 
( sweepExample 
) where

import Waterfall.Sweep (sweep)
import Waterfall.Solids (Solid)
import qualified Waterfall.Path as Path
import qualified Waterfall.TwoD.Path2D as Path2D
import qualified Waterfall.TwoD.Shape as Shape
import Linear ( V3 (..), (*^), angle, unit, _x, zero)

sweepExample :: Solid
sweepExample :: Solid
sweepExample = 

    let sweepPath :: Path
sweepPath = V3 Double -> [V3 Double -> (V3 Double, Path)] -> Path
forall path point.
Monoid path =>
point -> [point -> (point, path)] -> path
Path.pathFrom V3 Double
forall a. Num a => V3 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
            [ V3 Double
-> V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
forall point path.
(AnyPath point path, Num point) =>
point -> point -> point -> point -> (point, path)
Path.bezierRelative (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0 Double
0 Double
0.5) (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0.5 Double
0.5 Double
0.5) (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0.5 Double
0.5 Double
1)
            , V3 Double
-> V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
forall point path.
(AnyPath point path, Num point) =>
point -> point -> point -> point -> (point, path)
Path.bezierRelative (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0 Double
0 Double
0.5) (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 (-Double
0.5) (-Double
0.5) Double
0.5) (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 (-Double
0.5) (-Double
0.5) Double
1)
            , V3 Double -> V3 Double -> V3 Double -> (V3 Double, Path)
forall point path.
(AnyPath point path, Num point) =>
point -> point -> point -> (point, path)
Path.arcViaRelative (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0 Double
1 Double
1) (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0 Double
2 Double
0)
            , V3 Double -> V3 Double -> (V3 Double, Path)
forall point path.
AnyPath point path =>
point -> point -> (point, path)
Path.lineTo (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0 Double
2 Double
0) 
            ] 
        sweepProfile :: Shape
sweepProfile = Path2D -> Shape
Shape.fromPath (Path2D -> Shape) -> Path2D -> Shape
forall a b. (a -> b) -> a -> b
$
                Path2D -> Path2D
Path2D.repeatLooping (Path2D -> Path2D) -> Path2D -> Path2D
forall a b. (a -> b) -> a -> b
$
                V2 Double -> V2 Double -> V2 Double -> V2 Double -> Path2D
forall point path.
AnyPath point path =>
point -> point -> point -> point -> path
Path2D.bezier (Double
0.25 Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ ASetter' (V2 Double) Double -> V2 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V2 Double) Double
forall a. Lens' (V2 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x) (Double
0.5 Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ ASetter' (V2 Double) Double -> V2 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V2 Double) Double
forall a. Lens' (V2 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x) (Double
0.5 Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Double -> V2 Double
forall a. Floating a => a -> V2 a
angle (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
6)) (Double
0.25 Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Double -> V2 Double
forall a. Floating a => a -> V2 a
angle (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
6))
    in Path -> Shape -> Solid
sweep Path
sweepPath Shape
sweepProfile