From 643cd5a420ee71d8a00dcceda564b6ddc47b5a41 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 8 Sep 2021 17:41:13 +0100 Subject: [PATCH] Move towards incorporating sound into ai --- appDodge/Main.hs | 2 +- src/Dodge/Creature/AlertLevel.hs | 57 --------------------------- src/Dodge/Creature/AlertLevel/Data.hs | 29 -------------- src/Dodge/Creature/ArmourChase.hs | 4 +- src/Dodge/Creature/ChaseCrit.hs | 7 ++-- src/Dodge/Creature/ChooseTarget.hs | 5 ++- src/Dodge/Creature/LauncherCrit.hs | 4 +- src/Dodge/Creature/LtAutoCrit.hs | 4 +- src/Dodge/Creature/Picture.hs | 34 +++++++++++++++- src/Dodge/Creature/PistolCrit.hs | 4 +- src/Dodge/Creature/ReaderUpdate.hs | 13 +++++- src/Dodge/Creature/SentinelAI.hs | 6 +-- src/Dodge/Creature/SetTarget.hs | 4 +- src/Dodge/Creature/SpreadGunCrit.hs | 4 +- src/Dodge/Creature/SwarmCrit.hs | 4 +- src/Dodge/Data.hs | 10 ++--- src/Dodge/Default.hs | 35 ++++++++++++++-- src/Dodge/Initialisation.hs | 4 +- src/Dodge/Render.hs | 3 +- src/Dodge/SoundLogic.hs | 32 ++++++++++----- src/Dodge/SoundLogic/Synonyms.hs | 2 + src/Dodge/Update.hs | 1 - src/Render.hs | 1 - src/Sound.hs | 15 ++++--- src/Sound/Data.hs | 10 +++-- 25 files changed, 150 insertions(+), 144 deletions(-) delete mode 100644 src/Dodge/Creature/AlertLevel.hs delete mode 100644 src/Dodge/Creature/AlertLevel/Data.hs diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 609350a8f..7fc7a3036 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -52,7 +52,7 @@ doSideEffects preData w = do --startTicks <- SDL.ticks void $ doDrawing (_renderData preData) w playPositionalSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w) - newPlayingSounds <- playAndUpdate (_soundData preData) (_sounds w) + newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_sounds w) endTicks <- SDL.ticks let lastFrameTicks = _frameTimer preData diff --git a/src/Dodge/Creature/AlertLevel.hs b/src/Dodge/Creature/AlertLevel.hs deleted file mode 100644 index 46c697dba..000000000 --- a/src/Dodge/Creature/AlertLevel.hs +++ /dev/null @@ -1,57 +0,0 @@ -{-# LANGUAGE TupleSections #-} -{- | Deals with changes in a creature's awareness of other creatures. -} -module Dodge.Creature.AlertLevel - ( basicPerceptionUpdateR - ) - where -import Dodge.Data -import Dodge.Creature.AlertLevel.Data -import Dodge.Base.Collide ---import StrictHelp - -import Control.Lens -import Control.Monad.Reader -import qualified Data.IntMap.Strict as IM - -{- | Ties together (currently) an awareness and attention update -} -basicPerceptionUpdateR - :: [Int] -- ^ List of creature ids that may direct attention and awareness - -> Creature - -> Reader World Creature -basicPerceptionUpdateR is cr = basicAttentionUpdate is cr >>= basicAwarenessUpdate - -{- | Update a creatures awareness based upon the creatures' current direction - of attention -} -basicAwarenessUpdate - :: Creature -> Reader World Creature -basicAwarenessUpdate cr = case _crAttentionDir cr of - AttentiveTo is -> pure $ cr & crAwarenessLevel - %~ (IM.unionWith combineAwareness is . IM.mapMaybe decreaseAwareness) - Fixated i -> pure $ cr & crAwarenessLevel - %~ ( IM.insert i (Cognizant 100) . IM.mapMaybe decreaseAwareness) - -combineAwareness :: AwarenessLevel -> AwarenessLevel -> AwarenessLevel -combineAwareness (AwarenessInt x) (AwarenessInt y) - | x + y < 100 = AwarenessInt $ x + y - | otherwise = Cognizant 50 -combineAwareness (AwarenessInt x) (Cognizant y) = Cognizant $ min 100 $ x + y -combineAwareness (Cognizant x) (AwarenessInt y) = Cognizant $ min 100 $ x + y -combineAwareness (Cognizant x) (Cognizant y) = Cognizant $ min 100 $ x + y - -{- | Decrease awareness level. Returns 'Maybe' value for use with 'IM.mapMaybe' - -} -decreaseAwareness :: AwarenessLevel -> Maybe AwarenessLevel -decreaseAwareness (AwarenessInt 0) = Nothing -decreaseAwareness (AwarenessInt x) = Just $ AwarenessInt (x - 1) -decreaseAwareness (Cognizant 0) = Just $ AwarenessInt 100 -decreaseAwareness (Cognizant x) = Just $ Cognizant $ x - 1 -{- | Given a fixed group of creatures, direct attention to those of them that - - are in view. -} -basicAttentionUpdate - :: [Int] -- ^ Creatures that may attract this creature's attention - -> Creature - -> Reader World Creature -basicAttentionUpdate cids cr = do - w <- ask - pure $ cr & crAttentionDir .~ - AttentiveTo (IM.fromList $ map (, AwarenessInt 2) $ filter (\cid -> canSeeIndirect (_crID cr) cid w) cids) diff --git a/src/Dodge/Creature/AlertLevel/Data.hs b/src/Dodge/Creature/AlertLevel/Data.hs deleted file mode 100644 index 2c62b0cde..000000000 --- a/src/Dodge/Creature/AlertLevel/Data.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE StrictData #-} -module Dodge.Creature.AlertLevel.Data - ( AwakeLevel (..) - , AttentionDir (..) - , AwarenessLevel (..) - -- lenses - , getAttentiveTo - , getFixated - ) where -import Control.Lens -import qualified Data.IntMap as IM - -data AwakeLevel - = Comatose - | Asleep - | Lethargic - | Vigilant - | Overstrung - -data AttentionDir - = AttentiveTo {_getAttentiveTo :: IM.IntMap AwarenessLevel } - | Fixated {_getFixated :: Int } - -data AwarenessLevel - = AwarenessInt Int - | Cognizant Int - -makeLenses ''AttentionDir diff --git a/src/Dodge/Creature/ArmourChase.hs b/src/Dodge/Creature/ArmourChase.hs index 60667d9db..089a8afc8 100644 --- a/src/Dodge/Creature/ArmourChase.hs +++ b/src/Dodge/Creature/ArmourChase.hs @@ -7,7 +7,7 @@ import Dodge.Default import Dodge.Creature.State import Dodge.Creature.State.Data import Dodge.Creature.ReaderUpdate -import Dodge.Creature.AlertLevel +import Dodge.Creature.Perception import Dodge.Creature.Picture import Dodge.Creature.Impulse import Dodge.Creature.Action @@ -28,7 +28,7 @@ armourChaseCrit = defaultCreature targetYouWhenCognizantR >=> setTargetMv (pure . _crTarget) >=> -- should be able to remove this? flockACCR >=> - basicPerceptionUpdateR [0] >=> + perceptionUpdate [0] >=> goToTarget >=> overrideMeleeCloseTargetR >=> return . (crMeleeCooldown %~ max 0 . subtract 1) diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index 85cd1061b..d82223b3b 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -8,7 +8,7 @@ import Dodge.Creature.Picture import Dodge.Creature.ReaderUpdate import Dodge.Creature.Impulse import Dodge.Creature.Action -import Dodge.Creature.AlertLevel +import Dodge.Creature.Perception import Dodge.Creature.State import Dodge.Creature.State.Data import Dodge.Item.Consumable @@ -38,9 +38,10 @@ chaseCrit = defaultCreature doStrategyActionsR >=> performActionsR >=> overrideMeleeCloseTargetR >=> - setTargetMv (pure . _crTarget) >=> + setMvPos >=> +-- setTargetMv (pure . _crTarget) >=> goToTarget >=> - basicPerceptionUpdateR [0] >=> + perceptionUpdate [0] >=> targetYouWhenCognizantR >=> return . (crMeleeCooldown %~ max 0 . subtract 1) , _crHP = 300 diff --git a/src/Dodge/Creature/ChooseTarget.hs b/src/Dodge/Creature/ChooseTarget.hs index 6f1853680..1a9bf8ac7 100644 --- a/src/Dodge/Creature/ChooseTarget.hs +++ b/src/Dodge/Creature/ChooseTarget.hs @@ -3,7 +3,7 @@ module Dodge.Creature.ChooseTarget import Dodge.Data import Dodge.Base import Dodge.Base.Collide -import Dodge.Creature.AlertLevel.Data +import Dodge.Creature.Perception.Data import Control.Lens --import qualified Data.IntMap.Strict as IM @@ -17,7 +17,8 @@ targetYouLOS cr w targetYouCognizant :: Creature -> World -> Maybe Creature targetYouCognizant cr w | hasLOS (_crPos cr) (_crPos $ you w) w - && isCog (cr ^? crAwarenessLevel . ix 0) = Just $ you w + && isCog (cr ^? crPerception . crAwarenessLevel . ix 0) + = Just $ you w | otherwise = Nothing where isCog x = case x of diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index 41be6b88e..a7058e92e 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -9,7 +9,7 @@ import Dodge.Creature.Test import Dodge.Creature.Volition import Dodge.Creature.Strategy import Dodge.Creature.ReaderUpdate -import Dodge.Creature.AlertLevel +import Dodge.Creature.Perception import Dodge.Creature.State import Dodge.Item.Weapon.Launcher import Dodge.Creature.Impulse @@ -30,7 +30,7 @@ launcherCrit = defaultCreature [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire]) , (crAwayFromPost, goToPostStrat) ] - >=> basicPerceptionUpdateR [0] + >=> perceptionUpdate [0] >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index c2ad64294..d491639f3 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -11,7 +11,7 @@ import Dodge.Creature.Volition import Dodge.Creature.Strategy --import Dodge.Creature.ChooseTarget import Dodge.Creature.ReaderUpdate -import Dodge.Creature.AlertLevel +import Dodge.Creature.Perception import Dodge.Creature.State --import Dodge.Creature.State.Data import Dodge.Item.Weapon @@ -41,7 +41,7 @@ ltAutoCrit = defaultCreature ) , (crAwayFromPost, goToPostStrat) ] - >=> basicPerceptionUpdateR [0] + >=> perceptionUpdate [0] >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index f31254baf..f85e18fd0 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -8,9 +8,12 @@ module Dodge.Creature.Picture , picAtCrPosNoRot ) where import Dodge.Data +--import Dodge.Base --import Dodge.Creature.Stance.Data +import Dodge.Creature.Perception.Data import Dodge.Creature.State.Data import Dodge.Creature.Stance.Data +import Dodge.Creature.Memory.Data import Dodge.Creature.Test --import Dodge.Creature.AlertLevel.Data --import Dodge.Picture.Layer @@ -27,12 +30,13 @@ basicCrPict -> Creature -> World -> Picture -basicCrPict col cr w = setLayer 0 $ pictures $ +basicCrPict col cr w = pictures $ targetingPic ++ [ tr . dm . rotdir $ scalp cr , tr . dm . rotdir $ upperBody col cr , tr . dm . rotmdir $ feet cr , tr . rotdir $ drawEquipment cr + , creatureDisplayText w cr ] where dm = damageMod cr @@ -44,6 +48,34 @@ basicCrPict col cr w = setLayer 0 $ pictures $ . setDepth 1 . color (greyN 0.3) +creatureDisplayText :: World -> Creature -> Picture +creatureDisplayText w cr + = setLayer 4 + . setDepth 50 + . translate x y + . color white + . rotate a + . scale theScale theScale + $ text $ creatureDisplayString cr + where + campos = _cameraViewFrom w + theScale = 0.2 / _cameraZoom w + cpos = _crPos cr + v = cpos -.- campos + a = argV v - 0.5 * pi + (V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v + +creatureDisplayString :: Creature -> String +creatureDisplayString cr = show . _soundsToInvestigate $ _crMemory cr +-- | isAsleep = "Z" +-- | isSuspicious = "?" +-- | otherwise = "" +-- where +-- isAsleep = _crAwakeLevel (_crPerception cr) == Asleep +-- imAwarenesses = _crAwarenessLevel (_crPerception cr) +-- isSuspicious = any f imAwarenesses && not (null imAwarenesses) +-- f (Suspicious _) = True +-- f _ = False damageMod :: Creature -> Picture -> Picture damageMod cr pic = piercingMod $ bluntScale pic where diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index 977a0e71d..99d1bf08b 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -11,7 +11,7 @@ import Dodge.Creature.Volition import Dodge.Creature.Strategy import Dodge.Creature.ReaderUpdate --import Dodge.Creature.ChooseTarget -import Dodge.Creature.AlertLevel +import Dodge.Creature.Perception import Dodge.Creature.State --import Dodge.Creature.State.Data import Dodge.Item.Weapon @@ -36,7 +36,7 @@ pistolCrit = defaultCreature [DoActionIf (not . crIsAiming) drawWeapon,chooseMovement cr w]) , (crAwayFromPost, goToPostStrat) ] - >=> basicPerceptionUpdateR [0] + >=> perceptionUpdate [0] >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 2e145148d..134161686 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -9,13 +9,15 @@ module Dodge.Creature.ReaderUpdate , overrideInternalRRR , goToTarget , flockACCR + , setMvPos ) where import Dodge.Data import Dodge.Creature.Stance.Data +import Dodge.Creature.Memory.Data import Dodge.Creature.Test import Dodge.Creature.Volition -import Dodge.Creature.AlertLevel.Data +import Dodge.Creature.Perception.Data import Dodge.Base import Geometry import FoldableHelp @@ -23,6 +25,8 @@ import FoldableHelp import qualified Data.IntMap.Strict as IM import Control.Monad.Reader import Control.Lens +import Control.Applicative +import Data.Maybe overrideMeleeCloseTargetR :: Creature @@ -40,6 +44,11 @@ tryMeleeAttack cr tcr where cpos = _crPos cr +setMvPos :: Creature -> Reader World Creature +setMvPos cr = pure $ cr & crMvTarget .~ mpos + where + mpos = (_crPos <$> _crTarget cr) <|> listToMaybe (_soundsToInvestigate $ _crMemory cr) + setTargetMv :: (Creature -> Reader World (Maybe Creature)) -- ^ Function for determining target -> Creature @@ -126,6 +135,6 @@ listGuard ( (test,y):ps, z ) x listGuard (_,z) _ = z targetYouWhenCognizantR :: Creature -> Reader World Creature -targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crAwarenessLevel . ix 0 of +targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crPerception . crAwarenessLevel . ix 0 of Just (Cognizant _) -> cr {_crTarget = Just $! _creatures w IM.! 0} _ -> cr & crTarget .~ Nothing diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs index 7a5440593..ad9e4cff8 100644 --- a/src/Dodge/Creature/SentinelAI.hs +++ b/src/Dodge/Creature/SentinelAI.hs @@ -8,7 +8,7 @@ import Dodge.Creature.ReaderUpdate import Dodge.Creature.Strategy import Dodge.Creature.Action --import Dodge.Creature.ChooseTarget -import Dodge.Creature.AlertLevel +import Dodge.Creature.Perception --import Dodge.Creature.State --import Dodge.Creature.State.Data import Geometry.Data @@ -56,7 +56,7 @@ sentinelFireType f = performActionsR ) , (crAwayFromPost, goToPostStrat) ] - >=> basicPerceptionUpdateR [0] + >=> perceptionUpdate [0] >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR @@ -77,7 +77,7 @@ sentinelExtraWatchUpdate sentinelExtraWatchUpdate xs = performActionsR >=> watchUpdateStratR ( xs ++ [(crAwayFromPost, goToPostStrat)] ) - >=> basicPerceptionUpdateR [0] + >=> perceptionUpdate [0] >=> doStrategyActionsR >=> targetYouWhenCognizantR >=> overrideInternalRRR diff --git a/src/Dodge/Creature/SetTarget.hs b/src/Dodge/Creature/SetTarget.hs index a8d138d43..e81afbc88 100644 --- a/src/Dodge/Creature/SetTarget.hs +++ b/src/Dodge/Creature/SetTarget.hs @@ -4,7 +4,7 @@ Deals with setting a target for creatures module Dodge.Creature.SetTarget where import Dodge.Data -import Dodge.Creature.AlertLevel.Data +import Dodge.Creature.Perception.Data import Control.Lens import qualified Data.IntMap.Strict as IM @@ -13,7 +13,7 @@ targetYouWhenCognizant :: World -> Creature -> Creature -targetYouWhenCognizant w cr = case cr ^? crAwarenessLevel . ix 0 of +targetYouWhenCognizant w cr = case cr ^? crPerception . crAwarenessLevel . ix 0 of Just (Cognizant _) -> cr & crTarget ?~ _creatures w IM.! 0 _ -> cr & crTarget .~ Nothing diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index b9402b4d6..2cc6d49bf 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -11,7 +11,7 @@ import Dodge.Creature.Volition import Dodge.Creature.Strategy import Dodge.Creature.ReaderUpdate --import Dodge.Creature.ChooseTarget -import Dodge.Creature.AlertLevel +import Dodge.Creature.Perception import Dodge.Creature.State --import Dodge.Creature.State.Data import Dodge.Item.Weapon @@ -42,7 +42,7 @@ spreadGunCrit = defaultCreature ) , (crAwayFromPost, goToPostStrat) ] - >=> basicPerceptionUpdateR [0] + >=> perceptionUpdate [0] >=> doStrategyActionsR >=> reloadOverrideR >=> targetYouWhenCognizantR diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index 429ab3ebb..74e782136 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -7,7 +7,7 @@ import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Boid import Dodge.Creature.ReaderUpdate -import Dodge.Creature.AlertLevel +import Dodge.Creature.Perception import Dodge.Creature.Impulse import Dodge.Creature.State import Dodge.Creature.State.Data @@ -22,7 +22,7 @@ swarmCrit = defaultCreature { _crUpdate = stateUpdate $ impulsiveAIR $ flockToPointUsing (encircleDistP 100) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9) >=> return . (crMeleeCooldown %~ max 0 . subtract 1) - >=> basicPerceptionUpdateR [0] + >=> perceptionUpdate [0] >=> doStrategyActionsR >=> targetYouWhenCognizantR -- , doStrategyActions diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 9fabc4481..efc9c4a0c 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -17,7 +17,8 @@ module Dodge.Data ) where import Dodge.Creature.State.Data import Dodge.Creature.Stance.Data -import Dodge.Creature.AlertLevel.Data +import Dodge.Creature.Perception.Data +import Dodge.Creature.Memory.Data import Dodge.Debug.Flag.Data import Dodge.Data.SoundOrigin import Dodge.Data.DamageType @@ -214,9 +215,8 @@ data Creature = Creature , _crStance :: Stance , _crActionPlan :: ActionPlan , _crMeleeCooldown :: !Int - , _crAwakeLevel :: AwakeLevel - , _crAttentionDir :: AttentionDir - , _crAwarenessLevel :: IM.IntMap AwarenessLevel + , _crPerception :: PerceptionState + , _crMemory :: MemoryState , _crFaction :: Faction , _crGroup :: CrGroup , _crTarget :: Maybe Creature @@ -578,7 +578,7 @@ data Impulse | DropItem -- | PickupNearby Int -- | UseWorldObject Int --- | Bark -- placeholder for various communication types + | Bark -- placeholder for various communication types -- | UseIntrinsicAbility | Melee Int | ChangePosture Posture diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 48ae74d34..4e1be8da8 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -10,7 +10,8 @@ import Dodge.Data import Dodge.Item.Data import Dodge.Creature.Stance.Data import Dodge.Creature.State.Data -import Dodge.Creature.AlertLevel.Data +import Dodge.Creature.Perception.Data +import Dodge.Creature.Memory.Data import Dodge.SoundLogic import Dodge.Picture.Layer import Geometry @@ -49,16 +50,42 @@ defaultCreature = Creature ,_strideLength = 40 } , _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper] + , _crPerception = defaultPerceptionState + , _crMemory = defaultCreatureMemory , _crMeleeCooldown = 0 - , _crAwakeLevel = Vigilant - , _crAttentionDir = AttentiveTo IM.empty - , _crAwarenessLevel = IM.empty , _crFaction = NoFaction , _crTarget = Nothing , _crMvTarget= Nothing , _crGroup = LoneWolf , _crMvType = defaultAimMvType } +defaultCreatureMemory :: MemoryState +defaultCreatureMemory = MemoryState + { _soundsToInvestigate = [] + } + +defaultPerceptionState :: PerceptionState +defaultPerceptionState = PerceptionState + { _crAwakeLevel = Lethargic + , _crAttentionDir = AttentiveTo IM.empty + , _crAwarenessLevel = IM.empty + , _crVision = defaultVision + , _crAudition = defaultAudition + } +defaultVision :: Vision +defaultVision = Eyes + { _viFOV = f + , _viDist = g + } + where + f x | abs x < 0.5 * pi = 1 + | otherwise = 0 + g x | x > 500 = 0 + | otherwise = 1 +defaultAudition :: Audition +defaultAudition = Ears + { _auDist = \x -> 1 / (x * x) + } defaultChaseMvType :: CrMvType defaultChaseMvType = ChaseMvType { _mvSpeed = 3 diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index d5f787ffc..09c88d40b 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -9,6 +9,7 @@ import Dodge.Story import Dodge.WorldEvent.Cloud import Dodge.SoundLogic import Dodge.SoundLogic.Synonyms +import Dodge.Creature.Perception import Geometry.Data --import Dodge.GameRoom --import Geometry @@ -52,7 +53,8 @@ initialWorld = defaultWorld , _worldState = M.empty } testStringInit :: World -> [String] -testStringInit _ = [] +--testStringInit _ = [] +testStringInit w = [show $ newSounds w] --testStringInit w = (show . _crPos $ _creatures w IM.! 0) -- : (map show . _grBound . last $ sortOn _grName grs) -- ++ closeRooms diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 69891fce4..edc2ef8e4 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -198,11 +198,12 @@ doDrawing pdata w = do zipWithM_ (>>) bindings $ map bindDrawDist rds activeTexture $= TextureUnit 0 -- draw overlay - bufferUBO $ isoMatrix 0 1 (V2 0 0) (V2 2 2) depthFunc $= Just Always depthMask $= Disabled blend $= Enabled blendFunc $= (SrcAlpha,OneMinusSrcAlpha) + renderLayer 4 shadV layerCounts + bufferUBO $ isoMatrix 0 1 (V2 0 0) (V2 2 2) renderFoldable shadV $ fixedCoordPictures w depthMask $= Enabled eTicks <- SDL.ticks diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 45ef433fe..33442d033 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -23,6 +23,7 @@ module Dodge.SoundLogic ( import Dodge.Data import Sound.Data (SoundStatus (..)) import Geometry.Vector +import Dodge.SoundLogic.Synonyms import Control.Lens import qualified Data.Map as M @@ -61,7 +62,8 @@ soundOnceOrigin :: Int -- ^ ID of the sound to be played -> SoundOrigin -- ^ The \"creator\" of the sound -> Point2 -- ^ The position of the sound in the world - -> World -> World + -> World + -> World soundOnceOrigin sType so p w = w & sounds %~ M.insertWith (\ _ x -> x) so theSound where theSound = Sound @@ -70,7 +72,9 @@ soundOnceOrigin sType so p w = w & sounds %~ M.insertWith (\ _ x -> x) so theSou , _soundFadeTime = 0 , _soundStatus = ToStart , _soundChannel = Nothing - , _soundPos = Just (a,0) + , _soundAngDist = Just (a,0) + , _soundPos = p + , _soundVolume = soundVolID sType } a = soundAngle p w @@ -89,7 +93,9 @@ soundFromPos so pos sType time fadeTime w = over sounds (M.insertWith f so sound , _soundStatus = ToStart , _soundFadeTime = fadeTime , _soundChannel = Nothing - , _soundPos = Just (a,0) + , _soundAngDist = Just (a,0) + , _soundPos = pos + , _soundVolume = soundVolID sType } f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime} a = soundAngle pos w @@ -114,8 +120,9 @@ soundFrom -> Int -- ^ Sound ID -> Int -- ^ Frames to play -> Int -- ^ Fade out time (ms) - -> World -> World -soundFrom so sType time fadeTime = sounds %~ M.insertWith f so sound + -> World + -> World +soundFrom so sType time fadeTime w = w & sounds %~ M.insertWith f so sound where sound = Sound { _soundChunkID = sType @@ -123,7 +130,9 @@ soundFrom so sType time fadeTime = sounds %~ M.insertWith f so sound , _soundStatus = ToStart , _soundFadeTime = fadeTime , _soundChannel = Nothing - , _soundPos = Nothing + , _soundAngDist = Nothing + , _soundPos = _cameraCenter w + , _soundVolume = soundVolID sType } f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime} {-| Uses the first free origin from a list. @@ -147,7 +156,9 @@ soundMultiFrom (so:sos) sType time fadeTime w , _soundStatus = ToStart , _soundFadeTime = fadeTime , _soundChannel = Nothing - , _soundPos = Nothing + , _soundAngDist = Nothing + , _soundPos = _cameraCenter w + , _soundVolume = soundVolID sType } {-| Uses the first free origin from a list. Does nothing if all origins are already creating sounds. -} @@ -157,7 +168,8 @@ soundMultiFromPos -> Int -- ^ Frames to play for -> Int -- ^ Fade out time (ms) -> Point2 -- ^ Position - -> World -> World + -> 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 @@ -169,7 +181,9 @@ soundMultiFromPos (so:sos) sType time fadeTime pos w , _soundStatus = ToStart , _soundFadeTime = fadeTime , _soundChannel = Nothing - , _soundPos = Just (a,0) + , _soundAngDist = Just (a,0) + , _soundPos = pos + , _soundVolume = soundVolID sType } a = soundAngle pos w {- | Sets '_soundTime' to 0. -} diff --git a/src/Dodge/SoundLogic/Synonyms.hs b/src/Dodge/SoundLogic/Synonyms.hs index 83ad15fa6..569c50474 100644 --- a/src/Dodge/SoundLogic/Synonyms.hs +++ b/src/Dodge/SoundLogic/Synonyms.hs @@ -38,3 +38,5 @@ skwareFadeTwoSecSound = 45 drawWeaponSound = 4 holsterWeaponSound = 5 +soundVolID :: Int -> Float +soundVolID _ = 10000 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index db0889589..3f869db23 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -265,4 +265,3 @@ visibleWalls p1 p2 ws $ IM.toList ws where f (i,wl) = (uncurry intersectSegSeg (_wlLine wl) p1 p2, (i,wl)) - diff --git a/src/Render.hs b/src/Render.hs index 58c068e70..3ae91beb4 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -130,4 +130,3 @@ bindTO t = textureBinding Texture2D $= Just t bindFBO :: FramebufferObject -> IO () bindFBO fb = bindFramebuffer Framebuffer $= fb - diff --git a/src/Sound.hs b/src/Sound.hs index 7e0812f5f..344f2dc24 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -13,7 +13,7 @@ module Sound ( playSoundQueue , playPositionalSoundQueue -- * Complex Playback - , playAndUpdate + , playSoundAndUpdate -- * Volume Control , setSoundVolume , setMusicVolume @@ -49,8 +49,8 @@ In the update: 3. apply 'Just' sound position effects, set value to 'Nothing' 4. remove sounds that have stopped playing from the map. -} -playAndUpdate :: Ord a => SoundData a -> M.Map a Sound -> IO (M.Map a Sound) -playAndUpdate sData newSounds +playSoundAndUpdate :: Ord a => SoundData a -> M.Map a Sound -> IO (M.Map a Sound) +playSoundAndUpdate sData newSounds = updateSounds (_loadedChunks sData) (M.unionWith mergeSound (_playingSounds sData) newSounds) mergeSound :: Sound -> Sound -> Sound @@ -74,6 +74,7 @@ updateSound sd s = initialisePlaying :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound initialisePlaying sd s = case _soundStatus s of ToStart -> tryPlay sd s + JustStartedPlaying -> return $ s & soundStatus .~ Playing _ -> return s tryPlay :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound @@ -84,7 +85,7 @@ tryPlay sd s = do Mix.playOn i Mix.Once (sd IM.! _soundChunkID s) return $ s & soundChannel ?~ i - & soundStatus .~ Playing + & soundStatus .~ JustStartedPlaying --repetitions :: Sound -> Mix.Times --repetitions s = case _soundTime s of @@ -96,6 +97,8 @@ tryGetChannel s = case _soundChannel s of Just i -> return i Nothing -> MaybeT $ Mix.getAvailable Mix.DefaultGroup + + decrementTimer :: Sound -> IO Sound decrementTimer s = case _soundTime s of Just t @@ -106,10 +109,10 @@ decrementTimer s = case _soundTime s of Nothing -> return s applyPosition :: Sound -> IO Sound -applyPosition s = case _soundPos s of +applyPosition s = case _soundAngDist s of Nothing -> return s Just (a,d) -> Mix.effectPosition (fromJust $ _soundChannel s) a d - >> return (s & soundPos .~ Nothing) + >> return (s & soundAngDist .~ Nothing) fadeOutMaybe :: Maybe Mix.Channel diff --git a/src/Sound/Data.hs b/src/Sound/Data.hs index fa9ebb7f5..dd4926fd7 100644 --- a/src/Sound/Data.hs +++ b/src/Sound/Data.hs @@ -5,12 +5,13 @@ import qualified SDL.Mixer as Mix import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as M import Control.Lens ---import Geometry +import Geometry.Data import Data.Word (Word8) import Data.Int (Int16) data SoundStatus - = Playing + = JustStartedPlaying + | Playing | FadingOut | ToStart deriving (Eq,Ord,Show) @@ -24,11 +25,12 @@ data Sound = Sound , _soundFadeTime :: Int , _soundStatus :: SoundStatus , _soundChannel :: Maybe Mix.Channel - , _soundPos :: Maybe (Int16,Word8) + , _soundAngDist :: Maybe (Int16,Word8) + , _soundPos :: Point2 + , _soundVolume :: Float , _soundChunkID :: Int } deriving (Eq,Ord,Show) makeLenses ''SoundData makeLenses ''Sound -