diff --git a/src/Dodge/Creature/Action/Movement.hs b/src/Dodge/Creature/Action/Movement.hs index f81a3a59f..a3d0e6b8d 100644 --- a/src/Dodge/Creature/Action/Movement.hs +++ b/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 diff --git a/src/Dodge/Creature/Stance/Data.hs b/src/Dodge/Creature/Stance/Data.hs index 06063300f..15de38f51 100644 --- a/src/Dodge/Creature/Stance/Data.hs +++ b/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 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 0a76ebee1..ace4be45c 100644 --- a/src/Dodge/Creature/State.hs +++ b/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' diff --git a/src/Dodge/Creature/State/WalkCycle.hs b/src/Dodge/Creature/State/WalkCycle.hs new file mode 100644 index 000000000..50a295e2a --- /dev/null +++ b/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 diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 8e5922301..20256bf68 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 22c3b46e2..b5d1a9e79 100644 --- a/src/Dodge/Default.hs +++ b/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 diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 09df04d92..cb1f008ac 100644 --- a/src/Dodge/SoundLogic.hs +++ b/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)