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

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 :: Creature -> World -> World
-dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
+--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
+    addAnyTwist = case (cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance, cr^. crTwist) of
-        Just TwoHandTwist -> twistamount * pi
+        (Just TwoHandTwist, 0) -> (crTwist .~ twistamount * pi)
-        _ -> 0
+                    . (crDir -~ twistamount * pi)
-    --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
         _ -> 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

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

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
+itemInfo :: Item -> String
-itmInfo itm = itmBaseInfo itm ++ " " ++ itmUsageInfo itm
+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

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 ->
+    ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
-        titledSub
-            "EXAMINE"
-            (defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems itm ++ map f (mitmInfo itm))
-            <> examineInventoryExtra mtweaki itm cfig
     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) 
+        | ButtonRight `M.member` _mouseButtons (_input w)
-            && w ^? hud . hudElement . subInventory == Just NoSubInventory -> 47
+            && 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