imj-animation (empty) → 0.1.0.2
raw patch · 17 files changed
+1069/−0 lines, 17 filesdep +basedep +imj-basedep +imj-preludesetup-changed
Dependencies added: base, imj-base, imj-prelude, mtl
Files
- CHANGELOG.md +8/−0
- LICENSE +30/−0
- README.md +21/−0
- Setup.hs +2/−0
- imj-animation.cabal +57/−0
- src/Imj/Graphics/Animation.hs +249/−0
- src/Imj/Graphics/Animation/Chars.hs +61/−0
- src/Imj/Graphics/Animation/Design/Color.hs +21/−0
- src/Imj/Graphics/Animation/Design/Create.hs +69/−0
- src/Imj/Graphics/Animation/Design/Render.hs +65/−0
- src/Imj/Graphics/Animation/Design/Timing.hs +24/−0
- src/Imj/Graphics/Animation/Design/Types.hs +99/−0
- src/Imj/Graphics/Animation/Design/Update.hs +63/−0
- src/Imj/Graphics/Animation/Design/UpdateAnimatedPoints.hs +130/−0
- src/Imj/Graphics/Animation/Geo.hs +156/−0
- src/Imj/Graphics/Animation/Internal.hs +10/−0
- test/Spec.hs +4/−0
+ CHANGELOG.md view
@@ -0,0 +1,8 @@+# Changelog++This project adheres to [Haskell PVP](https://pvp.haskell.org/).+++## 0.1.0.2 [2018-01-01]++- Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Olivier Sohn (c) 2017 - 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Olivier Sohn nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,21 @@+# What is it?++A framework to create event-based, physics-based, composed, generative animations.++Also contains ready-to-use animations.++## Demos++The following game uses this library to create its animations:++[](https://asciinema.org/a/151434)++# Build++You can build using [stack](https://docs.haskellstack.org):++`stack build --pedantic`++# Contributions++Contributions are welcome!
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ imj-animation.cabal view
@@ -0,0 +1,57 @@+name: imj-animation+version: 0.1.0.2+Category: Animation, Game Engine, Graphics, Algorithms+Synopsis: Animation Framework+Description: Framework to create event-based, physics-based, composed, generative animations.+homepage: https://github.com/OlivierSohn/hamazed/blob/master/imj-animation/README.md+bug-reports: https://github.com/OlivierSohn/hamazed/issues/+license: BSD3+license-file: LICENSE+author: Olivier Sohn+maintainer: olivier.sohn@gmail.com+copyright: 2017 - 2018 Olivier Sohn+build-type: Simple+extra-source-files: README.md CHANGELOG.md+cabal-version: >=1.10++Tested-With: GHC == 8.0.2, GHC == 8.2.2++library+ hs-source-dirs: src+ other-modules:+ exposed-modules:+ -- initially in a separate module for implementations+ Imj.Graphics.Animation+ , Imj.Graphics.Animation.Chars+ , Imj.Graphics.Animation.Geo+ , Imj.Graphics.Animation.Internal+ -- initially in a separate module for core+ , Imj.Graphics.Animation.Design.Color+ , Imj.Graphics.Animation.Design.Create+ , Imj.Graphics.Animation.Design.Render+ , Imj.Graphics.Animation.Design.Timing+ , Imj.Graphics.Animation.Design.Types+ , Imj.Graphics.Animation.Design.Update+ , Imj.Graphics.Animation.Design.UpdateAnimatedPoints+ build-depends: base >= 4.8 && < 4.11+ , mtl >= 2.2.1 && < 2.3+ , imj-base ==0.1.*+ , imj-prelude ==0.1.*+ ghc-options: -Wall -fpedantic-bottoms -Wredundant-constraints+ -fexcess-precision -optc-ffast-math+ default-language: Haskell2010++test-suite imj-animation-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ other-modules:+ main-is: Spec.hs+ build-depends: base >= 4.8 && < 4.11+ ghc-options: -Wall -fpedantic-bottoms -Wredundant-constraints+ -fexcess-precision -optc-ffast-math+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/OlivierSohn/hamazed/+ subdir: imj-animation
+ src/Imj/Graphics/Animation.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Graphics.Animation+ (+ -- * Animation functions+ -- | Animation functions are used by 'Animation's to update 'AnimatedPoint's.+ gravityFallGeo+ , simpleExplosionGeo+ , quantitativeExplosionGeo+ , animatePolygonGeo+ , laserAnimationGeo+ -- * Animation+ , Animation+ {- | An 'Animation' generates 'AnimatedPoint's: -}+ , AnimatedPoint(..)+ -- | 'AnimatedPoint's can interact with their environment:+ , CanInteract(..)+ -- | The result of an interaction between an 'AnimatedPoint' and its environment+ -- can trigger a /mutation/:+ , InteractionResult(..)+ {- | 'AnimatedPoint's live in a+ <https://en.wikipedia.org/wiki/Tree_(graph_theory) tree-like structure>:+ -}+ , AnimatedPoints(..)+ -- ** Create+ , mkAnimation+ -- ** Predefined animations+ -- *** Explosive+ , simpleExplosion+ , quantitativeExplosionThenSimpleExplosion+ -- *** Free fall+ {- | 'freeFall' simulates the effect of gravity on an object that has an initial speed.++ 'freeFallThenExplode' adds an explosion when the falling object hits the environment+ (ie when the 'InteractionResult' of an interaction between the object and+ the environment is 'Mutation').+ -}+ , freeFall+ , freeFallThenExplode+ -- *** Fragments+ {- | 'fragmentsFreeFall' gives the impression that the object disintegrated in multiple+ pieces before falling.++ 'fragmentsFreeFallThenExplode' adds an explosion when the falling object hits the environment+ (ie when the 'InteractionResult' of an interaction between the object and+ the environment is 'Mutation').+ -}+ , fragmentsFreeFall+ , fragmentsFreeFallThenExplode+ -- *** Geometric+ , animatedPolygon+ , laserAnimation+ -- *** Nice chars+ {-| 'niceChar' presents a list of 'Char's that /look good/+ when used in explosive and free fall animations. -}+ , niceChar+ -- ** Update+ , getDeadline+ , shouldUpdate+ , updateAnimation+ -- ** Render+ , renderAnim+ -- * Internal+ , module Imj.Graphics.Animation.Internal+ -- * Reexports+ , module Imj.Timing+ , module Imj.Iteration+ , Coords+ ) where++import Imj.Prelude++import Imj.GameItem.Weapon.Laser.Types+import Imj.Geo.Continuous+import Imj.Geo.Discrete+import Imj.Graphics.Animation.Chars+import Imj.Graphics.Animation.Design.Create+import Imj.Graphics.Animation.Design.Color+import Imj.Graphics.Animation.Design.Render+import Imj.Graphics.Animation.Design.Timing+import Imj.Graphics.Animation.Design.Types+import Imj.Graphics.Animation.Design.Update+import Imj.Graphics.Animation.Geo+import Imj.Graphics.Animation.Internal+import Imj.Iteration+import Imj.Timing++-- | A laser ray animation, with a fade-out effect.+laserAnimation :: LaserRay Actual+ -- ^ The laser ray+ -> (Coords Pos -> InteractionResult)+ -- ^ Environment interaction function+ -> Either SystemTime KeyTime+ -- ^ 'Right' 'KeyTime' of the event's deadline+ -- that triggered this animation, or 'Left' 'SystemTime'+ -- of the current time if a player action triggered this animation+ -> Maybe Animation+laserAnimation ray@(LaserRay _ (Ray seg)) interaction keyTime =+ let pos = fst $ extremities seg -- this needs to be collision-free+ in mkAnimation pos [laserAnimationGeo ray] (Speed 1) interaction keyTime Nothing++-- | An animation chaining two circular explosions, the first explosion+-- can be configured in number of points, the second has 4*8=32 points.+quantitativeExplosionThenSimpleExplosion :: Int+ -- ^ Number of points in the first explosion+ -> Coords Pos+ -- ^ Center of the first explosion+ -> (Coords Pos -> InteractionResult)+ -- ^ Environment interaction function+ -> Speed+ -- ^ Animation speed+ -> Either SystemTime KeyTime+ -- ^ 'Right' 'KeyTime' of the event's deadline+ -- that triggered this animation, or 'Left' 'SystemTime'+ -- of the current time if a player action triggered this animation+ -> Char+ -- ^ Character used when drawing the animation.+ -> Maybe Animation+quantitativeExplosionThenSimpleExplosion num pos interaction animSpeed keyTime char =+ let funcs = [ quantitativeExplosionGeo num Interact+ , simpleExplosionGeo 8 Interact ]+ in mkAnimation pos funcs animSpeed interaction keyTime (Just char)++-- | An animation where a geometric figure (polygon or circle) expands then shrinks,+-- and doesn't interact with the environment.+animatedPolygon :: Int+ -- ^ If n==1, the geometric figure is a circle, else if n>1, a n-sided polygon+ -> Coords Pos+ -- ^ Center of the polygon (or circle)+ -> (Coords Pos -> InteractionResult)+ -- ^ Environment interaction function+ -> Speed+ -- ^ Animation speed+ -> Either SystemTime KeyTime+ -- ^ 'Right' 'KeyTime' of the event's deadline+ -- that triggered this animation, or 'Left' 'SystemTime'+ -- of the current time if a player action triggered this animation+ -> Char+ -- ^ Character used when drawing the animation.+ -> Maybe Animation+animatedPolygon n pos interaction animSpeed keyTime char =+ mkAnimation pos [animatePolygonGeo n] animSpeed interaction keyTime (Just char)++-- | A circular explosion configurable in number of points+simpleExplosion :: Int+ -- ^ Number of points in the explosion+ -> Coords Pos+ -- ^ Center of the explosion+ -> (Coords Pos -> InteractionResult)+ -- ^ Environment interaction function+ -> Speed+ -- ^ Animation speed+ -> Either SystemTime KeyTime+ -- ^ 'Right' 'KeyTime' of the event's deadline+ -- that triggered this animation, or 'Left' 'SystemTime'+ -- of the current time if a player action triggered this animation+ -> Char+ -- ^ Character used when drawing the animation.+ -> Maybe Animation+simpleExplosion resolution pos interaction animSpeed keyTime char =+ mkAnimation pos [simpleExplosionGeo resolution Interact] animSpeed interaction keyTime (Just char)++-- | Animation representing an object with an initial velocity disintegrating in+-- 4 different parts.+fragmentsFreeFall :: Vec2 Vel+ -- ^ Initial speed+ -> Coords Pos+ -- ^ Initial position+ -> (Coords Pos -> InteractionResult)+ -- ^ Environment interaction function+ -> Speed+ -- ^ Animation speed+ -> Either SystemTime KeyTime+ -- ^ 'Right' 'KeyTime' of the event's deadline+ -- that triggered this animation, or 'Left' 'SystemTime'+ -- of the current time if a player action triggered this animation+ -> Char+ -- ^ Character used when drawing the animation.+ -> [Animation]+fragmentsFreeFall speed pos interaction animSpeed keyTime char =+ mapMaybe (\sp -> freeFall sp pos interaction animSpeed keyTime char) $ variations speed++-- | A gravity-based free-falling animation.+freeFall :: Vec2 Vel+ -- ^ Initial speed+ -> Coords Pos+ -- ^ Initial position+ -> (Coords Pos -> InteractionResult)+ -- ^ Environment interaction function+ -> Speed+ -- ^ Animation speed+ -> Either SystemTime KeyTime+ -- ^ 'Right' 'KeyTime' of the event's deadline+ -- that triggered this animation, or 'Left' 'SystemTime'+ -- of the current time if a player action triggered this animation+ -> Char+ -- ^ Character used when drawing the animation.+ -> Maybe Animation+freeFall speed pos interaction animSpeed keyTime char =+ mkAnimation pos [gravityFallGeo speed Interact] animSpeed interaction keyTime (Just char)++-- | Animation representing an object with an initial velocity disintegrating in+-- 4 different parts free-falling and then exploding.+fragmentsFreeFallThenExplode :: Vec2 Vel+ -- ^ Initial speed+ -> Coords Pos+ -- ^ Initial position+ -> (Coords Pos -> InteractionResult)+ -- ^ Environment interaction function+ -> Speed+ -- ^ Animation speed+ -> Either SystemTime KeyTime+ -- ^ 'Right' 'KeyTime' of the event's deadline+ -- that triggered this animation, or 'Left' 'SystemTime'+ -- of the current time if a player action triggered this animation+ -> Char+ -- ^ Character used when drawing the animation.+ -> [Animation]+fragmentsFreeFallThenExplode speed pos interaction k s c =+ mapMaybe (\sp -> freeFallThenExplode sp pos interaction k s c) $ variations speed++-- | Given an input speed, computes four slightly different input speeds+variations :: Vec2 Vel -> [Vec2 Vel]+variations sp =+ map (sumVec2d sp) [ Vec2 0.12 (-0.16)+ , Vec2 (-0.22) (-0.116)+ , Vec2 (-0.04) 0.36+ , Vec2 0.48 0.08]++-- | An animation chaining a gravity-based free-fall and a circular explosion of 4*8 points.+freeFallThenExplode :: Vec2 Vel+ -- ^ Initial speed+ -> Coords Pos+ -- ^ Initial position+ -> (Coords Pos -> InteractionResult)+ -- ^ Environment interaction function+ -> Speed+ -- ^ Animation speed+ -> Either SystemTime KeyTime+ -- ^ 'Right' 'KeyTime' of the event's deadline+ -- that triggered this animation, or 'Left' 'SystemTime'+ -- of the current time if a player action triggered this animation+ -> Char+ -- ^ Character used when drawing the animation.+ -> Maybe Animation+freeFallThenExplode speed pos interaction animSpeed keyTime char =+ let funcs = [ gravityFallGeo speed Interact+ , simpleExplosionGeo 8 Interact]+ in mkAnimation pos funcs animSpeed interaction keyTime (Just char)
+ src/Imj/Graphics/Animation/Chars.hs view
@@ -0,0 +1,61 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Graphics.Animation.Chars+ ( niceChar+ -- * Reexports+ , Word8+ ) where++import Imj.Prelude++import Data.Word(Word8)++-- | Returns one of the characters that /look good/ for explosive animations.+niceChar :: Word8+ -- ^ We take the modulo of that value+ -> Char+niceChar i'+ | i == 0 = '$'+ | i == 1 = '?'+ | i == 2 = 'd'+ | i == 3 = 'R'+ | i == 4 = 'O'+ | i == 5 = 'o'+ | i == 6 = '^'+ | i == 7 = 'à'+ | i == 8 = '{'+ | i == 9 = '['+ | i == 10 = '|'+ | i == 11 = '!'+ | i == 12 = ':'+ | i == 13 = '¨'+ | i == 14 = '`'+ | i == 15 = '&'+ | i == 16 = '#'+ | i == 17 = '@'+ | i == 18 = '='+ | i == 19 = '\\'+ | i == 20 = '/'+ | i == 21 = '*'+ | otherwise = error $ "logic error in niceChar " ++ show i'+ where+ end = 22+ i = abs $ i' `mod` end++ -- characters by type:+ -- funny : $+ -- surprising : ?+ -- beautiful : d+ -- visible : R+ -- bubbly : O o+ -- birds : ^ { [+ -- interesting: à+ -- subtle : | !+ -- nice : : & =+ -- very light : ¨ `+ -- heavy : #+ -- round : @+ -- sharp : \ /+ -- rich : *
+ src/Imj/Graphics/Animation/Design/Color.hs view
@@ -0,0 +1,21 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Graphics.Animation.Design.Color+ ( colorFromFrame+ ) where++import Imj.Prelude++import Imj.Graphics.Color+import Imj.Iteration++-- | Returns the color used to draw an animation, based on the frame number+-- (relative to the parent animation, if any).+colorFromFrame :: Frame -> LayeredColor+colorFromFrame (Frame f) = onBlack $ rgb r g b+ where+ r = assert (f >= 0) 4+ g = fromIntegral $ (0 + quot f 6) `mod` 2 -- [0..1] , slow changes+ b = fromIntegral $ (0 + quot f 3) `mod` 3 -- [0..2] , 2x faster changes
+ src/Imj/Graphics/Animation/Design/Create.hs view
@@ -0,0 +1,69 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Graphics.Animation.Design.Create+ ( mkAnimation+ ) where+++import Imj.Prelude++import Imj.Geo.Discrete+import Imj.Graphics.Animation.Design.Types+import Imj.Graphics.Animation.Design.Update+import Imj.Graphics.Animation.Design.UpdateAnimatedPoints+import Imj.Iteration+import Imj.Timing++-- | Creates an animation and initializes it by updating it once.+mkAnimation :: Coords Pos+ -- ^ Center of the root 'AnimatedPoints'.+ -> [Coords Pos -> Frame -> [AnimatedPoint]]+ {- ^ List of /animation functions/. Every /animation function/ generates+ 'AnimatedPoint's for a given level of the root 'AnimatedPoints':++ The k-th /animation function/ generates 'AnimatedPoints'+ living in the (k+2)-th level, and takes the center of a (k+1)-th+ level 'AnimatedPoints' in its 'Coords' argument.++ /Animation functions/ are expected to return the same number of 'AnimatedPoint's+ at each iteration, or none after a given iteration to indicate that+ their animation is over. -}+ -> Speed+ -- ^ Animation discrete speed. Tells by how much the 'Frame', passed+ -- to animation functions, is incremented during an update.+ -> (Coords Pos -> InteractionResult)+ {- ^ The environmental interaction function.++ During update, 'AnimatedPoint's for which this function returns+ 'Mutation' can mutate if they are allowed to.++ During render, 'AnimatedPoint's for which this+ function returns 'Stable' are drawn. Others are+ not drawn because they would overlap with the environment. -}+ -> Either SystemTime KeyTime+ -- ^ 'Right' 'KeyTime' of the event's deadline+ -- that triggered this animation, or 'Left' 'SystemTime'+ -- of the current time if a player action triggered this animation+ -> Maybe Char+ {- ^ The default 'Char' to draw an 'AnimatedPoint' with, if an 'AnimatedPoint'+ of that 'Animation' doesn't specify one (i.e if one of the /animation functions/+ passed as argument don't set the 'Char' of the 'AnimatedPoint' they generate). -}+ -> Maybe Animation+ -- ^ Depending on /animation functions/, the created 'Animation' may be over+ -- after the first update, hence 'Nothing' would be returned.+mkAnimation center updates speed interaction t' mayChar =+ let update = updateAnimatedPoints updates+ t = either KeyTime id t'+ u = UpdateSpec t (zeroIteration speed)+ points = mkAnimatedPoints center+ in updateAnimation $ Animation points update interaction u mayChar+++-- | Constructs an 'AnimatedPoints'.+mkAnimatedPoints :: Coords Pos+ -- ^ Where the first animation should start.+ -> AnimatedPoints+mkAnimatedPoints center =+ AnimatedPoints Nothing center 0
+ src/Imj/Graphics/Animation/Design/Render.hs view
@@ -0,0 +1,65 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Graphics.Animation.Design.Render+ ( renderAnim+ ) where+++import Imj.Prelude++import Control.Monad.IO.Class(MonadIO)+import Control.Monad.Reader.Class(MonadReader)++import Data.Either(partitionEithers)++import Imj.Geo.Discrete+import Imj.Graphics.Animation.Design.Types+import Imj.Graphics.Animation.Design.Color+import Imj.Graphics.Render+import Imj.Iteration++{- | If an 'AnimatedPoint' has no specific 'Char' to be rendered with,+it will be rendered with the 'Char' of the 'Animation'.++Hence, if neither 'AnimatedPoint' nor 'Animation' contain a 'Char', this function+errors.-}+{-# INLINABLE renderAnim #-}+renderAnim :: (Draw e, MonadReader e m, MonadIO m)+ => Animation+ -> Coords Pos+ -- ^ Reference coordinates.+ -> m ()+renderAnim (Animation points _ interaction (UpdateSpec _ (Iteration _ frameForNextUpdate)) mayChar) =+ render' frameForNextUpdate mayChar points interaction++{-# INLINABLE render' #-}+render' :: (Draw e, MonadReader e m, MonadIO m)+ => Frame+ -> Maybe Char+ -- ^ Default char to use when there is no char specified in the state+ -> AnimatedPoints+ -> (Coords Pos -> InteractionResult)+ -> Coords Pos+ -> m ()+render' _ _ (AnimatedPoints Nothing _ _) _ _ = return ()+render' _ _ (AnimatedPoints (Just []) _ _) _ _ = return ()+render'+ parentFrame mayCharAnim (AnimatedPoints (Just branches) _ childFrame) interaction r = do+ let (children, aliveCoordinates) = partitionEithers branches+ selectRenderedCoordinates =+ filter (\(AnimatedPoint canInteract coords _) ->+ case canInteract of+ -- An alive animated point may collide:+ DontInteract -> interaction coords == Stable+ -- We make the assumption that every alive point is guaranteed to be collision-free.+ -- Note that when the environment will be dynamic, it will be wrong:+ Interact -> True)+ relFrame = parentFrame - childFrame+ color = colorFromFrame relFrame+ mapM_ (\(AnimatedPoint _ c mayChar) -> do+ let char = fromMaybe (error "no char was specified") $ mayChar <|> mayCharAnim+ drawChar char (sumCoords c r) color)+ $ selectRenderedCoordinates aliveCoordinates+ mapM_ (\child -> render' relFrame mayCharAnim child interaction r) children
+ src/Imj/Graphics/Animation/Design/Timing.hs view
@@ -0,0 +1,24 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Graphics.Animation.Design.Timing+ ( animationPeriod+ , animationUpdateMargin+ ) where++import Imj.Timing++-- | The console can refresh at approx. 21 fps, hence this value seems+-- appropriate (1/25 second)+animationPeriod :: DiffTime+animationPeriod = 0.04++{- | When there are multiple unsynchronized animations running,+there could be a lot of scene renderings in the same 1/100th second.++To prevent performance degradation we allow some margin+to group update deadlines.+-}+animationUpdateMargin :: DiffTime+animationUpdateMargin = 0.01
+ src/Imj/Graphics/Animation/Design/Types.hs view
@@ -0,0 +1,99 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Graphics.Animation.Design.Types+ ( Animation(..)+ , UpdateSpec(..)+ , AnimatedPoints(..)+ , AnimatedPoint(..)+ , CanInteract(..)+ , InteractionResult(..)+ ) where++import Imj.Prelude++import GHC.Show(showString)++import Imj.Geo.Discrete+import Imj.Iteration+import Imj.Timing+++data Animation = Animation {+ _animationPoints :: !AnimatedPoints+ -- ^ The current points.+ , _animationUpdate :: !((Coords Pos -> InteractionResult)+ -> Frame+ -> AnimatedPoints+ -> AnimatedPoints)+ -- ^ The function updating 'AnimatedPoints'.+ , _animationInteraction :: !(Coords Pos -> InteractionResult)+ -- ^ The environment interaction function.+ , _animationNextUpdateSpec :: !UpdateSpec+ -- ^ The time and iteration of the next update+ , _animationChar :: !(Maybe Char)+ -- ^ The char used to draw animated points when the 'AnimatedPoints'+ -- don't specify one. If 'Nothing', the animation function /must/ specify one+ -- when creating new 'AnimatedPoint's.+}++instance Show Animation where+ showsPrec _ (Animation a _ _ b c) =+ showString $ "Animation{" ++ show (a,b,c) ++ "}"+++data UpdateSpec = UpdateSpec {+ _updateSpecTime :: !KeyTime+ -- ^ The time at which the update should happen.+ , _updateSpecIteration :: !Iteration+ -- ^ The iteration that will be used in the update.+} deriving(Show)+++data AnimatedPoints = AnimatedPoints {+ _animatedPointsBranches :: !(Maybe [Either AnimatedPoints AnimatedPoint])+ -- ^ The children. A child can be 'Right' 'AnimatedPoint' or 'Left' 'AnimatedPoints'.+ --+ -- When a 'Right' 'AnimatedPoint' mutates, it is converted to an empty 'Left' 'AnimatedPoints'+ , _animatedPointsCenter :: !(Coords Pos)+ -- ^ The center, aka the coordinates of the 'AnimatedPoint', w.r.t the animation reference frame,+ -- that gave birth to this 'AnimatedPoints'.+ , _animatedPointsFrame :: !Frame+ -- ^ The frame at which this 'AnimatedPoints' was created, relatively to the parent, if any.+} deriving (Show)++data AnimatedPoint = AnimatedPoint {+ _animatedPointCanInteract :: !CanInteract+ -- ^ Can the point interact with the environment?+ , _animatedPointCoords :: {-# UNPACK #-} !(Coords Pos)+ -- ^ Its location, w.r.t the animation reference frame.+ , _animatedPointRenderedWith :: !(Maybe Char)+ -- ^ The char used to render it. If 'Nothing', 'Animation' /must/ specify a 'Char'.+} deriving (Show)++data CanInteract = DontInteract+ -- ^ The 'AnimatedPoint' can't interact with the environment.+ --+ -- To ensure that the 'Animation' is finite in time,+ -- animation functions returning 'AnimatedPoint's that+ -- 'DontInteract' should return an empty list of 'AnimatedPoint's+ -- for each 'Frame' after a given 'Frame'.+ | Interact+ -- ^ The 'AnimatedPoint' can be mutated after an interaction+ -- with the environment.+ --+ -- For the animation to be finite in time, 'AnimatedPoint's that+ -- 'Interact' /must/ eventually be mutated by the environment.+ --+ -- Hence, assuming the environment has a finite size,+ -- animation functions returning 'AnimatedPoint's that+ -- 'Interact' can guarantee animation finitude by computing their+ -- coordinates using functions diverging in the 'Frame' argument.+ deriving (Show, Eq)++data InteractionResult = Mutation+ -- ^ The 'AnimatedPoint' can mutate.+ | Stable+ -- ^ The 'AnimatedPoint' doesn't mutate.+ deriving(Eq,Show)
+ src/Imj/Graphics/Animation/Design/Update.hs view
@@ -0,0 +1,63 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Graphics.Animation.Design.Update+ ( shouldUpdate+ , updateAnimation+ , getDeadline+ ) where+++import Imj.Prelude++import Data.Either(partitionEithers)++import Imj.Graphics.Animation.Design.Types+import Imj.Graphics.Animation.Design.Timing+import Imj.Iteration+import Imj.Timing+++{- | Returns 'True' if the 'KeyTime' is beyond the 'Animation' deadline or if the+time difference is within 'animationUpdateMargin'. -}+shouldUpdate :: Animation+ -> KeyTime+ -- ^ The current 'KeyTime'+ -> Bool+shouldUpdate a (KeyTime k) =+ let (KeyTime k') = getDeadline a+ in diffSystemTime k' k < animationUpdateMargin++updateAnimation :: Animation+ -- ^ The current animation+ -> Maybe Animation+ -- ^ The updated animation, or Nothing if the 'Animation'+ -- is over.+updateAnimation+ (Animation points update interaction (UpdateSpec k it@(Iteration _ frame)) c) =+ let newPoints = update interaction frame points+ newUpdateSpec = UpdateSpec (addDuration animationPeriod k) (nextIteration it)+ newAnim = Animation newPoints update interaction newUpdateSpec c+ in case isActive newAnim of+ True -> Just newAnim+ False -> Nothing++isActive :: Animation+ -> Bool+isActive (Animation points _ _ _ _) =+ hasActivePoints points++hasActivePoints :: AnimatedPoints+ -> Bool+hasActivePoints (AnimatedPoints Nothing _ _) = False+hasActivePoints (AnimatedPoints (Just []) _ _) = False+hasActivePoints (AnimatedPoints (Just branches) _ _) =+ let (children, activeCoordinates) = partitionEithers branches+ childrenActive = map hasActivePoints children+ in (not . null) activeCoordinates || or childrenActive++-- | Returns the time at which an 'Animation' should be updated.+getDeadline :: Animation -> KeyTime+getDeadline (Animation _ _ _ (UpdateSpec k _) _) = k
+ src/Imj/Graphics/Animation/Design/UpdateAnimatedPoints.hs view
@@ -0,0 +1,130 @@+{-# 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+++{- | Given a length \( n \) list of animation functions, updates the \( n \)+first levels of an 'AnimatedPoints' using one animation function per level.++An 'AnimatedPoint' at level \( k <= n \) can mutate to an 'AnimatedPoints' by+interacting with its environment:++* if \( k = n \) , the new 'AnimatedPoints' will remain empty.+* if \( k < n \), the new 'AnimatedPoints' will be populated by 'AnimatedPoints'+using the \( k+1 \)th animation function.+-}+updateAnimatedPoints :: [Coords Pos -> Frame -> [AnimatedPoint]]+ -- ^ The animation function at index @i@ updates+ -- 'AnimatedPoints' at level @i@.+ -> (Coords Pos -> InteractionResult)+ -- ^ Interaction function+ -> Frame+ -- ^ Current iteration+ -> 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+ -- recurse for the 'AnimatedPoints's+ Left aps -> Left $ updateAnimatedPoints fs interaction relativeFrame aps+ -- the 'AnimatedPoint's are already up-to-date due to updatePointsAndMutateIfNeeded:+ Right ap -> Right ap+ ) branchesLevel1Mutated+ in AnimatedPoints (Just newBranches) center startFrame+++-- | Doesn't change the existing /level 1/ 'AnimatedPoints's, but can convert some+-- 'AnimatedPoint's to 'AnimatedPoints's.+updatePointsAndMutateIfNeeded :: (Coords Pos -> Frame -> [AnimatedPoint])+ -- ^ Geometric animation function+ -> Coords Pos+ -- ^ Center of the animation+ -> Frame+ -- ^ Relative frame+ -> (Coords Pos -> InteractionResult)+ -- ^ Interaction function+ -> Maybe [Either AnimatedPoints AnimatedPoint]+ -- ^ Current branches+ -> [Either AnimatedPoints AnimatedPoint]+ -- ^ Updated branches+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+ -- if previousState contains only Left(s), the animation does not need to be computed.+ -- I wonder if lazyness takes care of that or not?+ 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 ->+ -- The assert verifies that we can drop the first point of the trajectory.+ -- This is because the environment is static.+ 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+ )++-- The first point of the trajectory is expected to be stable+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++{- | Verifies that the variation in number of points is allowed:++Number of points generated by /animation functions/ should be always the same,+or change from non-zero to 0 (to indicate the end of the animation).+-}+allowedPointCountVariation :: Int+ -- ^ From+ -> Int+ -- ^ To+ -> Bool+allowedPointCountVariation from to =+ to == from || to == 0
+ src/Imj/Graphics/Animation/Geo.hs view
@@ -0,0 +1,156 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Graphics.Animation.Geo+ ( gravityFallGeo+ , simpleExplosionGeo+ , quantitativeExplosionGeo+ , animatePolygonGeo+ , laserAnimationGeo+ ) where++import Imj.Prelude++import Data.Char( intToDigit )+import Data.List( length )++import Imj.GameItem.Weapon.Laser.Types+import Imj.Geo.Continuous+import Imj.Geo.Discrete+import Imj.Graphics.Animation.Design.Types+import Imj.Iteration+++-- | Note that the Coords parameter is unused.+laserAnimationGeo :: LaserRay Actual+ -> Coords Pos+ -- ^ Unused, because the 'LaserRay' encodes the origin already+ -> Frame+ -> [AnimatedPoint]+laserAnimationGeo (LaserRay dir (Ray seg)) _ (Frame i) =+ -- frame 0 : original char+ -- frame 1 and 2 : replacement char+ -- frame 3 : the end+ let (originalChar, replacementChar) =+ if dir == LEFT || dir == RIGHT+ then+ ('=','-')+ else+ ('|','.')+ char = if i >= 2+ then+ replacementChar+ else+ originalChar+ points = if i >= 4+ then+ []+ else+ bresenham seg+ in map (\p -> AnimatedPoint DontInteract p (Just char)) points++-- | Gravity free-fall+gravityFallGeo :: Vec2 Vel+ -- ^ Initial speed+ -> CanInteract+ -> Coords Pos+ -- ^ Initial position+ -> Frame+ -> [AnimatedPoint]+gravityFallGeo initialSpeed canInteract origin frame =+ let o = pos2vec origin+ points = [vec2pos $ parabola o initialSpeed frame]+ in map (\p -> AnimatedPoint canInteract p Nothing) points++-- | Circular explosion by copying quarter arcs.+simpleExplosionGeo :: Int+ -- ^ Number of points per quarter arc.+ -> CanInteract+ -> Coords Pos+ -- ^ Center+ -> Frame+ -> [AnimatedPoint]+simpleExplosionGeo resolution canInteract center (Frame iteration) =+ let radius = fromIntegral iteration :: Float+ c = pos2vec center+ points = map vec2pos $ translatedFullCircleFromQuarterArc c radius 0 resolution+ in map (\p -> AnimatedPoint canInteract p Nothing) points++-- | Circular explosion+quantitativeExplosionGeo :: Int+ -- ^ The number of points of the circle+ -> CanInteract+ -> Coords Pos+ -- ^ Center+ -> Frame+ -> [AnimatedPoint]+quantitativeExplosionGeo number canInteract center (Frame iteration) =+ let numRand = 10 :: Int+ rnd = 2 :: Int -- TODO store the random number in the state of the animation+ -- rnd <- getStdRandom $ randomR (0,numRand-1)+ radius = fromIntegral iteration :: Float+ firstAngle = (fromIntegral rnd :: Float) * 2*pi / (fromIntegral numRand :: Float)+ c = pos2vec center+ points = map vec2pos $ translatedFullCircle c radius firstAngle number+ in map (\p -> AnimatedPoint canInteract p Nothing) points++-- | Expanding then shrinking geometric figure.+animatePolygonGeo :: Int+ -- ^ number of extremities of the polygon (if 1, draw a circle instead)+ -> Coords Pos+ -- ^ Center+ -> Frame+ -- ^ Used to compute the radius.+ -> [AnimatedPoint]+animatePolygonGeo n center (Frame i) =+ let r = animateRadius (quot i 2) n+ points = if r < 0+ then+ []+ else+ case n of+ 1 -> let p = simpleExplosionGeo 8 DontInteract center $ Frame r+ in map (\(AnimatedPoint _ p' _) -> p') p+ _ -> polygon n r center+ in map (\p -> AnimatedPoint DontInteract p (Just $ intToDigit n)) points++-- | A polygon using resampled bresenham to augment the number of points :+-- the number of points needs to be constant across the entire animation+-- so we need to resampleWithExtremities according to the biggest possible figure.+polygon :: Int -> Int -> Coords Pos -> [Coords Pos]+polygon nSides radius center =+ let startAngle = if odd nSides then pi else pi/4.0+ extrs = polyExtremities (pos2vec center) (fromIntegral radius) startAngle nSides+ in connect $ map vec2pos extrs++-- | Animates the radius by first expanding then shrinking.+animateRadius :: Int -> Int -> Int+animateRadius i nSides =+ let limit+ | nSides <= 4 = 5+ | nSides <= 6 = 7+ | otherwise = 10+ in if i < limit+ then+ i+ else+ 2 * limit - i++connect :: [Coords Pos] -> [Coords Pos]+connect [] = []+connect l@[_] = l+connect (a:rest@(b:_)) = connect2 a b ++ connect rest++connect2 :: Coords Pos -> Coords Pos -> [Coords Pos]+connect2 start end =+ let numpoints = 80 -- more than 2 * (max height width of world) to avoid spaces+ in sampledBresenham numpoints start end++-- | Applies bresenham transformation and resamples it+sampledBresenham :: Int -> Coords Pos -> Coords Pos -> [Coords Pos]+sampledBresenham nSamples start end =+ let l = bresenhamLength start end+ seg = mkSegment start end+ bres = bresenham seg+ in resampleWithExtremities bres (assert (l == length bres) l) nSamples
+ src/Imj/Graphics/Animation/Internal.hs view
@@ -0,0 +1,10 @@+module Imj.Graphics.Animation.Internal+ ( -- * Animation timing+ animationPeriod+ , animationUpdateMargin+ -- * Animation colors+ , colorFromFrame+ ) where++import Imj.Graphics.Animation.Design.Color+import Imj.Graphics.Animation.Design.Timing
+ test/Spec.hs view
@@ -0,0 +1,4 @@++main :: IO ()+main = do+ putStrLn "" -- for readablilty