From fa8d8b589972ef3bad8ab96770baa7e1cb457607 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 25 Apr 2022 23:27:39 +0100 Subject: [PATCH] Assorted changes, cleanup menu selection text --- src/Dodge/Base/Collide.hs | 5 +-- src/Dodge/Base/Coordinate.hs | 9 +++--- src/Dodge/Config/Data.hs | 2 ++ src/Dodge/Creature/Action.hs | 20 ++++++++++-- src/Dodge/Creature/ChaseCrit.hs | 15 +++------ src/Dodge/Creature/Impulse.hs | 1 + src/Dodge/Creature/Perception.hs | 44 ++++++++++++++++++++++--- src/Dodge/Creature/ReaderUpdate.hs | 20 ++++++++++-- src/Dodge/Creature/State.hs | 24 +++++++------- src/Dodge/Data.hs | 48 +++++++++++++--------------- src/Dodge/Default.hs | 7 ++-- src/Dodge/Default/World.hs | 1 + src/Dodge/Item/Equipment.hs | 9 ++++-- src/Dodge/Item/Weapon/Booster.hs | 4 ++- src/Dodge/Item/Weapon/ExtraEffect.hs | 25 ++++++++------- src/Dodge/Item/Weapon/Grenade.hs | 4 ++- src/Dodge/Item/Weapon/Utility.hs | 6 ++-- src/Dodge/Menu.hs | 34 +++++++++++--------- src/Dodge/Menu/OptionType.hs | 4 +-- src/Dodge/Path.hs | 2 +- src/Dodge/Render/MenuScreen.hs | 15 +++++++-- src/Dodge/Render/ShapePicture.hs | 26 ++++++++++++--- 22 files changed, 217 insertions(+), 108 deletions(-) diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 7b8169c92..575e8b4bc 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -79,7 +79,7 @@ pointHitsWalls p1 p2 collidePointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Bool collidePointWalkable p1 p2 ws = any (isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) - $ IM.filter (fromMaybe True . (^? wlPathable)) ws + $ IM.filter (not . fromMaybe True . (^? wlPathable)) ws --furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2 --furthestPointWalkable p1 p2 ws @@ -179,7 +179,8 @@ hasLOSIndirect p1 p2 w = case collidePointIndirect' p1 p2 $ wallsAlongLine p1 p2 isWalkable :: Point2 -> Point2 -> World -> Bool isWalkable p1 p2 w = not $ collidePointWalkable p1 p2 - $ wallsAlongLine p1 p2 w + $ _walls w +-- $ wallsAlongLine p1 p2 w canSee :: Int -> Int -> World -> Bool canSee i j w = hasLOS p1 p2 w diff --git a/src/Dodge/Base/Coordinate.hs b/src/Dodge/Base/Coordinate.hs index 40b236f4b..bf1889e26 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -14,11 +14,10 @@ worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTransla - These have to be scaled according to the size of the window to get actual screen positions. - This allows for line thicknesses etc to correspond to pixel sizes.-} worldPosToScreen :: World -> Point2 -> Point2 -worldPosToScreen w = doRotate . doZoom . doTranslate - where - doTranslate p = p -.- _cameraCenter w - doZoom p = _cameraZoom w *.* p - doRotate p = rotateV (negate $ _cameraRot w) p +worldPosToScreen w + = rotateV (negate $ _cameraRot w) + . (_cameraZoom w *.*) + . (-.- _cameraCenter w) {- | Transform coordinates from the map position to screen coordinates. -} cartePosToScreen :: Configuration -> World -> Point2 -> Point2 diff --git a/src/Dodge/Config/Data.hs b/src/Dodge/Config/Data.hs index 4acafa600..251b1ee6b 100644 --- a/src/Dodge/Config/Data.hs +++ b/src/Dodge/Config/Data.hs @@ -22,6 +22,7 @@ data Configuration = Configuration , _debug_noclip :: Bool , _debug_cr_status :: Bool , _debug_cr_awareness :: Bool + , _debug_mouse_position :: Bool , _debug_view_boundaries :: Bool , _debug_view_clip_bounds :: RoomClipping , _debug_pathing :: Bool @@ -66,6 +67,7 @@ defaultConfig = Configuration , _debug_show_sound = False , _debug_seconds_frame = True , _debug_noclip = False + , _debug_mouse_position = False , _debug_cr_status = False , _debug_cr_awareness = False , _debug_view_boundaries = False diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index b389f015c..e45b14e36 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -18,6 +18,7 @@ module Dodge.Creature.Action ) where import Dodge.Inventory.Add +--import Dodge.ShortShow import Dodge.Path import Dodge.Default import Dodge.WallCreatureCollisions @@ -65,14 +66,27 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos) performPathTo :: Creature -> World -> Point2 -> OutAction performPathTo cr w p | dist cpos p < 5 = ([], Nothing) - | hasLOS cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p)) - | otherwise = case pointTowardsImpulse cpos p w of - Just q -> ([MvTurnToward q,MvForward,RandomTurn jit] , Just (PathTo p)) + | isWalkable cpos p w = ([MvTurnToward p,MvForward,RandomTurn jit] , Just (PathTo p)) + | otherwise = case pointTowardsImpulse p cpos w of + Just q -> ([MvTurnToward q + ,MvForward + ,RandomTurn jit + ,ArbitraryImpulseEffect . const + $ debugPicture .~ drawPathList cpos p w + ] + , Just (PathTo p)) _ -> ([],Nothing) where cpos = _crPos cr jit = _mvTurnJit $ _crMvType cr +drawPathList :: Point2 -> Point2 -> World -> Picture +drawPathList x y w = case makePathBetweenPs x y w of + Nothing -> setLayer DebugLayer $ color red $ line [x,y] + Just [] -> setLayer DebugLayer $ color green $ line [x,y] + Just as -> setLayer DebugLayer $ color orange (line as) + <> color blue (line [head as,x]) <> color yellow (line [last as, y]) + performTurnToA :: Creature -> Point2 -> OutAction performTurnToA cr p | angleVV cdirv dirv < 0.1 = ([], Nothing) diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index 7c368579d..775820f0b 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -35,9 +35,9 @@ chaseCrit = defaultCreature , performActions , const overrideMeleeCloseTarget , const setViewPos - , const setMvPos - , goToTarget - , perceptionUpdate [0] + , setMvPos + , chaseCritMv + , chaseCritPerceptionUpdate [0] , targetYouWhenCognizant , const (crMeleeCooldown %~ max 0 . subtract 1) ] @@ -47,12 +47,5 @@ chaseCrit = defaultCreature , _crMeleeCooldown = 0 , _crFaction = ColorFaction green , _crVocalization = Vocalization seagullChatterS 50 0 - , _crMvType = ChaseMvType - { _mvSpeed = 3 - , _mvTurnRad = f - , _mvTurnJit = 0.2 - } + , _crMvType = defaultChaseMvType } - where - f x | x > pi / 4 = 0.2 - | otherwise = 0.05 diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 83259aa36..b7db09e20 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -67,6 +67,7 @@ followImpulse cr w imp = case imp of AddGoal gl -> crup $ cr & crActionPlan . crGoal .:~ gl ArbitraryImpulseFunction f -> crup $ f w cr ArbitraryImpulse f -> followImpulse cr w (f cr w) + ArbitraryImpulseEffect f -> (f cr, cr) ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of Just tcr -> followImpulse cr w (f $ _crID tcr) _ -> crup cr diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 556b82d7d..2f8c6601a 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/src/Dodge/Creature/Perception.hs @@ -1,11 +1,13 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Creature.Perception ( perceptionUpdate + , chaseCritPerceptionUpdate , newSounds ) where import Dodge.Data import Dodge.Creature.Vocalization import Dodge.Base.Collide +import Dodge.RandomHelp --import Dodge.SoundLogic import Geometry.Vector --import Geometry.Data @@ -13,6 +15,7 @@ import Geometry.Data import Sound.Data --import StrictHelp +import Control.Monad.State import Data.Maybe import Control.Lens import qualified Data.IntMap.Strict as IM @@ -25,10 +28,16 @@ perceptionUpdate -> Creature perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate . basicAttentionUpdate is w +chaseCritPerceptionUpdate :: [Int] -> World -> Creature -> Creature +chaseCritPerceptionUpdate is w = + rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w + {- | Update a creatures awareness based upon the creatures' current direction of attention -} basicAwarenessUpdate :: Creature -> Creature basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of + Fixated i -> cr & crPerception . crAwarenessLevel + %~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness) AttentiveTo is -> cr & crPerception . crAwarenessLevel %~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) @@ -41,8 +50,29 @@ basicAwarenessUpdate cr = case _crAttentionDir $ _crPerception cr of Just sid -> crActionPlan . crImpulse .~ [Bark sid] Nothing -> id | otherwise = id - Fixated i -> cr & crPerception . crAwarenessLevel - %~ ( IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness) + +chaseCritAwarenessUpdate :: World -> Creature -> Creature +chaseCritAwarenessUpdate w cr = case _crAttentionDir $ _crPerception cr of + Fixated i -> cr & crPerception . crAwarenessLevel + %~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness) + AttentiveTo is -> cr + & crPerception . crAwarenessLevel + %~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) + & maybeBark + where + oldAwareness = _crAwarenessLevel $ _crPerception cr + newAwareness = (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is) oldAwareness + becomesCognizant = any isCognizant $ IM.unionWith cogRaised oldAwareness newAwareness + randBool = takeOne [False,True] & evalState $ _randGen w + maybeBark + | becomesCognizant && randBool = + crActionPlan . crStrategy .~ StrategyActions WarningCry + [DoImpulses [Bark $ fromJust $ vocalizationTest cr] + `DoActionThen` 20 + `WaitThen` DoImpulses [ChangeStrategy $ CloseToMelee 0] + , AimAt 0 (_crPos $ _creatures w IM.! 0) + ] + | otherwise = id cogRaised :: AwarenessLevel -> AwarenessLevel -> AwarenessLevel cogRaised Suspicious{} Cognizant{} = Cognizant 100 @@ -76,7 +106,7 @@ basicAttentionUpdate -> Creature -> Creature basicAttentionUpdate cids w cr = cr & crPerception . crAttentionDir .~ - AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids) + AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids) newExtraAwareness :: Creature -- ^ source creature @@ -110,7 +140,13 @@ newSounds = mapMaybe f . M.elems . _playingSounds rememberSounds :: World -> Creature -> Creature rememberSounds w cr = cr - & crMemory . soundsToInvestigate .~ map fst (filter (soundIsClose cr) (newSounds w)) + & crMemory . soundsToInvestigate .~ closesounds + & awakeupdate + where + awakeupdate | null closesounds = id + | otherwise = crPerception . crAwakeLevel .~ Vigilant + closesounds = map fst (filter (soundIsClose cr) (newSounds w)) + soundIsClose :: Creature -> (Point2,Float) -> Bool soundIsClose cr (pos,vol) = vol > (_auDist . _crAudition $ _crPerception cr) (dist pos (_crPos cr)) diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 8cdee2a02..bb212bf84 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -9,6 +9,7 @@ module Dodge.Creature.ReaderUpdate , overrideInternal , goToTarget , flockACC + , chaseCritMv , setMvPos , setViewPos ) where @@ -38,11 +39,16 @@ tryMeleeAttack cr tcr where cpos = _crPos cr -setMvPos :: Creature -> Creature -setMvPos cr = cr & crIntention . mvToPoint .~ mpos +setMvPos :: World -> Creature -> Creature +setMvPos w cr = cr & crIntention . mvToPoint .~ mpos where int = _crIntention cr - mpos = (_crPos <$> _targetCr int) + mtpos = do + tpos <- _crPos <$> _targetCr int + if hasLOS (_crPos cr) tpos w + then Just tpos + else Nothing + mpos = mtpos <|> _mvToPoint int -- <|> listToMaybe (_soundsToInvestigate $ _crMemory cr) @@ -80,6 +86,14 @@ flockACC w cr = case cr ^? crIntention . targetCr . _Just of else negate r *.* horDir in cr & crIntention . mvToPoint ?~ tpos +.+ horShift +chaseCritMv :: World -> Creature -> Creature +chaseCritMv w cr = case _crStrategy (_crActionPlan cr) of + StrategyActions _ _ -> cr + WarningCry -> cr + _ -> case cr ^? crIntention . mvToPoint . _Just of + Just p -> cr & crActionPlan . crAction .~ [PathTo p] + _ -> viewTarget w cr + goToTarget :: World -> Creature -> Creature goToTarget w cr = case cr ^? crIntention . mvToPoint . _Just of diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 404fe12c1..0e27f4bed 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -129,27 +129,29 @@ movementSideEff cr w (randAng,_) = randomR (0,2*pi) $ _randGen w heldItemUpdate :: Int -> Item -> Item -heldItemUpdate invid = (itIsHeld .~ True) . invItemUpdate invid +heldItemUpdate invid = (itUse %~ useUpdate) . (itIsHeld .~ True) . (itInvPos ?~ invid) invItemUpdate :: Int -> Item -> Item -invItemUpdate invid = (itUse %~ useupdate) . (itIsHeld .~ False) . (itInvPos ?~ invid) - where - useupdate = (useHammer . hammerPosition %~ moveHammerUp) +invItemUpdate invid = (itUse %~ useUpdate) . (itIsHeld .~ False) . (itInvPos ?~ invid) + +useUpdate :: ItemUse -> ItemUse +useUpdate = (useHammer . hammerPosition %~ moveHammerUp) . (useDelay . warmTime %~ decreaseToZero) . (useDelay . rateTime %~ decreaseToZero) +useEquipment :: Creature -> Int -> World -> World +useEquipment cr i = _eqUse (_itUse $ _crInv cr IM.! i) cr i + invSideEff :: Creature -> World -> World invSideEff cr w = weaponReloadSounds cr - . flip (IS.foldr useeq) (_crInvEquipped cr) --- . doHeldItemTargeting cr + . flip (IS.foldr $ useEquipment cr) (_crInvEquipped cr) $ IM.foldrWithKey f w (_crInv cr) where - useeq i = _eqUse (_itUse $ _crInv cr IM.! i) cr i - f i it w' = case it ^? itEffect . itInvEffect of - Nothing -> w' & doitemupdate - Just g -> g (_itEffect it) cr i w' & doitemupdate + f i it w' = doitemupdate w' & case it ^? itEffect . itInvEffect of + Nothing -> id + Just g -> g (heldItemUpdate i it) cr -- this is done twice! where - doitemupdate + doitemupdate | i == _crInvSel cr = doItemTargeting i cr . (itpointer %~ heldItemUpdate i) | otherwise = doItemTargeting i cr . (itpointer %~ invItemUpdate i) itpointer = creatures . ix (_crID cr) . crInv . ix i diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index fb1f40930..c76d59821 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -21,6 +21,7 @@ module Dodge.Data , module Dodge.Item.Data , module Dodge.Config.Data ) where +import Dodge.ShortShow import Dodge.Creature.State.Data import Dodge.Creature.Stance.Data import Dodge.Creature.Perception.Data @@ -100,6 +101,7 @@ data World = World , _floorTiles :: [(Point3,Point3)] , _randGen :: StdGen , _testString :: World -> [String] + , _debugPicture :: Picture , _modifications :: IM.IntMap Modification , _yourID :: Int , _worldEvents :: World -> World @@ -197,14 +199,14 @@ data MenuOption = Toggle { _moKey :: Scancode , _moEff :: Universe -> IO (Maybe Universe) - , _moString :: Universe -> String + , _moString :: Universe -> Either String (String,String) } | Toggle2 { _moKey1 :: Scancode , _moEff1 :: Universe -> IO (Maybe Universe) , _moKey2 :: Scancode , _moEff2 :: Universe -> IO (Maybe Universe) - , _moString :: Universe -> String + , _moString :: Universe -> Either String (String,String) } | InvisibleToggle { _moKey :: Scancode @@ -308,12 +310,7 @@ data Intention = Intention data CrMvType = NoMvType | MvWalking { _mvSpeed :: Float } - | ChaseMvType - { _mvSpeed :: Float - , _mvTurnRad :: Float -> Float - , _mvTurnJit :: Float - } - | AimMvType + | CrMvType { _mvSpeed :: Float , _mvTurnRad :: Float -> Float , _mvTurnJit :: Float @@ -478,27 +475,24 @@ data ReloadType -- I believe this is called every frame, not sure when though data ItEffect = NoItEffect - | ItSimpleInvEffect - {_itInvEffect :: ItEffect -> Creature -> Int -> World -> World - -- the Int is the items inventory position - } +-- | ItSimpleInvEffect +-- {_itInvEffect :: Item -> Creature -> World -> World +-- } | ItInvEffect - {_itInvEffect :: ItEffect -> Creature -> Int -> World -> World - -- the Int is the items inventory position + {_itInvEffect :: Item -> Creature -> World -> World ,_itEffectCounter :: Int } | ItRewindEffect - {_itInvEffect :: ItEffect -> Creature -> Int -> World -> World + {_itInvEffect :: Item -> Creature -> World -> World ,_itStoredWorlds :: [World] } | ItEffect - {_itInvEffect :: ItEffect -> Creature -> Int -> World -> World + {_itInvEffect :: Item -> Creature -> World -> World ,_itFloorEffect :: Int -> World -> World ,_itEffectCounter :: Int } | ItInvEffectID - {_itInvEffect :: ItEffect -> Creature -> Int -> World -> World - -- the Int is the items inventory position + {_itInvEffect :: Item -> Creature -> World -> World ,_itEffectID :: Maybe Int } data IntID a = IntID Int a @@ -932,6 +926,7 @@ data Impulse | AddGoal Goal | ArbitraryImpulseFunction (World -> Creature -> Creature) | ArbitraryImpulse (Creature -> World -> Impulse) + | ArbitraryImpulseEffect (Creature -> World -> World) | ImpulseUseTargetCID {_impulseUseTargetCID :: Int -> Impulse } @@ -943,14 +938,14 @@ data Impulse } instance Show Impulse where show imp = case imp of - Move p -> "Move "++show p + Move p -> "Move "++shortPoint2 p MoveForward f -> "MoveForward "++ show f Turn f -> "Turn "++show f RandomTurn f -> "RandomTurn "++show f - TurnToward p f -> "TurnToward "++show p++show f - MvTurnToward p -> "MvTurnToward "++show p + TurnToward p f -> "TurnToward "++shortPoint2 p++show f + MvTurnToward p -> "MvTurnToward "++shortPoint2 p MvForward -> "MvForward" - TurnTo p -> "TurnTo "++show p + TurnTo p -> "TurnTo "++shortPoint2 p UseItem -> "UseItem" SwitchToItem i -> "SwitchToItem "++show i DropItem -> "DropItem" @@ -962,6 +957,7 @@ instance Show Impulse where AddGoal g -> "AddGoal " ++ show g ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction" ArbitraryImpulse {} -> "ArbitraryImpulse" + ArbitraryImpulseEffect {} -> "ArbitraryImpulseEffect" ImpulseUseTargetCID {} -> "ImpulseUseTargetCID" ImpulseUseTarget {} -> "ImpulseUseTarget" ImpulseUseAheadPos {} -> "ImpulseUseAheadPos" @@ -1067,13 +1063,13 @@ instance Show Action where AimAt {_targetID = tid ,_targetSeenAt = p - } -> "AimAt tid:"++show tid++" seenAt:"++show p + } -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p PathTo {_pathToPoint = p - } -> "PathTo:"++show p + } -> "PathTo:"++shortPoint2 p TurnToA {_turnToAPoint = p - } -> "TurnToA:"++show p + } -> "TurnToA:"++shortPoint2 p ---- | PickupItem ---- {_pickupItemID :: Int ---- } @@ -1161,6 +1157,8 @@ data Strategy | ShootAt Int | FollowImpulses | WatchAndWait + | WarningCry + | CloseToMelee Int | StrategyActions Strategy [Action] | GetTo Point2 | Reload diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 43bbbd539..840d8b6e4 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -101,16 +101,19 @@ defaultIntention = Intention , _viewPoint = Nothing } defaultChaseMvType :: CrMvType -defaultChaseMvType = ChaseMvType +defaultChaseMvType = CrMvType { _mvSpeed = 3 , _mvTurnRad = f , _mvTurnJit = 0.2 + , _mvAimSpeed = g } where + g x | x > pi/8 = 0.2 + | otherwise = 0.01 f x | x > pi / 4 = 0.2 | otherwise = 0.05 defaultAimMvType :: CrMvType -defaultAimMvType = AimMvType +defaultAimMvType = CrMvType { _mvSpeed = 3 , _mvTurnRad = const 0.2 , _mvTurnJit = 0.05 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 677fcc134..35c1d41da 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -52,6 +52,7 @@ defaultWorld = World , _randGen = mkStdGen 2 , _mousePos = V2 0 0 , _testString = const [] + , _debugPicture = mempty , _yourID = 0 , _worldEvents = id , _delayedEvents = [] diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 2ab86337a..c4a6d1e7c 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -14,6 +14,7 @@ import Shape import qualified IntMapHelp as IM import LensHelp +import Data.Maybe magShield :: Item magShield = defaultEquipment { _itType = MAGSHIELD @@ -98,9 +99,11 @@ effectOnEquip f = ItInvEffectID , _itEffectID = Nothing } where - g f' _ cr invid w + g f' itm cr w | _crInvSel cr == invid = f' cr (_crInv (_creatures w IM.! _crID cr) IM.! invid) w | otherwise = w + where + invid = fromJust $ _itInvPos itm shieldWall :: Int -> Wall shieldWall crid = defaultWall @@ -156,9 +159,11 @@ effectOnOffEquip f f' = ItInvEffectID , _itEffectID = Nothing } where - g _ cr invid w + g itm cr w | _crInvSel cr == invid = f cr invid w | otherwise = f' cr invid w + where + invid = fromJust $ _itInvPos itm {- | Increases speed, reduces friction, cannot only move forwards. -} jetPack :: Item diff --git a/src/Dodge/Item/Weapon/Booster.hs b/src/Dodge/Item/Weapon/Booster.hs index cb00f4193..af9e028d8 100644 --- a/src/Dodge/Item/Weapon/Booster.hs +++ b/src/Dodge/Item/Weapon/Booster.hs @@ -123,8 +123,10 @@ boosterGun = defaultGun resetAttachmentID :: ItEffect resetAttachmentID = ItInvEffect f 0 where - f iteff cr invid w + f itm cr w | _itEffectCounter iteff < 0 = w & pointToIt . itAttachment .~ NoItAttachment | otherwise = w & pointToIt . itEffect . itEffectCounter -~ 1 where + iteff = _itEffect itm + invid = fromJust $ _itInvPos itm pointToIt = creatures . ix (_crID cr) . crInv . ix invid diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 3015c9e39..e4e4de9e0 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -35,22 +35,25 @@ import qualified SDL autoRadarEffect :: ItEffect autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } where - f :: Int -> ItEffect -> Creature -> Int -> World -> World - f 0 _ cr i w = aRadarPulse cr w - & creatures . ix (_crID cr) . crInv . ix i + f :: Int -> Item -> Creature -> World -> World + f 0 itm cr w = aRadarPulse cr w + & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm) . itEffect . itInvEffect .~ f 100 - f t _ cr i w = w - & creatures . ix (_crID cr) . crInv . ix i + f t itm cr w = w + & creatures . ix (_crID cr) . crInv . ix (fromJust $ _itInvPos itm) . itEffect . itInvEffect .~ f (t-1) {- | Automatically send out sonar pulses that detect creatures. -} autoSonarEffect :: ItEffect -autoSonarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } +autoSonarEffect = ItInvEffect {_itInvEffect = f ,_itEffectCounter = 50 } where - f :: Int -> ItEffect -> Creature -> Int -> World -> World - f 0 _ cr i w = aSonarPulse cr w - & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f 140 - f t _ cr i w = w - & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1) + f :: Item -> Creature -> World -> World + f itm cr w + | _itEffectCounter (_itEffect itm) == 0 = aSonarPulse cr w + & decreasecounter + | otherwise = decreasecounter w + where + decreasecounter = creatures . ix (_crID cr) . crInv + . ix (fromJust $ _itInvPos itm) . itEffect . itEffectCounter %~ (\i -> (i - 1) `mod` 50) defaultTargeting :: Targeting defaultTargeting = Targeting diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index 1d824f8dd..931f8123d 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/src/Dodge/Item/Weapon/Grenade.hs @@ -119,7 +119,9 @@ throwGrenade thePayload cr w = setWp $ removePict $ over props addG w throwArmReset :: Int -> ItEffect throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x } where - f _ cr i = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i + f itm cr = creatures . ix (_crID cr) . crInv %~ IM.adjust counterDown i + where + i = fromJust $ _itInvPos itm counterDown it | _itEffectCounter (_itEffect it) == 0 = it & itUse . useHammer . hammerPosition .~ HammerUp diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index 6c78edafe..f2d2434a9 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -13,6 +13,7 @@ import qualified IntMapHelp as IM import Shape import ShapePicture +import Data.Maybe --import qualified Data.Map.Strict as M import Control.Lens @@ -28,13 +29,14 @@ rewindGun = defaultGun , _itEffect = ItRewindEffect rewindEffect [] , _itUse = defaultlUse {_lUse = \cr invid -> useRewindGun (_crInv cr IM.! invid) cr} } -rewindEffect :: ItEffect -> Creature -> Int -> World -> World -rewindEffect _ cr invid w +rewindEffect :: Item -> Creature -> World -> World +rewindEffect itm cr w | Just invid == _crLeftInvSel cr = w & rewindWorlds %~ (take maxcharge . (w' : )) & ptrWpCharge .~ length (_rewindWorlds w) | otherwise = w & rewindWorlds .~ [] & ptrWpCharge .~ 0 where + invid = fromJust $ _itInvPos itm ptrWpCharge = creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge maxcharge = _wpMaxCharge . _itConsumption $ _crInv cr IM.! invid w' = w & rewindWorlds .~ [] diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index fdaded274..0f94a6777 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -11,6 +11,7 @@ import Dodge.Data import Dodge.PreloadData import Dodge.Save import Dodge.Config.Update +import Padding --import SDL.Internal.Numbered --import Preload.Update import Dodge.SoundLogic @@ -33,18 +34,20 @@ pauseMenu :: ScreenLayer pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause) pauseMenuOptions :: [MenuOption] pauseMenuOptions = - [ Toggle ScancodeN (return . Just . startNewGame) (const "NEW LEVEL") - , Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (const "RESTART") - , Toggle ScancodeS (pushScreen $ seedStartMenu "START FROM SEED") (const "START FROM SEED") - , Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS") - , Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS") + [ Toggle ScancodeN (return . Just . startNewGame) (opText "NEW LEVEL") + , Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART") + , Toggle ScancodeS (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED") + , Toggle ScancodeO (pushScreen optionMenu ) (opText "OPTIONS") + , Toggle ScancodeC (pushScreen displayControls) (opText "CONTROLS") , InvisibleToggle ScancodeEscape (return . const Nothing) ] + where + opText = const . Left seedStartMenu :: String -> ScreenLayer seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen seedStartOptions :: [MenuOption] seedStartOptions = - [ Toggle ScancodeP trySeedFromClipboard (const "PASTE NUMBER FROM CLIPBOARD") + [ Toggle ScancodeP trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD") -- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER") ] @@ -64,10 +67,10 @@ optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen optionsOptions :: [MenuOption] optionsOptions = - [ makeSubmenuOption ScancodeV soundMenu "VOLUME" - , makeSubmenuOption ScancodeG graphicsMenu "GRAPHICS" - , makeSubmenuOption ScancodeP gameplayMenu "GAMEPLAY" - , makeSubmenuOption ScancodeD debugMenu "DEBUG OPTIONS" + [ makeSubmenuOption ScancodeV soundMenu $ Left "VOLUME" + , makeSubmenuOption ScancodeG graphicsMenu $ Left "GRAPHICS" + , makeSubmenuOption ScancodeP gameplayMenu $ Left "GAMEPLAY" + , makeSubmenuOption ScancodeD debugMenu $ Left "DEBUG OPTIONS" ] debugMenu :: ScreenLayer debugMenu = slTitleOptions @@ -83,10 +86,11 @@ debugMenuOptions = , makeEnumOption ScancodeB debug_view_clip_bounds "SHOW ROOM CLIP" return , doption ScancodeP debug_pathing "SHOW PATHING" _debug_pathing , doption ScancodeS debug_show_sound "SHOW VISUAL SOUNDS" _debug_show_sound + , doption ScancodeM debug_mouse_position "SHOW MOUSE POSITION" _debug_mouse_position ] where doption scode l t rec - = Toggle scode (return . Just . (config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config w)) + = Toggle scode (return . Just . (config . l %~ not)) (\w -> Right (t ,show (rec $ _config w))) gameplayMenu :: ScreenLayer gameplayMenu = slTitleOptions "OPTIONS:GAMEPLAY" @@ -104,9 +108,9 @@ soundMenu = slTitleOptions soundMenuOptions :: [MenuOption] soundMenuOptions = - [ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME:" _volume_master - , theoption ScancodeH volume_sound ScancodeJ "EFFECTS VOLUME:" _volume_sound - , theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME:" _volume_music + [ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME" _volume_master + , theoption ScancodeH volume_sound ScancodeJ "EFFECTS VOLUME" _volume_sound + , theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME" _volume_music ] where theoption scod1 stype scod2 str voltype = Toggle2 @@ -114,7 +118,7 @@ soundMenuOptions = (change dec stype) scod2 (change inc stype) - (\w -> str ++ show (round $ 10 * voltype (_config w)::Int)) + (\w -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_config w)::Int))) change g vt = return . Just . (config . vt %~ g) . sw dec x = max 0 (x - 0.1) inc x = min 1 (x + 0.1) diff --git a/src/Dodge/Menu/OptionType.hs b/src/Dodge/Menu/OptionType.hs index 1f9026811..0e8163553 100644 --- a/src/Dodge/Menu/OptionType.hs +++ b/src/Dodge/Menu/OptionType.hs @@ -7,12 +7,12 @@ import Control.Lens makeBoolOption scode lns t = Toggle scode (return . Just . (config . lns #%~ not)) - (\u -> t ++ ":" ++ show (u ^# config . lns)) + (\u -> Right (t , show (u ^# config . lns))) makeEnumOption scode lns str sideeff = Toggle scode (\u -> Just <$> sideeff (u & config . lns #%~ cycleEnum) ) - (\u -> str ++ ":" ++ show (u ^# config . lns)) + (\u -> Right (str , show (u ^# config . lns)) ) makeSubmenuOption scode submenu t = Toggle scode (pushScreen submenu) (const t) diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index f33bc581f..72a0b277d 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -30,7 +30,7 @@ makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w) walkableNodeNear p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear p makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2] -makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween b a w +makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween a b w pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2 pointTowardsImpulse a b w = find (flip (isWalkable a) w) =<< makePathBetweenPs a b w diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 5d9037ff5..2d80cd48a 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -54,9 +54,10 @@ drawOptions u title ops footer = pictures $ , drawFooterText cfig red footer ] ++ zipWith (\s vpos -> placeString (-hw + 50) vpos 0.2 s) - (map (menuOptionToString u) ops') + (map (menuOptionToString u maxOptionLength) ops') [hh-100,hh-150 ..] where + maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops') ops' = filter notInvisible ops notInvisible InvisibleToggle {} = False notInvisible _ = True @@ -64,6 +65,11 @@ drawOptions u title ops footer = pictures $ hw = halfWidth cfig cfig = _config u +optionValueOffset :: Universe -> MenuOption -> Int +optionValueOffset u mo = case _moString mo u of + Left _ -> 0 + Right (s,_) -> length s + darkenBackground :: Configuration -> Picture darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox @@ -87,9 +93,12 @@ drawFooterText cfig col = color col . placeString (-hw + 30) (-hh+10) 0.1 hh = halfHeight cfig hw = halfWidth cfig -menuOptionToString :: Universe -> MenuOption -> String -menuOptionToString w mo = theKeys ++ _moString mo w +menuOptionToString :: Universe -> Int -> MenuOption -> String +menuOptionToString w padAmount mo = theKeys ++ optionText where + optionText = case _moString mo w of + Left s -> s + Right (s,t) -> rightPad padAmount '.' s ++ t theKeys = case mo of Toggle {_moKey = k} -> stc k : ":" Toggle2 {_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":" diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 00e148daa..e800bcded 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -1,6 +1,7 @@ module Dodge.Render.ShapePicture ( worldSPic ) where +import Dodge.ShortShow import Dodge.Config.Data import Dodge.Render.InfoBox import Dodge.Debug.Picture @@ -51,11 +52,13 @@ extraPics cfig w = pictures (_decorations w) <> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w) <> concatMapPic (dbArg _lsPict) (_lightSources w) <> testPic w + <> _debugPicture w <> concatMapPic clDraw (_clouds w ) <> concatMapPic ppDraw (_pressPlates w ) <> soundPics cfig w <> viewBoundaries cfig w <> viewClipBounds cfig w + <> drawMousePosition cfig w <> drawPathing cfig w <> drawCrInfo cfig w @@ -95,6 +98,19 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w theScale = 0.15 * f (_soundVolume s * 0.0001) f x = 1 - 0.5 * (1 - x) +drawMousePosition :: Configuration -> World -> Picture +drawMousePosition cfig w + | not $ _debug_mouse_position cfig = mempty + | otherwise + = setLayer FixedCoordLayer . winScale cfig + . uncurryV translate p + . scale 0.1 0.1 + . text + $ shortPoint2 mwp + where + p = worldPosToScreen w mwp + mwp = mouseWorldPos w + drawPathing :: Configuration -> World -> Picture drawPathing cfig w | _debug_pathing cfig @@ -111,9 +127,11 @@ crDisplayInfo cfig w cr | _crID cr == 0 = Nothing | crOnScreen = Just (_crPos cr, catMaybes -- [fmap show $ ap ^? crGoal --- ,fmap show $ ap ^? crStrategy - [fmap show $ cr ^? crPos - ,fmap show $ cr ^? crOldPos + [fmap show $ cr ^? crHP + ,fmap show $ ap ^? crStrategy + ,fmap show $ cr ^? crPos + ,fmap show $ cr ^? crPerception . crAwakeLevel +-- ,fmap show $ cr ^? crOldPos ,fmap show $ ap ^? crAction ,fmap show $ ap ^? crImpulse ] @@ -126,7 +144,7 @@ crDisplayInfo cfig w cr drawCrInfo :: Configuration -> World -> Picture drawCrInfo cfig w | _debug_cr_status cfig = setLayer FixedCoordLayer - $ renderInfoListsAt (2*hw - 200) 0 cfig w + $ renderInfoListsAt (2*hw - 400) 0 cfig w $ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures w | otherwise = mempty where