Add capability to examine you (empty slots) and close objects

2023-01-11 22:23:01 +00:00
parent 25912fe3eb
commit 994496e964
4 changed files with 65 additions and 38 deletions
@@ -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
@@ -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
@@ -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
@@ -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