aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJeanne-Kamikaze <jeannekamikaze@gmail.com>2013-08-11 23:58:28 +0200
committerJeanne-Kamikaze <jeannekamikaze@gmail.com>2013-08-11 23:58:28 +0200
commit59d2edd9877a2aa1e243597052a3af6bbeefa3cf (patch)
treeef77d9bcd77b159529b4b268ce1bbee2801a1268
parente15a9cc51e31b5deb973d8583298aa130dd82b17 (diff)
Moved step into its own module
-rw-r--r--Spear.cabal1
-rw-r--r--Spear/Step.hs75
-rw-r--r--demos/pong/Pong.hs34
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 #-}
2module 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)
18where
19
20import Data.Monoid
21
22type Elapsed = Double
23type Dt = Float
24
25-- | A step function.
26data Step a b = Step { step :: Elapsed -> Dt -> a -> (b, Step a b) }
27
28-- | Step identity.
29sid :: Step a a
30sid = Step $ \_ _ a -> (a, sid)
31
32-- | The step that returns the first component in the tuple.
33sfst :: Step (a,b) a
34sfst = spure $ \(a,_) -> a
35
36-- | The step that returns the second component in the tuple.
37ssnd :: Step (a,b) b
38ssnd = spure $ \(_,b) -> b
39
40-- | Construct a step from a pure function.
41spure :: (a -> b) -> Step a b
42spure f = Step $ \_ _ x -> (f x, spure f)
43
44instance 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
49instance 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.
71szip :: (a -> b -> c) -> Step d a -> Step d b -> Step d c
72szip 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
11import Spear.Math.AABB 11import Spear.Math.AABB
12import Spear.Math.Spatial2 12import Spear.Math.Spatial2
13import Spear.Math.Vector 13import Spear.Math.Vector
14import Spear.Step
14 15
15import Data.List (foldl') 16import Data.List (foldl')
16import Data.Monoid 17import Data.Monoid
17import GHC.Float (double2Float) 18import GHC.Float (double2Float)
18 19
19type Elapsed = Double
20type Dt = Float
21
22-- Step function
23
24data Step a b = Step { step :: Elapsed -> Dt -> a -> (b, Step a b) }
25
26sid :: Step a a
27sid = Step $ \_ _ a -> (a, sid)
28
29spure :: (a -> b) -> Step a b
30spure f = Step $ \_ _ x -> (f x, spure f)
31
32smap :: (a -> b) -> Step c a -> Step c b
33smap 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
46sfst :: Step (a,b) a
47sfst = spure $ \(a,_) -> a
48
49ssnd :: Step (a,b) b
50ssnd = spure $ \(_,b) -> b
51
52-- Game events 20-- Game events
53 21
54data GameEvent 22data GameEvent