From 59d2edd9877a2aa1e243597052a3af6bbeefa3cf Mon Sep 17 00:00:00 2001 From: Jeanne-Kamikaze Date: Sun, 11 Aug 2013 23:58:28 +0200 Subject: Moved step into its own module --- Spear.cabal | 1 + Spear/Step.hs | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ demos/pong/Pong.hs | 34 +------------------------ 3 files changed, 77 insertions(+), 33 deletions(-) create mode 100644 Spear/Step.hs diff --git a/Spear.cabal b/Spear.cabal index ea5eafc..a19d89f 100644 --- a/Spear.cabal +++ b/Spear.cabal @@ -61,6 +61,7 @@ library Spear.Scene.Graph Spear.Scene.Loader Spear.Scene.SceneResources + Spear.Step Spear.Sys.Store Spear.Sys.Store.ID Spear.Sys.Timer diff --git a/Spear/Step.hs b/Spear/Step.hs new file mode 100644 index 0000000..5df873d --- /dev/null +++ b/Spear/Step.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE FlexibleInstances #-} +module Spear.Step +( + -- * Definitions + Step(..) +, Elapsed +, Dt + -- * Constructors +, sid +, spure +, sfst +, ssnd + -- * Combinators +, (.>) +, (<.) +, szip +) +where + +import Data.Monoid + +type Elapsed = Double +type Dt = Float + +-- | A step function. +data Step a b = Step { step :: Elapsed -> Dt -> a -> (b, Step a b) } + +-- | Step identity. +sid :: Step a a +sid = Step $ \_ _ a -> (a, sid) + +-- | The step that returns the first component in the tuple. +sfst :: Step (a,b) a +sfst = spure $ \(a,_) -> a + +-- | The step that returns the second component in the tuple. +ssnd :: Step (a,b) b +ssnd = spure $ \(_,b) -> b + +-- | Construct a step from a pure function. +spure :: (a -> b) -> Step a b +spure f = Step $ \_ _ x -> (f x, spure f) + +instance Functor (Step a) where + fmap f (Step s1) = Step $ \elapsed dt x -> + let (a, s') = s1 elapsed dt x + in (f a, fmap f s') + +instance Monoid (Step a a) where + mempty = sid + + mappend (Step s1) (Step s2) = Step $ \elapsed dt a -> + let (b, s1') = s1 elapsed dt a + (c, s2') = s2 elapsed dt b + in (c, mappend s1' s2') + +-- Combinators + +-- | Chain two steps. +(.>) :: Step a b -> Step b c -> Step a c +(Step s1) .> (Step s2) = Step $ \elapsed dt a -> + let (b, s1') = s1 elapsed dt a + (c, s2') = s2 elapsed dt b + in (c, s1' .> s2') + +-- | Chain two steps. +(<.) :: Step a b -> Step c a -> Step c b +(<.) = flip (.>) + +-- | Evaluate two steps and zip their results. +szip :: (a -> b -> c) -> Step d a -> Step d b -> Step d c +szip f (Step s1) (Step s2) = Step $ \elapsed dt d -> + let (a, s1') = s1 elapsed dt d + (b, s2') = s2 elapsed dt d + in (f a b, szip f s1' s2') \ No newline at end of file diff --git a/demos/pong/Pong.hs b/demos/pong/Pong.hs index 9a3138b..b323aa2 100644 --- a/demos/pong/Pong.hs +++ b/demos/pong/Pong.hs @@ -11,44 +11,12 @@ where import Spear.Math.AABB import Spear.Math.Spatial2 import Spear.Math.Vector +import Spear.Step import Data.List (foldl') import Data.Monoid import GHC.Float (double2Float) -type Elapsed = Double -type Dt = Float - --- Step function - -data Step a b = Step { step :: Elapsed -> Dt -> a -> (b, Step a b) } - -sid :: Step a a -sid = Step $ \_ _ a -> (a, sid) - -spure :: (a -> b) -> Step a b -spure f = Step $ \_ _ x -> (f x, spure f) - -smap :: (a -> b) -> Step c a -> Step c b -smap f (Step s1) = Step $ \elapsed dt x -> - let (a, s') = s1 elapsed dt x - in (f a, smap f s') - -(.>) :: Step a b -> Step b c -> Step a c -(Step s1) .> (Step s2) = Step $ \elapsed dt a -> - let (b, s1') = s1 elapsed dt a - (c, s2') = s2 elapsed dt b - in (c, s1' .> s2') - -(.<) :: Step a b -> Step c a -> Step c b -(.<) = flip (.>) - -sfst :: Step (a,b) a -sfst = spure $ \(a,_) -> a - -ssnd :: Step (a,b) b -ssnd = spure $ \(_,b) -> b - -- Game events data GameEvent -- cgit v1.2.3