diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 294f31dea..e6770ac6c 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -31,6 +31,8 @@ import System.Random --import qualified Data.Set as S --import qualified Data.Map as M import Data.Monoid +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV dummyUpdate :: CRUpdate dummyUpdate cr _ = (Endo id, Just cr) @@ -80,10 +82,18 @@ crFriction _ _ = V2 0 0 doDamage :: Creature -> Creature doDamage cr = set (crState . crDamage) [] - $ over (crState . crPastDamage) (forceFoldable . take 10 . (dams :) ) damagedCr + . over (crState . crPastDamage) (advancePastDamages dams) + $ snd $ _crApplyDamage cr dams cr where dams = _crDamage $ _crState cr - damagedCr = snd $ _crApplyDamage cr dams cr + +advancePastDamages :: [DamageType] -> V.Vector [DamageType] -> V.Vector [DamageType] +advancePastDamages newDs v = f $ V.backpermute v bpVector + where + f = V.modify $ \v' -> MV.write v' 0 newDs + +bpVector :: V.Vector Int +bpVector = V.fromList $ 0 : [0 .. 18] movementSideEff :: Creature -> World -> World movementSideEff cr w diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs index 1e2d1a7cb..09d34891e 100644 --- a/src/Dodge/Creature/State/Data.hs +++ b/src/Dodge/Creature/State/Data.hs @@ -10,9 +10,10 @@ import Picture.Data import Control.Lens import qualified Data.IntSet as IS +import qualified Data.Vector as V data CreatureState = CrSt { _crDamage :: [DamageType] - , _crPastDamage :: [[DamageType]] + , _crPastDamage :: V.Vector [DamageType] , _crSpState :: CrSpState , _crDropsOnDeath :: CreatureDropType } diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 3a941530a..973bf336e 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -72,7 +72,7 @@ data World = World , _mousePos :: !Point2 , _testString :: String , _yourID :: !Int - , _worldEvents :: (World -> World) + , _worldEvents :: World -> World , _pressPlates :: IM.IntMap PressPlate , _buttons :: IM.IntMap Button , _soundQueue :: [(Int,Int16)] diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 0f48f6c4d..8458ffbc9 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -18,6 +18,7 @@ import Picture import Control.Lens import qualified Data.IntMap.Strict as IM +import qualified Data.Vector as V import Data.List import Data.Monoid @@ -58,7 +59,7 @@ defaultCreature = Creature defaultState :: CreatureState defaultState = CrSt { _crDamage = [] - , _crPastDamage = [] + , _crPastDamage = V.fromList $ replicate 20 [] , _crSpState = GenCr , _crDropsOnDeath = DropAll } diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 10e927ce9..3e5b97750 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -16,6 +16,7 @@ import qualified Data.IntMap.Strict as IM import qualified Data.Map as M import qualified Data.Set as S import Data.Graph.Inductive.Graph hiding ((&)) +--import qualified Data.Vector.Fusion.Stream.Monadic as VS defaultWorld :: World defaultWorld = World { _keys = S.empty diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index c97ef9e86..62dd2c418 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -43,7 +43,6 @@ initialWorld = defaultWorld [V2 x y | x <- [-5,-3..5] , y <- [-5,-3..5]] , _pressPlates = IM.empty , _buttons = IM.empty - , _soundQueue = [] , _sounds = M.empty , _decorations = IM.empty , _storedLevel = Nothing diff --git a/src/Sound.hs b/src/Sound.hs index 79747a8a7..4ba2b7c9c 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -24,6 +24,7 @@ import qualified SDL.Mixer as Mix import Data.Maybe import qualified Data.IntMap.Strict as IM import qualified Data.Map as M +import qualified Data.Vector.Fusion.Stream.Monadic as VS import Control.Monad import Control.Monad.Trans import Control.Monad.Trans.Maybe @@ -147,8 +148,9 @@ playIfFree c times = do As for 'playSoundQueue', but with positional information in the form of an Int16. -} playPositionalSoundQueue :: IM.IntMap Mix.Chunk -> [(Int,Int16)] -> IO () -playPositionalSoundQueue chunkMap ns = forM_ ns $ \(n,a) -> - runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once >>= setChannelPos a +playPositionalSoundQueue chunkMap = VS.mapM_ ( \(n,a) -> + runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once >>= setChannelPos a ) + . VS.fromList setChannelPos :: Int16 -> Mix.Channel -> MaybeT IO Mix.Channel setChannelPos a i = do