Modularise and improve step cycle

src/Dodge/Creature/Action/Movement.hs

@@ -53,15 +53,17 @@ advanceStepCounter
     :: Float    -- ^ Speed
     -> Creature 
     -> Creature
-advanceStepCounter speed = crStance . carriage %~ f
+advanceStepCounter speed cr = cr & crStance . carriage %~ f
   where 
-    f w@Walking{} = w{_stepToAdd = ceiling speed}
-    f s = s
+    --stnce = _crStance cr
+    f car = case car of
+        Standing -> f (Walking 0 RightForward)
+        Walking i ff -> Walking (i + ceiling speed) ff
+        _ -> car
 
 creatureTurn :: Float -> Creature -> Creature
 creatureTurn a = crDir +~ a
 
-
 creatureTurnTo :: Point2 -> Creature -> Creature
 creatureTurnTo p cr 
     | vToTarg == (0,0)  = cr -- this should deal with the angleVV error

src/Dodge/Creature/Stance/Data.hs

@@ -6,19 +6,31 @@ import Geometry.Data
 
 import Control.Lens
 data Stance = Stance 
-    {_carriage :: Carriage
-    ,_posture  :: Posture
+    {_carriage     :: Carriage
+    ,_posture      :: Posture
+    ,_strideLength :: Int
     }
   deriving (Eq,Show)
 data Carriage 
-    = Walking { _stepCycle :: Int, _stepToAdd :: Int }
+    = Walking 
+        { _strideAmount :: Int 
+        , _currentFoot :: FootForward
+        }
     | Standing
     | Floating
     | Flying
     | Boosting Point2
   deriving (Eq,Show)
+data FootForward
+    = LeftForward
+    | RightForward
+    | WasLeftForward
+    | WasRightForward
+  deriving
+    (Eq,Ord,Show)
 data Posture = Aiming | AtEase
-  deriving (Eq,Ord,Show)
+  deriving 
+    (Eq,Ord,Show)
 
 makeLenses ''Stance
 makeLenses ''Carriage

src/Dodge/Creature/State.hs

@@ -2,6 +2,7 @@ module Dodge.Creature.State where
 import Dodge.Data
 import Dodge.Item.Data
 import Dodge.Creature.State.Data
+import Dodge.Creature.State.WalkCycle
 import Dodge.Creature.Stance.Data
 --import Dodge.Creature.Test
 import Dodge.Base
@@ -98,9 +99,7 @@ movementSideEff cr w
                     $ set randGen g
                         w
             _   -> w
-    | otherwise = case cr ^? crStance . carriage of
-                    Just (Walking x y) -> takeStep x y w
-                    _ -> w
+    | otherwise = footstepSideEffect cr w
   where 
     hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
     oldPos = _crOldPos cr
@@ -111,11 +110,8 @@ movementSideEff cr w
     (randDir,g) = randomR (-0.5,0.5) $ _randGen w
     (randAng,_) = randomR (0,2*pi) $ _randGen w
 
-    crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5
-    takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0
-                 | crHasMoved && x < 80 && x + y >= 80 = soundMultiFrom footor 23 3 0  
-                 | otherwise = id
-    footor = [FootstepSound 0,FootstepSound 1]
+    --crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5
+
 
 invSideEff :: Creature -> World -> World
 invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
@@ -136,12 +132,7 @@ weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
 updateMovement :: StdGen -> Creature -> (Creature, StdGen)
 updateMovement g cr 
     | isFrictionless cr = (over crPos (+.+ momentum) $ setOldPos cr, g')
-    | otherwise = case cr ^? crStance . carriage of
-        Just (Walking x y) 
-            -> (set (crStance . carriage) (Walking ((x+y)`mod`120) 0) $ setOldPos cr
-                , g)
-        _  -> (set (crStance . carriage) (Walking 0 0) $ setOldPos cr
-                , g)
+    | otherwise = (updateWalkCycle $ setOldPos cr, g)
   where
     momentum' = 0.98 *.* (_crPos cr -.- _crOldPos cr)
     momentum'' | magV momentum' > 1 = 1 *.* normalizeV momentum'

src/Dodge/Creature/State/WalkCycle.hs

@@ -0,0 +1,39 @@
+module Dodge.Creature.State.WalkCycle
+    where
+import Dodge.Data
+import Dodge.Creature.Stance.Data
+import Dodge.SoundLogic
+
+import Control.Lens
+
+updateWalkCycle :: Creature -> Creature
+updateWalkCycle cr = case cr ^? crStance . carriage of
+    Just (Walking x ff) | x > maxStride -> cr & crStance . carriage .~ Walking 0 (normalGait ff)
+    _ -> cr
+  where
+    maxStride = _strideLength $ _crStance cr
+
+normalGait :: FootForward -> FootForward
+normalGait LeftForward = WasLeftForward
+normalGait WasLeftForward = RightForward
+normalGait RightForward = WasRightForward
+normalGait WasRightForward = LeftForward
+
+footstepSideEffect :: Creature -> World -> World
+footstepSideEffect cr w = case cr ^? crStance . carriage of
+    Just (Walking x ff) -> makeFootstepSound x maxStride ff (_crPos cr) w
+    _ -> w
+  where
+    maxStride = _strideLength (_crStance cr)
+
+
+makeFootstepSound :: Int -> Int -> FootForward -> Point2 -> World -> World
+makeFootstepSound currentStride maxStride ff p
+    | currentStride > maxStride = soundMultiFromPos footor (chooseFootSound ff) 3 0 p
+    | otherwise = id
+  where
+    footor = [FootstepSound 0,FootstepSound 1]
+
+chooseFootSound :: FootForward -> Int
+chooseFootSound LeftForward = 22
+chooseFootSound _ = 23

src/Dodge/Creature/YourControl.hs

@@ -13,7 +13,7 @@ import Geometry
 
 import Control.Lens
 import qualified SDL
-import Data.Maybe
+--import Data.Maybe
 import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM
 import System.Random

src/Dodge/Default.hs

@@ -108,7 +108,11 @@ defaultCreature = Creature
     , _crState  = defaultState
     , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
     , _crApplyDamage = defaultApplyDamage
-    , _crStance = Stance {_carriage=Walking 0 0,_posture=AtEase}
+    , _crStance = Stance 
+        {_carriage=Walking 0 WasLeftForward
+        ,_posture=AtEase
+        ,_strideLength = 9
+        }
     , _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper]
     , _crMeleeCooldown = Nothing
     , _crAwakeLevel = Vigilant

src/Dodge/SoundLogic.hs

@@ -12,6 +12,7 @@ module Dodge.SoundLogic (
     , soundFromPos
     , soundFrom
     , soundMultiFrom
+    , soundMultiFromPos
     , stopSoundFrom
 
     -- * Manipulation of all sounds
@@ -129,8 +130,7 @@ soundFrom so sType time fadeTime = sounds %~ M.insertWith f so sound
         , _soundChannel     = Nothing
         , _soundPos         = Nothing
         }
-    f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}
-
+    f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime} 
 {-| Uses the first free origin from a list.
 Does nothing if all origins are already creating sounds.
 TODO: add positional information.
@@ -154,9 +154,30 @@ soundMultiFrom (so:sos) sType time fadeTime w
         , _soundChannel     = Nothing
         , _soundPos         = Nothing
         }
-
-{- | Sets '_soundTime' to 0.
- -}
+{-| Uses the first free origin from a list.
+Does nothing if all origins are already creating sounds.  -}
+soundMultiFromPos
+    :: [SoundOrigin] 
+    -> Int -- ^ Sound ID
+    -> Int -- ^ Frames to play for
+    -> Int -- ^ Fade out time (ms)
+    -> Point2 -- ^ Position
+    -> World -> World
+soundMultiFromPos [] _ _ _ _ w = w
+soundMultiFromPos (so:sos) sType time fadeTime pos w
+    | so `M.member` _sounds w = soundMultiFromPos sos sType time fadeTime pos w
+    | otherwise = over sounds (M.insert so sound) w
+  where 
+    sound = Sound 
+        { _soundChunkID     = sType
+        , _soundTime        = Nothing
+        , _soundStatus      = ToStart
+        , _soundFadeTime    = fadeTime
+        , _soundChannel     = Nothing
+        , _soundPos         = Just (a,0)
+        }
+    a = soundAngle pos w
+{- | Sets '_soundTime' to 0.  -}
 stopSoundFrom :: SoundOrigin -> World -> World
 stopSoundFrom so = over (sounds . ix so . soundTime) (fmap $ min 0)