diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 0a6e7325b..1e116277d 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -2,15 +2,15 @@ module Dodge.Creature.YourControl ( yourControl, ) where -import Data.Maybe import Data.Foldable import qualified Data.Map.Strict as M +import Data.Maybe import Dodge.Base.Coordinate import Dodge.Creature.Impulse.Movement import Dodge.Creature.Test import Dodge.Data.World import Dodge.InputFocus -import Dodge.LightSource +--import Dodge.LightSource import Dodge.Update.UsingInput import Geometry import LensHelp @@ -19,15 +19,15 @@ import qualified SDL -- | The AI equivalent for your control. yourControl :: Creature -> World -> World yourControl cr w - | inTermFocus w = dimCreatureLight cr w & updateUsingInput + | inTermFocus w = w & updateUsingInput | otherwise = - dimCreatureLight cr w + w & cWorld . lWorld . creatures . ix (_crID cr) %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w))) & updateUsingInput -dimCreatureLight :: Creature -> World -> World -dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr) +--dimCreatureLight :: Creature -> World -> World +--dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr) -- note the order of operation, setting the posture first--this prevents the twist fire bug @@ -41,7 +41,6 @@ wasdWithAiming :: wasdWithAiming w speed cr | isAiming = addAnyTwist $ aimTurn mouseDir $ theMovement $ setMvAim cr | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_input w) = - --addAnyTwist $ aimTurn (mouseDir + anytwist) $ theMovement $ setMvAim cr aimTurn mouseDir $ removeTwist $ theMovement $ setMvAim cr | otherwise = noaimmove $ theTurn $ removeTwist $ setMvAim cr where @@ -51,17 +50,10 @@ wasdWithAiming w speed cr cr' & crDir +~ _crTwist cr' & crTwist .~ 0 - anytwist = case cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance of - Just TwoHandTwist -> twistamount * pi - _ -> 0 - --addAnyTwist = crTwist .~ anytwist - addAnyTwist = case cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance of - Just TwoHandTwist -> case cr ^. crTwist of - 0 -> (crTwist .~ twistamount * pi) - . (crDir -~ twistamount * pi) - _ -> id + addAnyTwist = case (cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance, cr^. crTwist) of + (Just TwoHandTwist, 0) -> (crTwist .~ twistamount * pi) + . (crDir -~ twistamount * pi) _ -> id - theMovement | movDir == V2 0 0 = id | otherwise = crMvAbsolute (speed *.* movAbs) @@ -69,7 +61,6 @@ wasdWithAiming w speed cr | movDir == V2 0 0 = id | otherwise = crMvForward speed theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr' --- theTurn' cr' = creatureTurnTowardDir dir 0.2 cr' movDir = wasdDir w dir = fmap ((w ^. cWorld . camPos . camRot) +) (safeArgV movDir) movAbs = rotateV (w ^. cWorld . camPos . camRot) $ normalizeV movDir diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 9104bb791..f90b2079a 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -23,6 +23,7 @@ module Dodge.Inventory ( crInvSize, selectedCloseObject, invDimColor, + trimapAugmentInv, ) where import Color @@ -102,6 +103,7 @@ augmentedInvSizes :: World -> IM.IntMap Int augmentedInvSizes = trimapAugmentInv itSlotsTaken 1 closeObjectSize trimapAugmentInv :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> IM.IntMap a +{-# INLINE trimapAugmentInv #-} trimapAugmentInv f x g w = IM.insert n x $ IM.union diff --git a/src/Dodge/Item/Info.hs b/src/Dodge/Item/Info.hs index 4ec27a264..2b7f4d46f 100644 --- a/src/Dodge/Item/Info.hs +++ b/src/Dodge/Item/Info.hs @@ -1,11 +1,18 @@ module Dodge.Item.Info where +import Data.Char import Dodge.Data.Item import qualified Data.Map.Strict as M import LensHelp -itmInfo :: Item -> String -itmInfo itm = itmBaseInfo itm ++ " " ++ itmUsageInfo itm +itemInfo :: Item -> String +itemInfo itm = itmBaseInfo itm ++ " " ++ itmUsageInfo itm + ++ itmSpaceInfo itm + +itmSpaceInfo :: Item -> String +itmSpaceInfo itm = case (ceiling $ _itInvSize itm) of + 1 -> "It takes up one inventory slot. " + x -> "It takes up " ++ map toLower (showInt x) ++ " inventory slots. " itmBaseInfo :: Item -> String itmBaseInfo itm = case itm ^. itType . iyBase of diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 117f44885..6ff81c846 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -3,7 +3,7 @@ module Dodge.Render.HUD ( drawHUD, ) where -import Justify +import Dodge.Creature.Info import Control.Lens import qualified Data.Map.Strict as M import Data.Maybe @@ -27,6 +27,7 @@ import Dodge.Tweak.Show import Dodge.WorldPos import Geometry import qualified IntMapHelp as IM +import Justify import ListHelp import Padding import Picture @@ -70,7 +71,7 @@ defaultSubInvSelectionList = invDisplayParams :: World -> ListDisplayParams invDisplayParams w = defaultListDisplayParams --- & ldpWidth .~ FixedSelectionWidth topInvW + -- & ldpWidth .~ FixedSelectionWidth topInvW & ldpCursorType .~ BorderCursor selcursortype & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w) where @@ -88,21 +89,29 @@ drawSubInventory :: SubInventory -> Configuration -> World -> Picture drawSubInventory subinv cfig w = case subinv of LockedInventory -> mempty -- topInvCursor col cursPos cfig w NoSubInventory -> drawNoSubInventory cfig w - ExamineInventory mtweaki -> - titledSub - "EXAMINE" - (defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems itm ++ map f (mitmInfo itm)) - <> examineInventoryExtra mtweaki itm cfig + ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld) CombineInventory mi -> titledSub + cfig "COMBINE" (combineListSelection w mi) <> combineInventoryExtra mi cfig w + +titledSub :: Configuration -> String -> SelectionList a -> Picture +titledSub cfig subtitle subitems = + invHead cfig subtitle + <> drawSelectionList secondColumnParams cfig subitems + +drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture +drawExamineInventory cfig mtweaki w = + titledSub + cfig + "EXAMINE" + (defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems itm + ++ map f (makeParagraph 60 $ yourAugmentedItem itemInfo (yourInfo (you w)) (closeObjectInfo (crNumFreeSlots (you w)) ) w)) + <> examineInventoryExtra mtweaki itm cfig where - titledSub subtitle subitems = - invHead cfig subtitle - <> drawSelectionList secondColumnParams cfig subitems itm = yourItem w f str = SelectionItem @@ -115,6 +124,25 @@ drawSubInventory subinv cfig w = case subinv of , _siPayload = () } +closeObjectInfo :: Int -> Either FloorItem Button -> String +closeObjectInfo n x = case x of + Left (FlIt {_flIt = itm}) -> "This item is on the floor " ++ floorItemPickupInfo n itm ++ itemInfo itm + Right _ -> "This is some sort of switch or button." + +floorItemPickupInfo :: Int -> Item -> String +floorItemPickupInfo n itm + | n >= ceiling (_itInvSize itm) = ", but you have space to pick it up. " + | otherwise = " and you don't have space to pick it up. " + +yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a +yourAugmentedItem f x g w + | i < n = f $ yourInv w ^?! ix i + | i == n = x + | otherwise = g $ w ^?! hud . closeObjects . ix (i - n - 1) + where + i = crSel (you w) + n = length $ yourInv w + drawNoSubInventory :: Configuration -> World -> Picture drawNoSubInventory cfig w = pictures @@ -132,7 +160,7 @@ drawNoSubInventory cfig w = cfig (Just i) (inventorySelectionList w) - equipcursor = case cr ^. crLeftInvSel . lisMPos of + equipcursor = case cr ^. crLeftInvSel . lisMPos of Just invid -> f cyan invid (_crInvEquipped cr IM.! invid) _ -> mempty equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) @@ -150,7 +178,7 @@ examineInventoryExtra mtweaki mitm cfig = -- consider moving this functionality out into a tweaks module tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki return $ listCursorNSW subInvX 60 cfig tweaki white (length $ showTweak tparam) 15 --- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm)) + -- , drawSelectionList thirdColumnParams cfig (thirdColumnPara (itmInfo mitm)) ] combineInventoryExtra :: Maybe Int -> Configuration -> World -> Picture @@ -201,9 +229,6 @@ secondColumnParams = -- , _siPayload = () -- } -mitmInfo :: Maybe Item -> [String] -mitmInfo = maybe [] $ makeParagraph 60 . itmInfo - displayTerminal :: Int -> Configuration -> LWorld -> Picture displayTerminal tid cfig w = fromMaybe mempty $ do tm <- w ^? terminals . ix tid @@ -301,8 +326,9 @@ determineInvSelCursorWidth :: World -> Int determineInvSelCursorWidth w = case _rbOptions w of NoRightButtonOptions -> topInvW EquipOptions{} - | ButtonRight `M.member` _mouseButtons (_input w) - && w ^? hud . hudElement . subInventory == Just NoSubInventory -> 47 + | ButtonRight `M.member` _mouseButtons (_input w) + && w ^? hud . hudElement . subInventory == Just NoSubInventory -> + 47 | otherwise -> topInvW combineListSelection :: World -> Maybe Int -> SelectionList () @@ -365,8 +391,9 @@ mapOverlay :: Configuration -> World -> [Picture] mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) : [foldMap (drawMapWall cfig (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)] - --(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls) where + --(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls) + lw = w ^. cWorld . lWorld drawMapWall :: Configuration -> HUD -> Wall -> Picture