module RSAGL.Modeling.Extrusion
(extrude,
extrudeTube,
extrudePrism)
where
import RSAGL.Math.Curve
import RSAGL.Math.CurveExtras
import RSAGL.Math.Vector
import RSAGL.Math.Affine
import Control.Applicative
import RSAGL.Scene.CoordinateSystems
import RSAGL.Math.Orthogonal
import Data.Maybe
import RSAGL.Math.Types
extrude :: Curve (Either Point3D Vector3D) ->
Curve Point3D ->
Curve (Curve Point3D) ->
Surface Point3D
extrude upish spine loop = wrapSurface $
transformation <$>
(modelLookAt <$> spine <*>
(forward <$> Right <$> spine') <*>
(up <$> upish)) <*>
loop
where spine' = curveDerivative spine
extrudeTube :: Curve RSdouble -> Curve Point3D -> Surface Point3D
extrudeTube radius spine =
extrude upish
spine
(scale' <$> radius <*> pure circleXY)
where upish = pure $ Right $ fromMaybe
(let [a,b] = iterateCurve 2 spine
in fst $ orthos $ vectorToFrom a b) $
newellCurve spine
extrudePrism :: Vector3D -> (Point3D,RSdouble) -> (Point3D,RSdouble) -> Curve Point3D -> Surface Point3D
extrudePrism upish (a,ra) (b,rb) c =
extrude (pure $ Right $ upish)
(linearInterpolation [a,b])
(flip scale' c <$> linearInterpolation [ra,rb])