module Geometry.Trajectory (
    -- * Various
      pointOnTrajectory
    , Reassemble.reassembleLines

    -- * Path simplifiers
    , SimplifyRdp.simplifyTrajectoryRdp
    , SimplifyRdp.simplifyTrajectoryRdpBy

    , SimplifyVW.simplifyTrajectoryVW
    , SimplifyVW.simplifyTrajectoryVWBy

    , SimplifyRadial.simplifyTrajectoryRadial
    , SimplifyRadial.simplifyTrajectoryRadialBy
) where



import           Data.Foldable
import           Data.Sequential
import qualified Data.Vector     as V
import           Prelude         hiding (lines)

import Geometry.Core
import Geometry.LookupTable.Lookup1
import Geometry.Trajectory.PathSimplifier.Radial              as SimplifyRadial
import Geometry.Trajectory.PathSimplifier.RamerDouglasPeucker as SimplifyRdp
import Geometry.Trajectory.PathSimplifier.VisvalingamWhyatt   as SimplifyVW
import Geometry.Trajectory.ReassembleLines                    as Reassemble



-- | Build a lookup table from arc length to the line that we’re on at that arc
-- length.
trajectoryLut :: [Vec2] -> LookupTable1 Double Line
trajectoryLut :: [Vec2] -> LookupTable1 Double Line
trajectoryLut = Vector (Double, Line) -> LookupTable1 Double Line
forall a b. Vector (a, b) -> LookupTable1 a b
LookupTable1 (Vector (Double, Line) -> LookupTable1 Double Line)
-> ([Vec2] -> Vector (Double, Line))
-> [Vec2]
-> LookupTable1 Double Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Double, Line)] -> Vector (Double, Line)
forall a. [a] -> Vector a
V.fromList ([(Double, Line)] -> Vector (Double, Line))
-> ([Vec2] -> [(Double, Line)]) -> [Vec2] -> Vector (Double, Line)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Line] -> [(Double, Line)]
go Double
0 ([Line] -> [(Double, Line)])
-> ([Vec2] -> [Line]) -> [Vec2] -> [(Double, Line)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vec2] -> [Line]
pairLines
  where
    pairLines :: [Vec2] -> [Line]
    pairLines :: [Vec2] -> [Line]
pairLines [Vec2]
xs = (Vec2 -> Vec2 -> Line) -> [Vec2] -> [Vec2] -> [Line]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Vec2 -> Vec2 -> Line
Line [Vec2]
xs ([Vec2] -> [Vec2]
forall a. HasCallStack => [a] -> [a]
tail [Vec2]
xs)

    go :: Double -> [Line] -> [(Double, Line)]
    go :: Double -> [Line] -> [(Double, Line)]
go !Double
_ [] = []
    go Double
currentDistance (Line
currentLine:[Line]
rest)
       = let newPosition :: Double
newPosition = Double
currentDistance Double -> Double -> Double
forall v. VectorSpace v => v -> v -> v
+. Line -> Double
lineLength Line
currentLine
         in (Double
currentDistance, Line
currentLine) (Double, Line) -> [(Double, Line)] -> [(Double, Line)]
forall a. a -> [a] -> [a]
: Double -> [Line] -> [(Double, Line)]
go Double
newPosition [Line]
rest

-- | Walk a certain 'Distance' on a trajectory defined by its points.
--
-- This caches the internal LUT when partially applied, so that the following will
-- only compute it once for repeated lookups:
--
-- @
-- let goto = 'pointOnTrajectory' […]
-- 'print' [goto d | d <- [0, 0.1 .. 5]]
-- @
pointOnTrajectory :: Sequential list => list Vec2 -> Double -> Vec2
pointOnTrajectory :: forall (list :: * -> *).
Sequential list =>
list Vec2 -> Double -> Vec2
pointOnTrajectory list Vec2
points
  = let lut :: LookupTable1 Double Line
lut = [Vec2] -> LookupTable1 Double Line
trajectoryLut (list Vec2 -> [Vec2]
forall a. list a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList list Vec2
points)
    in \Double
dist ->
        let (Double
start, Line
line) = LookupTable1 Double Line -> Double -> (Double, Line)
forall a b. Ord a => LookupTable1 a b -> a -> (a, b)
lookupBiasLower LookupTable1 Double Line
lut Double
dist
            distLeft :: Double
distLeft = Double
dist Double -> Double -> Double
forall v. VectorSpace v => v -> v -> v
-. Double
start
        in Line -> Double -> Vec2
moveAlongLine Line
line Double
distLeft