{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE LambdaCase #-}
module Imj.Graphics.Animation.Design.UpdateAnimatedPoints
( updateAnimatedPoints
) where
import Imj.Prelude
import Data.List( length )
import Data.Maybe( fromMaybe )
import Imj.Geo.Discrete
import Imj.Graphics.Animation.Design.Types
import Imj.Iteration
updateAnimatedPoints :: [Coords Pos -> Frame -> [AnimatedPoint]]
-> (Coords Pos -> InteractionResult)
-> Frame
-> AnimatedPoints
-> AnimatedPoints
updateAnimatedPoints [] _ _ aps = aps
updateAnimatedPoints (f:fs) interaction globalFrame (AnimatedPoints branches center startFrame) =
let relativeFrame = globalFrame - startFrame
branchesLevel1Mutated = updatePointsAndMutateIfNeeded f center relativeFrame interaction branches
newBranches = map (\case
Left aps -> Left $ updateAnimatedPoints fs interaction relativeFrame aps
Right ap -> Right ap
) branchesLevel1Mutated
in AnimatedPoints (Just newBranches) center startFrame
updatePointsAndMutateIfNeeded :: (Coords Pos -> Frame -> [AnimatedPoint])
-> Coords Pos
-> Frame
-> (Coords Pos -> InteractionResult)
-> Maybe [Either AnimatedPoints AnimatedPoint]
-> [Either AnimatedPoints AnimatedPoint]
updatePointsAndMutateIfNeeded animation root frame interaction branches =
let points = animation (assert (interaction root == Stable) root) frame
defaultState = map (\(AnimatedPoint canInteract _ _) -> Right $ AnimatedPoint canInteract root Nothing) points
previousState = fromMaybe defaultState branches
in combine points previousState frame interaction
combine :: [AnimatedPoint]
-> [Either AnimatedPoints AnimatedPoint]
-> Frame
-> (Coords Pos -> InteractionResult)
-> [Either AnimatedPoints AnimatedPoint]
combine points previousState frame interaction =
let check = allowedPointCountVariation (length previousState) (length points)
in assert check $
zipWith
(combinePoints interaction frame)
points previousState
combinePoints :: (Coords Pos -> InteractionResult)
-> Frame
-> AnimatedPoint
-> Either AnimatedPoints AnimatedPoint
-> Either AnimatedPoints AnimatedPoint
combinePoints interaction frame point@(AnimatedPoint onWall coords _) =
either
Left
(\(AnimatedPoint prevOnWall prevCoords' _) ->
case assert (prevOnWall == onWall) onWall of
DontInteract -> Right point
Interact ->
let prevCoords = assert (interaction prevCoords' == Stable) prevCoords'
trajectory = bresenham $ mkSegment prevCoords coords
in maybe
(Right $ assert (interaction coords == Stable) point)
(\preCollision ->
Left $ AnimatedPoints Nothing preCollision frame)
$ getCoordsBeforeMutation trajectory interaction
)
getCoordsBeforeMutation :: [Coords Pos] -> (Coords Pos -> InteractionResult) -> Maybe (Coords Pos)
getCoordsBeforeMutation [] _ = error "not supposed to happen"
getCoordsBeforeMutation [_] _ = Nothing
getCoordsBeforeMutation (a:as@(b:_)) interaction =
case interaction b of
Stable -> getCoordsBeforeMutation as interaction
Mutation -> Just a
allowedPointCountVariation :: Int
-> Int
-> Bool
allowedPointCountVariation from to =
to == from || to == 0