module OffsetExample 
( offsetExample 
) where

import qualified Waterfall.Solids as Solids
import Waterfall.Transforms (translate, rotate, scale)
import Waterfall.Offset (offset)
import Linear ( V3(V3), unit, _x, _y, _z, (^*))

offsetExample :: Solids.Solid
offsetExample :: Solid
offsetExample = 
  let beam :: V3 Double -> Solid
beam V3 Double
axis = V3 Double -> Double -> Solid -> Solid
forall a. Transformable a => V3 Double -> Double -> a -> a
rotate V3 Double
axis (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (V3 Double -> Solid -> Solid
forall a. Transformable a => V3 Double -> a -> a
scale (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
2 Double
2 Double
4) Solid
Solids.centeredCube)
      cross :: Solid
cross = (V3 Double -> Solid) -> [V3 Double] -> Solid
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap V3 Double -> Solid
beam [ASetter' (V3 Double) Double -> V3 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x,  ASetter' (V3 Double) Double -> V3 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y, ASetter' (V3 Double) Double -> V3 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z]
      tolerance :: Double
tolerance = Double
1e-6
      offsetCross :: Double -> Solid
offsetCross Double
amount = Double -> Double -> Solid -> Solid
offset Double
amount Double
tolerance Solid
cross
      offsetCrosses :: [Solid]
offsetCrosses = Double -> Solid
offsetCross (Double -> Solid) -> [Double] -> [Solid]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [- Double
0.5, - Double
0.25, Double
0, Double
0.25, Double
0.5] 
      position :: [V3 Double]
position = (ASetter' (V3 Double) Double -> V3 Double
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' (V3 Double) Double
forall a. Lens' (V3 a) a
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x V3 Double -> Double -> V3 Double
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Double
5 V3 Double -> Double -> V3 Double
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^*) (Double -> V3 Double) -> [Double] -> [V3 Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0..]  
  in [Solid] -> Solid
forall a. Monoid a => [a] -> a
mconcat ([Solid] -> Solid) -> [Solid] -> Solid
forall a b. (a -> b) -> a -> b
$ (V3 Double -> Solid -> Solid) -> [V3 Double] -> [Solid] -> [Solid]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith V3 Double -> Solid -> Solid
forall a. Transformable a => V3 Double -> a -> a
translate [V3 Double]
position [Solid]
offsetCrosses