Highlight dropped items, work towards fixing pickup selection change

src/Dodge/Data/HUD.hs

@@ -38,7 +38,7 @@ data HUD = HUD
     }
 
 data Selection = Sel {_slSec :: Int, _slInt :: Int}
-  deriving (Eq)
+  deriving (Eq,Show)
 
 makeLenses ''HUD
 makeLenses ''Selection

src/Dodge/Data/Item/Location.hs

@@ -35,7 +35,7 @@ data ItemLocation
         , _ilEquipSite :: Maybe EquipSite
         }
     | OnTurret {_ilTuID :: Int}
-    | OnFloor -- {_ilFlID :: NewInt FloorInt}
+    | OnFloor {_ilCloseSel :: Bool} -- {_ilFlID :: NewInt FloorInt}
     | InVoid
     deriving (Eq, Show, Ord, Read) --Generic, Flat)
 

src/Dodge/FloorItem.hs

@@ -15,8 +15,9 @@ copyItemToFloor :: Point2 -> Item -> World -> World
 copyItemToFloor p it w =
     w'
         & cWorld . lWorld . floorItems . at (it ^. itID . unNInt) ?~ FlIt q r
-        & cWorld . lWorld . items . at (it ^. itID . unNInt) ?~ (it & itLocation .~ OnFloor)
+        & cWorld . lWorld . items . at (it ^. itID . unNInt) ?~ (it & itLocation .~ OnFloor False)
         & hud . closeItems .:~ _itID it -- puts item at top of close items
