diff --git a/appDodge/Main.hs b/appDodge/Main.hs index d77d5ab2f..f0c73a348 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -95,6 +95,7 @@ firstWorldLoad theConfig = do , _uvFrameTicks = 0 , _uvRAMSave = Nothing , _uvDebug = mempty + , _uvDebugMessageOffset = 0 } return $ u & uvScreenLayers .~ [splashMenu u] diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 17bcf1dd8..422ee2798 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -67,13 +67,6 @@ miniGunCrit = longCrit :: Creature longCrit = defaultCreature - & crActionPlan - .~ ActionPlan - { _apImpulse = [] - , _apAction = [] - , _apStrategy = StrategyActions WatchAndWait [StartSentinelPost] - , _apGoal = [] - } & crInv .~ IM.fromList [(0, sniperRifle), (1, medkit 100)] & crType . humanoidAI .~ LongAI & crType . skinUpper .~ lightx4 red diff --git a/src/Dodge/Creature/ChainUpdates.hs b/src/Dodge/Creature/ChainUpdates.hs index 3535e5210..8e487ade5 100644 --- a/src/Dodge/Creature/ChainUpdates.hs +++ b/src/Dodge/Creature/ChainUpdates.hs @@ -11,6 +11,3 @@ chainCreatureUpdates :: chainCreatureUpdates ls w cr = foldl' unf cr ls where unf cr' g = g w cr' ---chainCreatureUpdates ls w cr = foldr unf cr ls --- where --- unf g cr' = g w cr' diff --git a/src/Dodge/Creature/HandPos.hs b/src/Dodge/Creature/HandPos.hs index 67a5ac107..c7e73b760 100644 --- a/src/Dodge/Creature/HandPos.hs +++ b/src/Dodge/Creature/HandPos.hs @@ -45,7 +45,7 @@ translatePointToRightHand' cr f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen translateToRightHand :: Creature -> SPic -> SPic -translateToRightHand cr = translateToRightHand' cr -- . mirrorSPxz +translateToRightHand = translateToRightHand' -- . mirrorSPxz translateToRightHand' :: Creature -> SPic -> SPic translateToRightHand' cr @@ -61,7 +61,7 @@ translateToRightHand' cr f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen translateToRightWrist :: Creature -> SPic -> SPic -translateToRightWrist cr = translateToRightWrist' cr -- . mirrorSPxz +translateToRightWrist = translateToRightWrist' -- . mirrorSPxz translateToRightWrist' :: Creature -> SPic -> SPic translateToRightWrist' cr diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 97770d5f6..956a17ad6 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -197,8 +197,8 @@ targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of searchIfDamaged :: Creature -> Creature searchIfDamaged cr - | _crPastDamage cr > 0 = case _apStrategy (_crActionPlan cr) of - WatchAndWait -> + | _crPastDamage cr > 0 && + _apStrategy (_crActionPlan cr) == WatchAndWait = cr & crPerception . cpVigilance .~ Vigilant & crActionPlan . apStrategy .~ StrategyActions @@ -206,7 +206,6 @@ searchIfDamaged cr [ TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr)) `DoActionThen` 40 `WaitThen` bfsThenReturn 500 ] - _ -> cr | otherwise = cr bfsThenReturn :: Int -> Action diff --git a/src/Dodge/Creature/SetTarget.hs b/src/Dodge/Creature/SetTarget.hs index b74ccd1fa..c213d845d 100644 --- a/src/Dodge/Creature/SetTarget.hs +++ b/src/Dodge/Creature/SetTarget.hs @@ -12,5 +12,5 @@ targetYouWhenCognizant :: Creature targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of --Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0 - Just (Cognizant _) -> cr & crIntention . targetCr .~ Just (w ^?! cWorld . lWorld . creatures . ix 0) + Just (Cognizant _) -> cr & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0) _ -> cr & crIntention . targetCr .~ Nothing diff --git a/src/Dodge/Data/ActionPlan.hs b/src/Dodge/Data/ActionPlan.hs index eaca43d38..fff119cd9 100644 --- a/src/Dodge/Data/ActionPlan.hs +++ b/src/Dodge/Data/ActionPlan.hs @@ -174,8 +174,8 @@ data Action --deriving (Eq, Ord, Show, Read) --Generic, Flat) data Strategy - = Flank Int - | Ambush Int + = Flank {_flankTarget :: Int} + | Ambush {_ambushTarget :: Int} | Lure Int Point2 | Patrol [Point2] | ShootAt Int @@ -183,7 +183,7 @@ data Strategy | WatchAndWait | WarningCry | LookAround - | CloseToMelee Int + | CloseToMelee {_meleeTarget :: Int} | StrategyActions Strategy [Action] | GetTo Point2 | Reload @@ -194,8 +194,8 @@ data Strategy data Goal = LiveLongAndProsper - | Kill Int - | SentinelAt Point2 Float + | Kill {_killTarget :: Int} + | SentinelAt {_sentinelPos :: Point2, _sentinelDir :: Float} deriving (Eq, Ord, Show) --Generic, Flat) --deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Data/Config.hs b/src/Dodge/Data/Config.hs index 0db3d386f..c590f6c81 100644 --- a/src/Dodge/Data/Config.hs +++ b/src/Dodge/Data/Config.hs @@ -89,7 +89,7 @@ data DebugBool | Inspect_wall | Show_nodes_near_select | Show_path_between - | Pacify_enemies + | Select_creature deriving (Eq, Ord, Bounded, Enum, Show) data ResFactor = DoubleRes | FullRes | HalfRes | QuarterRes | EighthRes | SixteenthRes diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index a98a9e813..0bb58f282 100644 --- a/src/Dodge/Data/Input.hs +++ b/src/Dodge/Data/Input.hs @@ -26,6 +26,7 @@ data Input = Input , _clickPos :: M.Map MouseButton Point2 -- updates on initial mouse button press , _heldPos :: M.Map MouseButton Point2 -- updates while mouse button is held, lags one frame , _clickWorldPos :: M.Map MouseButton Point2 -- updates on initial mouse button press + , _heldWorldPos :: M.Map MouseButton Point2 -- updates while mouse button is held, lags one frame , _textInput :: [Either TermSignal Char] , _scrollTestFloat :: Float , _scrollTestInt :: Int diff --git a/src/Dodge/Data/Universe.hs b/src/Dodge/Data/Universe.hs index 78b29dffc..54aba9447 100644 --- a/src/Dodge/Data/Universe.hs +++ b/src/Dodge/Data/Universe.hs @@ -41,11 +41,12 @@ data Universe = Universe , _uvFrameTicks :: Word32 , _uvRAMSave :: Maybe World , _uvDebug :: M.Map DebugBool DebugItem + , _uvDebugMessageOffset :: Int } data DebugItem = DebugItem - { _debugPic :: Picture - , _debugMessage :: [String] + { _debugPic :: Universe -> Picture + , _debugMessage :: Universe -> [String] , _debugInfo :: DebugInfo } @@ -54,6 +55,7 @@ data DebugInfo | DebugV3 { _debugV3 :: V3 Float} | DebugV2 { _debugV2 :: V2 Float} | DebugMInt { _debugMInt :: Maybe Int} + | DebugIntMInt {_debugInt :: Int, _debugMInt :: Maybe Int} data SideEffect = NewSideEffect @@ -113,3 +115,5 @@ makeLenses ''SideEffect makeLenses ''MenuOptionDisplay makeLenses ''MenuOption makeLenses ''PositionedMenuOption +makeLenses ''DebugItem +makeLenses ''DebugInfo diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index bde880cf9..411d2066e 100644 --- a/src/Dodge/Debug.hs +++ b/src/Dodge/Debug.hs @@ -1,9 +1,17 @@ module Dodge.Debug where -import Dodge.Debug.Picture +import AesonHelp import Control.Lens -import Dodge.Data.Universe +import Data.List (sortOn) +import qualified Data.Map.Strict as M +import Data.Maybe import qualified Data.Set as S +import Dodge.Base.Coordinate +import Dodge.Data.Universe +import Dodge.Debug.Picture +import Dodge.WorldEvent.ThingsHit +import Geometry.Vector +import qualified SDL debugEvents :: Universe -> Universe debugEvents u = case dbools ^. at Enable_debug of @@ -15,11 +23,62 @@ debugEvents u = case dbools ^. at Enable_debug of debugEvent :: DebugBool -> Universe -> Universe debugEvent db u = case db of Collision_test -> u & uvDebug . at Collision_test ?~ collisionDebugItem u + Select_creature -> u & uvDebug . at Select_creature ?~ selectCreatureDebugItem u _ -> u collisionDebugItem :: Universe -> DebugItem -collisionDebugItem u = DebugItem - { _debugPic = drawCollisionTest $ u ^. uvWorld - , _debugMessage = ["Collision test:","asdf"] - , _debugInfo = NoDebugInfo - } +collisionDebugItem u = + DebugItem + { _debugPic = const $ drawCollisionTest $ u ^. uvWorld + , _debugMessage = const [] + , _debugInfo = NoDebugInfo + } + +selectCreatureDebugItem :: Universe -> DebugItem +selectCreatureDebugItem u = + DebugItem + { _debugPic = const mempty + , _debugMessage = debugSelectCreatureMessage + , _debugInfo = scrollDebugInfoInt (length $ debugSelectCreatureList 0 u) u $ clickGetCreature u + } + +scrollDebugInfoInt :: Int -> Universe -> DebugInfo -> DebugInfo +scrollDebugInfoInt i u + | SDL.ScancodeRShift `M.member` (u ^. uvWorld . input . pressedKeys) = + debugInt %~ ((`mod` i) . (+ (u ^. uvWorld . input . scrollAmount))) + | otherwise = id + +debugSelectCreatureMessage :: Universe -> [String] +debugSelectCreatureMessage u = fromMaybe + [show (u ^? uvDebug . ix Select_creature . debugInfo . debugInt)] + $ do + cid <- u ^? uvDebug . ix Select_creature . debugInfo . debugMInt . _Just + i <- u ^? uvDebug . ix Select_creature . debugInfo . debugInt + cap <- debugSelectCreatureList cid u !! i + return $ show cid : getPretty cap + +debugSelectCreatureList :: Int -> Universe -> [Maybe [String]] +debugSelectCreatureList cid u = + [ fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crActionPlan + , fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crPerception + , fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crIntention + , fmap getPretty $ u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crMemory + ] + +clickGetCreature :: Universe -> DebugInfo +clickGetCreature u + | SDL.ButtonLeft `M.member` (u ^. uvWorld . input . mouseButtons) + && SDL.ScancodeRShift `M.member` (u ^. uvWorld . input . pressedKeys) = + DebugIntMInt 0 (closestCreatureID u) + | otherwise = + fromMaybe (DebugIntMInt 0 Nothing) $ + u ^? uvDebug . ix Select_creature . debugInfo + +closestCreatureID :: Universe -> Maybe Int +closestCreatureID u = + fmap (_crID . snd) . listToMaybe . reverse + . sortOn (dist mwp . fst) + . crsHitRadial mwp 100 + $ _uvWorld u + where + mwp = mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam) diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index 9b50ccc7a..7e2529e98 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -102,16 +102,15 @@ intersectLinefromScreen cfig w a b = drawCollisionTest :: World -> Picture drawCollisionTest w = fromMaybe mempty $ do --- let f = fmap (screenToWorldPos (w ^. wCam)) - a <- w ^. input . clickWorldPos . at ButtonLeft - b <- w ^. input . clickWorldPos . at ButtonRight + a <- w ^. input . heldWorldPos . at ButtonLeft + b <- w ^. input . heldWorldPos . at ButtonRight return $ setLayer DebugLayer (color orange $ line [a, b]) - <> foldMap (drawCross . fst) (crHit a b w) - <> foldMap (drawCross . _crPos) (crsNearSeg a b w) - <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b) - <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b) - <> foldMap (drawLabCrossCol blue) (xIntercepts crZoneSize a b) + <> foldMap (drawCrossCol red . fst) (thingHit a b w) +-- <> foldMap (drawCross . _crPos) (crsNearSeg a b w) +-- <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b) +-- <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b) +-- <> foldMap (drawLabCrossCol blue) (xIntercepts crZoneSize a b) drawZoneCol :: Color -> Float -> V2 Int -> Picture drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p : ps ++ [p]) @@ -159,7 +158,7 @@ debugDraw' cfig w bl = case bl of Show_nodes_near_select -> undefined --drawNodesNearSelect w Show_path_between -> drawPathBetween w Collision_test -> mempty - Pacify_enemies -> mempty + Select_creature -> mempty drawCreatureDisplayTexts :: World -> Picture drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index f1b053de7..4f0c3a257 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -16,6 +16,7 @@ defaultInput = { _clickPos = mempty , _clickWorldPos = mempty , _heldPos = mempty + , _heldWorldPos = mempty , _textInput = mempty , _pressedKeys = mempty , _mouseButtons = mempty diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 6ef6b8f1d..99470b37c 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -140,9 +140,11 @@ extraPics cfig u = <> concatMapPic ppDraw (_pressPlates lw) <> viewClipBounds cfig w <> debugDraw cfig w - <> foldMap _debugPic (_uvDebug u) + <> foldMap (`_debugPic` u) (_uvDebug u) <> setLayer FixedCoordLayer - (listPicturesAt (1.3 * halfWidth cfig) 0 cfig (map text (foldMap _debugMessage (_uvDebug u)))) + (listPicturesAt (1.3 * halfWidth cfig) 0 cfig + . take 50 . drop (u ^. uvDebugMessageOffset) + . map text $ foldMap (`_debugMessage` u) (_uvDebug u)) where w = u ^. uvWorld lw = w ^. cWorld . lWorld diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 63e96d892..d157ffeea 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -1,6 +1,7 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} module Dodge.TestString where +import AesonHelp import Dodge.SmoothScroll import HelpNum import Dodge.Base.Coordinate @@ -39,9 +40,6 @@ testStringInit u = [show $ u ^. uvWorld . input . smoothScrollAmount --[show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just] -- [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections] -getPretty :: ToJSON a => a -> [String] -getPretty = lines . unpack . AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) - showTimeFlow :: TimeFlowStatus -> String showTimeFlow tfs = case tfs of DeathTime i -> "DeathTime"++show i diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index c2ce69301..dba8c5eb2 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -86,8 +86,15 @@ updateUniverseFirst u = & uvWorld . input . clickWorldPos %~ M.union (setClickWorldPos u) & uvWorld . input . smoothScrollAmount %~ calcSmoothScroll (u ^. uvWorld . input . scrollAmount) & over (uvWorld . input) updateScrollTestValue + & updateDebugMessageOffset & over (uvWorld . cWorld . cClock) (+ 1) +updateDebugMessageOffset :: Universe -> Universe +updateDebugMessageOffset u + | SDL.ScancodeRShift `M.member` (u ^. uvWorld . input . pressedKeys) + = u & uvDebugMessageOffset %~ (max 0 . subtract (u ^. uvWorld . input . scrollAmount)) + | otherwise = u + setClickWorldPos :: Universe -> M.Map MouseButton Point2 setClickWorldPos u = fmap (const (screenToWorldPos (u ^. uvWorld . wCam) (u ^. uvWorld . input . mousePos))) @@ -125,8 +132,10 @@ updateUniverseLast u = & uvWorld . input . mouseMoving .~ False & uvWorld . input . mouseButtons . each +~ 1 & uvWorld . input . heldPos %~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons)) + & uvWorld . input . heldWorldPos %~ M.union (fmap (const mwp) (u ^. uvWorld . input . mouseButtons)) where mp = u ^. uvWorld . input . mousePos + mwp = screenToWorldPos (u ^. uvWorld . wCam) mp f LongPress = LongPress f _ = ShortPress @@ -151,7 +160,10 @@ timeFlowUpdate :: Universe -> Universe timeFlowUpdate u = case u ^. uvWorld . timeFlow of NormalTimeFlow -> functionalUpdate u ItemScrollTimeFlow smoothing _ _ _ -> over uvWorld (doItemTimeScroll smoothing) u - CameraScrollTimeFlow smoothing _ _ -> over uvWorld (doTimeScroll smoothing) u + CameraScrollTimeFlow smoothing _ _ + | SDL.ScancodeLShift `M.member` (u ^. uvWorld . input . pressedKeys) + -> over uvWorld (doTimeScroll smoothing) u + CameraScrollTimeFlow {} -> u RewindLeftClick 0 _ -> u & uvWorld . timeFlow .~ NormalTimeFlow RewindLeftClick _ _ -> over uvWorld scrollTimeBack u -- & uvWorld . cWorld . timeFlow .~ NormalTimeFlow DeathTime{} -> u @@ -282,9 +294,8 @@ advanceScrollAmount u = & uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll updatePastWorlds :: World -> World -updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :)) - ---updatePastWorlds w = w & pastWorlds .~ [] +--updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :)) +updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 300 . ((w ^. cWorld . lWorld) :)) doWorldEvents :: World -> World doWorldEvents w = diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index e97880c5b..428cffa00 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -104,7 +104,8 @@ crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)] crsHitRadial p r = mapMaybe f . crsNearCirc p r where f cr - | dist cpos p <= r = Just (cpos +.+ r *.* normalizeV (p -.- cpos), cr) + | dist hitpos p <= r = Just (hitpos, cr) | otherwise = Nothing where + hitpos = cpos +.+ r *.* normalizeV (p -.- cpos) cpos = _crPos cr