diff options
| author | Jeanne-Kamikaze <jeannekamikaze@gmail.com> | 2013-08-11 23:58:28 +0200 |
|---|---|---|
| committer | Jeanne-Kamikaze <jeannekamikaze@gmail.com> | 2013-08-11 23:58:28 +0200 |
| commit | 59d2edd9877a2aa1e243597052a3af6bbeefa3cf (patch) | |
| tree | ef77d9bcd77b159529b4b268ce1bbee2801a1268 | |
| parent | e15a9cc51e31b5deb973d8583298aa130dd82b17 (diff) | |
Moved step into its own module
| -rw-r--r-- | Spear.cabal | 1 | ||||
| -rw-r--r-- | Spear/Step.hs | 75 | ||||
| -rw-r--r-- | demos/pong/Pong.hs | 34 |
3 files changed, 77 insertions, 33 deletions
diff --git a/Spear.cabal b/Spear.cabal index ea5eafc..a19d89f 100644 --- a/Spear.cabal +++ b/Spear.cabal | |||
| @@ -61,6 +61,7 @@ library | |||
| 61 | Spear.Scene.Graph | 61 | Spear.Scene.Graph |
| 62 | Spear.Scene.Loader | 62 | Spear.Scene.Loader |
| 63 | Spear.Scene.SceneResources | 63 | Spear.Scene.SceneResources |
| 64 | Spear.Step | ||
| 64 | Spear.Sys.Store | 65 | Spear.Sys.Store |
| 65 | Spear.Sys.Store.ID | 66 | Spear.Sys.Store.ID |
| 66 | Spear.Sys.Timer | 67 | 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 @@ | |||
| 1 | {-# LANGUAGE FlexibleInstances #-} | ||
| 2 | module Spear.Step | ||
| 3 | ( | ||
| 4 | -- * Definitions | ||
| 5 | Step(..) | ||
| 6 | , Elapsed | ||
| 7 | , Dt | ||
| 8 | -- * Constructors | ||
| 9 | , sid | ||
| 10 | , spure | ||
| 11 | , sfst | ||
| 12 | , ssnd | ||
| 13 | -- * Combinators | ||
| 14 | , (.>) | ||
| 15 | , (<.) | ||
| 16 | , szip | ||
| 17 | ) | ||
| 18 | where | ||
| 19 | |||
| 20 | import Data.Monoid | ||
| 21 | |||
| 22 | type Elapsed = Double | ||
| 23 | type Dt = Float | ||
| 24 | |||
| 25 | -- | A step function. | ||
| 26 | data Step a b = Step { step :: Elapsed -> Dt -> a -> (b, Step a b) } | ||
| 27 | |||
| 28 | -- | Step identity. | ||
| 29 | sid :: Step a a | ||
| 30 | sid = Step $ \_ _ a -> (a, sid) | ||
| 31 | |||
| 32 | -- | The step that returns the first component in the tuple. | ||
| 33 | sfst :: Step (a,b) a | ||
| 34 | sfst = spure $ \(a,_) -> a | ||
| 35 | |||
| 36 | -- | The step that returns the second component in the tuple. | ||
| 37 | ssnd :: Step (a,b) b | ||
| 38 | ssnd = spure $ \(_,b) -> b | ||
| 39 | |||
| 40 | -- | Construct a step from a pure function. | ||
| 41 | spure :: (a -> b) -> Step a b | ||
| 42 | spure f = Step $ \_ _ x -> (f x, spure f) | ||
| 43 | |||
| 44 | instance Functor (Step a) where | ||
| 45 | fmap f (Step s1) = Step $ \elapsed dt x -> | ||
| 46 | let (a, s') = s1 elapsed dt x | ||
| 47 | in (f a, fmap f s') | ||
| 48 | |||
| 49 | instance Monoid (Step a a) where | ||
| 50 | mempty = sid | ||
| 51 | |||
| 52 | mappend (Step s1) (Step s2) = Step $ \elapsed dt a -> | ||
| 53 | let (b, s1') = s1 elapsed dt a | ||
| 54 | (c, s2') = s2 elapsed dt b | ||
| 55 | in (c, mappend s1' s2') | ||
| 56 | |||
| 57 | -- Combinators | ||
| 58 | |||
| 59 | -- | Chain two steps. | ||
| 60 | (.>) :: Step a b -> Step b c -> Step a c | ||
| 61 | (Step s1) .> (Step s2) = Step $ \elapsed dt a -> | ||
| 62 | let (b, s1') = s1 elapsed dt a | ||
| 63 | (c, s2') = s2 elapsed dt b | ||
| 64 | in (c, s1' .> s2') | ||
| 65 | |||
| 66 | -- | Chain two steps. | ||
| 67 | (<.) :: Step a b -> Step c a -> Step c b | ||
| 68 | (<.) = flip (.>) | ||
| 69 | |||
| 70 | -- | Evaluate two steps and zip their results. | ||
| 71 | szip :: (a -> b -> c) -> Step d a -> Step d b -> Step d c | ||
| 72 | szip f (Step s1) (Step s2) = Step $ \elapsed dt d -> | ||
| 73 | let (a, s1') = s1 elapsed dt d | ||
| 74 | (b, s2') = s2 elapsed dt d | ||
| 75 | 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 | |||
| 11 | import Spear.Math.AABB | 11 | import Spear.Math.AABB |
| 12 | import Spear.Math.Spatial2 | 12 | import Spear.Math.Spatial2 |
| 13 | import Spear.Math.Vector | 13 | import Spear.Math.Vector |
| 14 | import Spear.Step | ||
| 14 | 15 | ||
| 15 | import Data.List (foldl') | 16 | import Data.List (foldl') |
| 16 | import Data.Monoid | 17 | import Data.Monoid |
| 17 | import GHC.Float (double2Float) | 18 | import GHC.Float (double2Float) |
| 18 | 19 | ||
| 19 | type Elapsed = Double | ||
| 20 | type Dt = Float | ||
| 21 | |||
| 22 | -- Step function | ||
| 23 | |||
| 24 | data Step a b = Step { step :: Elapsed -> Dt -> a -> (b, Step a b) } | ||
| 25 | |||
| 26 | sid :: Step a a | ||
| 27 | sid = Step $ \_ _ a -> (a, sid) | ||
| 28 | |||
| 29 | spure :: (a -> b) -> Step a b | ||
| 30 | spure f = Step $ \_ _ x -> (f x, spure f) | ||
| 31 | |||
| 32 | smap :: (a -> b) -> Step c a -> Step c b | ||
| 33 | smap f (Step s1) = Step $ \elapsed dt x -> | ||
| 34 | let (a, s') = s1 elapsed dt x | ||
| 35 | in (f a, smap f s') | ||
| 36 | |||
| 37 | (.>) :: Step a b -> Step b c -> Step a c | ||
| 38 | (Step s1) .> (Step s2) = Step $ \elapsed dt a -> | ||
| 39 | let (b, s1') = s1 elapsed dt a | ||
| 40 | (c, s2') = s2 elapsed dt b | ||
| 41 | in (c, s1' .> s2') | ||
| 42 | |||
| 43 | (.<) :: Step a b -> Step c a -> Step c b | ||
| 44 | (.<) = flip (.>) | ||
| 45 | |||
| 46 | sfst :: Step (a,b) a | ||
| 47 | sfst = spure $ \(a,_) -> a | ||
| 48 | |||
| 49 | ssnd :: Step (a,b) b | ||
| 50 | ssnd = spure $ \(_,b) -> b | ||
| 51 | |||
| 52 | -- Game events | 20 | -- Game events |
| 53 | 21 | ||
| 54 | data GameEvent | 22 | data GameEvent |
