module LoftExample 
( loftExample
) where

import Linear (V3 (..))
import qualified Waterfall.Transforms as Transforms
import qualified Waterfall.TwoD.Transforms as Transforms2D
import qualified Waterfall.Booleans as Booleans
import qualified Waterfall.Solids as Solids
import qualified Waterfall.Sweep as Sweep
import qualified Waterfall.TwoD.Shape as Shape
import qualified Waterfall.Loft as Loft
import qualified Waterfall.Path.Common as Path

-- | [Loft](https://en.wikipedia.org/wiki/Loft_\(3D\)) is a method to create smooth 3D shapes. 
--
-- Analagous to the [lofting](https://en.wikipedia.org/wiki/Lofting) process in boat building. 
-- A loft is defined by planar cross-sections of the desired shape at chosen locations. 
-- These cross-sections are then interpolated to form a smooth 3d shape.
--
-- This example demonstrates the `Loft` module, by generating a boat, with the profile of the boat specified by a series of bezier curves.
loftExample :: Solids.Solid
loftExample :: Solid
loftExample = 
    let paths :: [Path]
paths = 
          [ let p :: a -> a -> V3 a
p a
x a
z = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
x a
0 a
z 
              -- the curve at the rear of the boat is tilted _slightly_ back
              in V3 Double -> Double -> Path -> Path
forall a. Transformable a => V3 Double -> Double -> a -> a
Transforms.rotate (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
1 Double
0 Double
0) Double
0.2 (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$
                  V3 Double -> V3 Double -> V3 Double -> V3 Double -> Path
forall point path.
(AnyPath point path, Epsilon point) =>
point -> point -> point -> point -> path
Path.bezier (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
0 Double
0) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
4 Double
0) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
5 Double
3) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
5 Double
4)
          , let p :: a -> a -> V3 a
p a
x a
z = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
x a
2 a
z 
              in  V3 Double -> V3 Double -> V3 Double -> V3 Double -> Path
forall point path.
(AnyPath point path, Epsilon point) =>
point -> point -> point -> point -> path
Path.bezier (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
0 Double
0) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
4 Double
0) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
5 Double
3) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
5 Double
4)
          , let p :: a -> a -> V3 a
p a
x a
z = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
x a
5 a
z 
              in  V3 Double -> V3 Double -> V3 Double -> V3 Double -> Path
forall point path.
(AnyPath point path, Epsilon point) =>
point -> point -> point -> point -> path
Path.bezier (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
0 Double
0) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
4 Double
0) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
5 Double
3) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
5 Double
4)
          , let p :: a -> a -> V3 a
p a
x a
z = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
x a
10 a
z
              in V3 Double -> V3 Double -> V3 Double -> V3 Double -> Path
forall point path.
(AnyPath point path, Epsilon point) =>
point -> point -> point -> point -> path
Path.bezier (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
1 Double
0) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
4.5 Double
0) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
5.25 Double
3) (Double -> Double -> V3 Double
forall {a}. Num a => a -> a -> V3 a
p Double
5.25 Double
4.2)
          ]
        mirror :: Path -> Path
mirror = V3 Double -> Path -> Path
forall a. Transformable a => V3 Double -> a -> a
Transforms.mirror (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
1 Double
0 Double
0 ) (Path -> Path) -> (Path -> Path) -> Path -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Path
forall point path. AnyPath point path => path -> path
Path.reversePath
        makeSymetric :: Path -> Path
makeSymetric Path
p = Path -> Path
mirror Path
p Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
p
        symetricPaths :: [Path]
symetricPaths = Path -> Path
makeSymetric (Path -> Path) -> [Path] -> [Path]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path]
paths
        body :: Solid
body = 
          Maybe (V3 Double) -> [Path] -> Maybe (V3 Double) -> Solid
Loft.pointedLoft 
            Maybe (V3 Double)
forall a. Maybe a
Nothing
            (Path -> Path
forall point path.
(AnyPath point path, Monoid path, Epsilon point) =>
path -> path
Path.closeLoop (Path -> Path) -> [Path] -> [Path]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  [Path]
symetricPaths)
            (V3 Double -> Maybe (V3 Double)
forall a. a -> Maybe a
Just (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0 Double
20 Double
5))
        -- shrink the boat shape slightly, and translate it
        -- use this to hollow out the boat
        cavity :: Solid
cavity = V3 Double -> Solid -> Solid
forall a. Transformable a => V3 Double -> a -> a
Transforms.translate (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0 (Double
0.025 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
20) Double
0.3) (Solid -> Solid) -> Solid -> Solid
forall a b. (a -> b) -> a -> b
$ Double -> Solid -> Solid
forall a. Transformable a => Double -> a -> a
Transforms.uScale Double
0.95 Solid
body
        -- sweep a circle along each of the paths, this makes them visible in the generated model
        sweepWithCircle :: Path -> Solid
sweepWithCircle = (Path -> Shape -> Solid
`Sweep.sweep` Double -> Shape -> Shape
forall a. Transformable2D a => Double -> a -> a
Transforms2D.uScale2D Double
0.2 Shape
Shape.unitCircle)
        splines :: Solid
splines = [Solid] -> Solid
forall a. Monoid a => [a] -> a
mconcat ([Solid] -> Solid) -> [Solid] -> Solid
forall a b. (a -> b) -> a -> b
$ Path -> Solid
sweepWithCircle (Path -> Solid) -> [Path] -> [Solid]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path]
symetricPaths
      in Double -> Solid -> Solid
forall a. Transformable a => Double -> a -> a
Transforms.uScale Double
0.1 (Solid -> Solid) -> Solid -> Solid
forall a b. (a -> b) -> a -> b
$
          (Solid
body Solid -> Solid -> Solid
forall a. Semigroup a => a -> a -> a
<> Solid
splines) Solid -> Solid -> Solid
`Booleans.difference` Solid
cavity