+        & cWorld . highlightItems . at (it ^. itID . unNInt) ?~ 20
   where
     (q, w') = findWallFreeDropPoint (_dimRad $ itDim it) p w
     r = fst . randomR (- pi, pi) $ _randGen w

src/Dodge/Inventory.hs

@@ -73,7 +73,7 @@ destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
     Nothing -> error $ "Tried to destroy item that does not exist; item id: " ++ show itid
     Just InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
     Just OnTurret{} -> error "need to write code for destroying items on turrets"
-    Just OnFloor ->
+    Just OnFloor{} ->
         w
             & cWorld . lWorld . items . at itid .~ Nothing
             & cWorld . lWorld . floorItems . at itid .~ Nothing

src/Dodge/Inventory/Add.hs

@@ -22,12 +22,12 @@ import qualified IntMapHelp as IM
 import NewInt
 
 -- this assumes that this item is currently on the floor
-tryPutItemInInv :: Maybe Int -> Int -> Int -> World -> Maybe (NewInt InvInt, World)
+tryPutItemInInv :: Maybe Int -> Int -> World -> Maybe (NewInt InvInt, World)
-tryPutItemInInv mcipos cid itid w = do
+tryPutItemInInv mcipos itid w = do
     itm <- w ^? cWorld . lWorld . items . ix itid
     invid <- checkInvSlotsYou itm w
     let itloc = InInv
-            { _ilCrID = cid
+            { _ilCrID = 0
             , _ilInvID = invid
             , _ilIsRoot = False
             , _ilIsSelected = False
@@ -36,17 +36,18 @@ tryPutItemInInv mcipos cid itid w = do
             }
     return $ (invid,) $
             w
-                & crUpdateItemLocations
-                & setInvPosFromSS
                 & crUpdateItemLocations
                 -- not sure about the order of these...
-                & cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid
+                & cWorld . lWorld . creatures . ix 0 . crInv . at invid ?~ itid
                 & cWorld . lWorld . items . ix itid . itLocation .~ itloc
                 & cWorld . lWorld . floorItems . at itid .~ Nothing
                 & updateselectionextra invid
                 & updatecloseitemset
                 & maybeselect invid
                 & cWorld . highlightItems . at itid ?~ 20
+                & setInvPosFromSS
+                & crUpdateItemLocations
+                & setInvPosFromSS
   where
     maybeselect invid = fromMaybe id $ do
         i <- mcipos
@@ -56,39 +57,36 @@ tryPutItemInInv mcipos cid itid w = do
     updatecloseitemset = fromMaybe id $ do
         i <- mcipos
         return $ hud . diSections . ix 3 . ssSet %~ IS.deleteShift i
-    updateselectionextra i
+    updateselectionextra i = (hud . diSections . ix 0 . ssSet %~ IS.map (f i))
-        | cid == 0 = (hud . diSections . ix 0 . ssSet %~ IS.map (f i))
             . (hud . diSelection . _Just . slInt %~ f i)
-        | otherwise = id
     f j i | i >= _unNInt j = i + 1
           | otherwise = i
 
--- not sure why we have the cid here, this will probably only work for cid == 0
+tryPutItemInInvAt :: Maybe Int -> Int -> Int -> World -> Maybe World
-tryPutItemInInvAt :: Maybe Int -> Int -> Int -> Int -> World -> Maybe World
+tryPutItemInInvAt mcipos i itid w = do
-tryPutItemInInvAt mcipos i cid itid w = do
+    (j, w') <- tryPutItemInInv mcipos itid w
-    (j, w') <- tryPutItemInInv mcipos cid itid w
     guard (i <= _unNInt j)
     return $ foldr f w' [i + 1 .. _unNInt j]
   where
     f j = swapInvItems (\_ _ -> Just (j -1)) j
 
 createItemYou :: Item -> World -> World
-createItemYou itm w = maybe w' snd $ tryPutItemInInv Nothing 0 itid w'
+createItemYou itm w = maybe w' snd $ tryPutItemInInv Nothing itid w'
   where
     itid = IM.newKey $ w ^. cWorld . lWorld . items
     pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy
     w' = copyItemToFloor pos (itm & itID .~ NInt itid) w
 
 -- the duplication is annoying...
-pickUpItem :: Int -> (Int,Int) -> World -> World
+pickUpItem :: (Int,Int) -> World -> World
-pickUpItem cid (i,itid) w = fromMaybe w $ do
+pickUpItem (i,itid) w = fromMaybe w $ do
     p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
-    soundStart (CrSound cid) p pickUpS Nothing . snd <$> tryPutItemInInv (Just i) cid itid w
+    soundStart (CrSound 0) p pickUpS Nothing . snd <$> tryPutItemInInv (Just i) itid w
 
-pickUpItemAt :: Int -> Int -> (Int,Int) -> World -> World
+pickUpItemAt :: Int -> (Int,Int) -> World -> World
-pickUpItemAt invid cid (i,itid) w = fromMaybe w $ do
+pickUpItemAt invid (i,itid) w = fromMaybe w $ do
     p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
-    soundStart (CrSound cid) p pickUpS Nothing <$> tryPutItemInInvAt (Just i) invid cid itid w
+    soundStart (CrSound 0) p pickUpS Nothing <$> tryPutItemInInvAt (Just i) invid itid w
         & _Just . hud . diSections . ix 0 . ssSet %~ IS.map f
   where
     f j | j >= invid = j +1

src/Dodge/Inventory/SelectionList.hs

@@ -231,8 +231,12 @@ closeItemToSelectionItem w i = do
             , _siColor = col
             , _siOffX = 0
             , _siPayload = Nothing
-            , _siDisplayMod = DropShadowSI
+            , _siDisplayMod = dmod
             }
+  where
+    dmod = maybe DropShadowSI (const HighlightSI) 
+        $ w ^? cWorld . highlightItems . ix i
+    
 
 closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
 closeButtonToSelectionItem w i = do

src/Dodge/Placement/PlaceSpot.hs

@@ -111,7 +111,7 @@ placeSpotID rid ps pt w = case pt of
          in ( i
             , w
                 & gwWorld . cWorld . lWorld . floorItems . at i ?~ FlIt p rot
-                & gwWorld . cWorld . lWorld . items . at i ?~ (itm & itID .~ NInt i & itLocation .~ OnFloor)
+                & gwWorld . cWorld . lWorld . items . at i ?~ (itm & itID .~ NInt i & itLocation .~ OnFloor False)
             )
     PutCrit cr -> plNewUpID (gwWorld . cWorld . lWorld . creatures) crID (mvCr p rot cr) w
     PutForeground fs ->

src/Dodge/SelectedClose.hs

@@ -12,7 +12,7 @@ interactWithCloseObj :: Either (NewInt ItmInt) Button -> World -> World
 interactWithCloseObj e w = worldEventFlags . at InventoryChange ?~ () $ case e of
     (Left flit) -> fromMaybe w $ do
         i <- w ^? hud . diSelection . _Just . slInt
-        return $ pickUpItem 0 (i,_unNInt flit) w
+        return $ pickUpItem (i,_unNInt flit) w
     (Right but) -> doButtonEvent (but ^. btEvent) but w
 
 getSelectedCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)

src/Dodge/TestString.hs

@@ -58,10 +58,10 @@ crs :: Universe -> [Creature]
 crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each
 
 testStringInit :: Universe -> [String]
-testStringInit u = [u ^. uvWorld . input . mouseContext . to show]
+testStringInit u = [u ^. uvWorld . input . mouseContext . to show
+    , u ^. uvWorld . hud . diSelection . to show
+    ] <> u ^.. uvWorld . hud . diSections . each . ssSet . to show
 --    u ^. uvWorld . hud . manObject . to prettyShort
---    <>
---    u ^.. uvWorld . hud . diSections . each . ssSet . to show
 --testStringInit u = u ^. uvWorld . cWorld . lWorld . creatures . ix 5 . crActionPlan . to prettyShort
     --[show . getSum $ foldMap (Sum . crslime) (crs u)]
 --     u ^.. tocrs . each . crType . slimeSplitTimer . to show

src/Dodge/Update.hs

@@ -426,7 +426,8 @@ updateMouseContext cfig u = case u ^? uvScreenLayers . ix 0 of
 
 updateMouseContextGame :: Config -> Universe -> MouseContext -> MouseContext
 updateMouseContextGame cfig u = \case
-    OverInvDrag i -> OverInvDrag i -- (inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf)
+    --OverInvDrag i -> OverInvDrag i -- (inverseSelNumPos cfig invDP mpos disss ^? _Just . nonInf)
+    x@OverInvDrag{} -> x
     x@OverInvDragSelect{} -> x
     MouseGameRotate x
         | ButtonRight `M.member` (w ^. input . mouseButtons) -> MouseGameRotate x

src/Dodge/Update/Input/InGame.hs

@@ -194,11 +194,11 @@ tryPickupSelected k mpos w = do
         ispickup = map (_unNInt . _itID) itmstopickup
     guard $ nfreeslots >= slotsneeded
     return $ case mpos of
-        Just (0, j) -> foldr (pickUpItemAt j 0) w (zip is ispickup) & newdisel j joff
+        Just (0, j) -> foldr (pickUpItemAt j) w (zip is ispickup) & newdisel j joff
-        _ -> foldl' (flip $ pickUpItem 0) w (zip is ispickup) & newdisel (length (cr ^. crInv)) joff
+        _ -> foldl' (flip $ pickUpItem) w (zip is ispickup) & newdisel (length (cr ^. crInv)) joff
+--        _ -> foldr (pickUpItem 0) w (zip is ispickup) & newdisel (length (cr ^. crInv)) joff
   where
-    newdisel j joff =
+    newdisel j joff = hud . diSelection ?~ Sel 0 (j + joff)
-        (hud . diSelection ?~ Sel 0 (j + joff))
     g i = do
         NInt j <- w ^? hud . closeItems . ix i
         w ^? cWorld . lWorld . items . ix j