Cleanup

src/Dodge/Data/Item/Use/Consumption/LoadAction.hs

@@ -10,12 +10,6 @@ import qualified Data.IntSet as IS
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
---import Sound.Data
-
---data Manipulation -- should be ManipulatedObject?
---    = Manipulator {_manObject :: ManipulatedObject }
---    | Brute
---    deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data ManipulatedObject
     = HeldItem
@@ -24,20 +18,6 @@ data ManipulatedObject
         , _hiAttachedItems :: IS.IntSet -- this should probably be NewIntSet InvInt also
         }    
     | HandsFree
---    = SortInventory
---    | SelectedItem
---        { _imRootSelectedItem :: NewInt InvInt
---        , _imAimStance :: AimStance
---        , _imAttachedItems :: IS.IntSet -- this should probably be NewIntSet InvInt also
---        }    
---    | SelNothing
---    | SortCloseItem
---    | SelCloseItem {_ispCloseItem :: Int}
---    | SortCloseButton
---    | SelCloseButton {_ispCloseButton :: Int}
---     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''ManipulatedObject
---makeLenses ''Manipulation
 deriveJSON defaultOptions ''ManipulatedObject
---deriveJSON defaultOptions ''Manipulation

src/Dodge/FloorItem.hs

@@ -14,11 +14,12 @@ import System.Random
 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 . floorItems . at i ?~ FlIt q r
+        & cWorld . lWorld . items . at i ?~ (it & itLocation .~ OnFloor)
         & hud . closeItems .:~ _itID it -- puts item at top of close items
-        & cWorld . highlightItems . at (it ^. itID . unNInt) ?~ 20
+        & cWorld . highlightItems . at i ?~ 20
   where
+    i = it ^. itID . unNInt
     (q, w') = findWallFreeDropPoint (_dimRad $ itDim it) p w
     r = fst . randomR (- pi, pi) $ _randGen w
 

src/Dodge/Inventory.hs

@@ -12,7 +12,6 @@ module Dodge.Inventory (
     swapInvItems,
     scrollAugNextInSection,
     swapItemWith,
-    destroyItem,
     destroyAllInvItems,
     multiSelScroll,
     changeSwapSelSet,
@@ -68,17 +67,6 @@ destroyAllInvItems cr w =
         . _unNIntMap
         $ cr ^. crInv
 
-destroyItem :: Int -> World -> World
-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{} ->
-        w
-            & cWorld . lWorld . items . at itid .~ Nothing
-            & cWorld . lWorld . floorItems . at itid .~ Nothing
-    Just InVoid -> w & cWorld . lWorld . items . at itid .~ Nothing
-
 -- note rmInvItem does not fully destroy the item, other updates to the item
 -- location are required
 -- note if this gets called ssInvPosFromSS might be necessary elsewhere

src/Dodge/Inventory/Add.hs

@@ -29,14 +29,10 @@ tryPutItemInInv mcipos itid w = do
     let itloc = InInv
             { _ilCrID = 0
             , _ilInvID = invid
---            , _ilIsRoot = False
---            , _ilIsSelected = False
---            , _ilIsAttached = False
             , _ilEquipSite = Nothing
             }
     return $ (invid,) $
             w
-                & crUpdateItemLocations
                 -- not sure about the order of these...
                 & cWorld . lWorld . creatures . ix 0 . crInv . at invid ?~ itid
                 & cWorld . lWorld . items . ix itid . itLocation .~ itloc
@@ -78,8 +74,8 @@ createItemYou itm w = maybe w' snd $ tryPutItemInInv Nothing itid w'
     w' = copyItemToFloor pos (itm & itID .~ NInt itid) w
 
 -- the duplication is annoying...
-pickUpItem :: (Int,Int) -> World -> World
-pickUpItem (i,itid) w = fromMaybe w $ do
+pickUpItem :: Int -> Int -> World -> World
+pickUpItem i itid w = fromMaybe w $ do
     p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
     soundStart (CrSound 0) p pickUpS Nothing . snd <$> tryPutItemInInv (Just i) itid w
 

src/Dodge/Inventory/SelectionList.hs

@@ -219,9 +219,9 @@ hotkeyToChar = \case
 
 closeItemToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
 closeItemToSelectionItem w i = do
-    e <- w ^? cWorld . lWorld . items . ix i
-    let pics = itemDisplay w Nothing e
-        col = itemInvColor (baseCI e)
+    itm <- w ^? cWorld . lWorld . items . ix i
+    let pics = itemDisplay w Nothing itm
+        col = itemInvColor (baseCI itm)
     return
         SelItem
             { _siPictures = pics

src/Dodge/SelectedClose.hs

@@ -10,10 +10,12 @@ import Data.Maybe
 -- assumes that, for picking up, you are selecting the item
 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 (i,_unNInt flit) w
+    (Left flit) -> pickUpItem i (_unNInt flit) w
     (Right but) -> doButtonEvent (but ^. btEvent) but w
+  where
+    i = fromMaybe 0 $ do
+        Sel 3 j <- w ^. hud . diSelection
+        return j
 
 getSelectedCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
 getSelectedCloseObj w = do

src/Dodge/Update/Input/InGame.hs

@@ -49,18 +49,19 @@ import SDL
 updateUseInputInGame :: Universe -> Universe
 updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . subInventory of
     DisplayTerminal tmid -> updateKeysInTerminal tmid u
-    CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _))} -> u
-        & uvWorld . hud . subInventory %~ docombineregexinput sss msel
-        & uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
+    CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _))} ->
+        u
+            & uvWorld . hud . subInventory %~ docombineregexinput sss msel
+            & uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
     _ | Just (-1) <- disel -> f diInvFilter diInvFilter (-1)
     _ | Just 2 <- disel -> f diCloseFilter diCloseFilter 2
     _ -> updateKeysInGame u
   where
     disel = u ^? uvWorld . hud . diSelection . _Just . slSec
     f x y i = u
-        & uvWorld . hud %~ dodisplayregexinput x y i
-        & uvWorld . worldEventFlags . at InventoryChange ?~ ()
-        & uvWorld %~ setInvPosFromSS -- not sure if this is necessary
+            & uvWorld . hud %~ dodisplayregexinput x y i
+            & uvWorld . worldEventFlags . at InventoryChange ?~ ()
+            & uvWorld %~ setInvPosFromSS -- not sure if this is necessary
     dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do
         sss <- di ^? diSections
         msel <- di ^? diSelection
@@ -96,30 +97,9 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
     OverInvDragSelect{}
         | ButtonRight `M.member` (w ^. input . mouseButtons) ->
             w & input . mouseContext .~ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
---    OverInvDragSelect {} -> w
---    OverInvDragSelect (Just sstart) _ ->
---        case inverseSelNumPos cfig invDP (w ^. input . mousePos) sss of
---            Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
---            Just m
---                | fmap fst m == NonInf (fst sstart) -> w & input . mouseContext . mcoSelEnd ?~ (m ^?! nonInf . _2)
---                | fmap fst m < NonInf (fst sstart) -> w & input . mouseContext . mcoSelEnd ?~ 0
---                | otherwise -> w & input . mouseContext . mcoSelEnd .~ 
---                    fmap fst (IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
---    -- not sure how the above performs when filtering...
---    OverInvDragSelect Nothing _ -> fromMaybe w $ do
---        ysel <-
---            inverseSelSecYint
---                (posSelSecYint cfig invDP (w ^. input . mousePos . _y))
---                sss
---                ^? nonInf
---        guard (isGroupSelectableSection $ fst ysel)
---        return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
---    OverInvDrag k mmouseover -> doDrag cfig 30 k mmouseover w
     OverInvDrag k -> doDrag cfig 30 k w
     OverTerminalBar p -> w & tmLDP %~ setPixelOffsetBounded cfig (p + w ^. input . mousePos)
     _ -> w
---  where
---    sss = w ^. hud . diSections
 
 setPixelOffsetBounded :: Config -> Point2 -> LDParams -> LDParams
 setPixelOffsetBounded cfig (V2 x y) ldp = ldp & ldpPos . spPixelOff .~ V2 x' y'
@@ -134,8 +114,6 @@ setPixelOffsetBounded cfig (V2 x y) ldp = ldp & ldpPos . spPixelOff .~ V2 x' y'
             max (1 + 20 * (ldp ^. ldpVerticalGap + ldp ^?! ldpSize . _Just . _y . to fromIntegral) - h * b) y
     V2 a b = ldp ^. ldpPos . spScreenOff
 
---doDrag :: Config -> Int -> Int -> Maybe (Int, Int) -> World -> World
---doDrag cfig n k mmouseover w = fromMaybe w $ do
 doDrag :: Config -> Int -> Int -> World -> World
 doDrag cfig n k w = fromMaybe w $ do
     guard (n /= 0)
@@ -173,11 +151,6 @@ selectionSet w = do
         Just is | not $ IS.null is -> Just is
         _ -> IS.singleton <$> w ^? hud . diSelection . _Just . slInt
 
--- selectionSet :: World -> Maybe IS.IntSet
--- selectionSet w = case w ^? hud . diSelection . _Just . slSet of
---        Just is' | not $ IS.null is' -> Just is'
---        _ -> IS.singleton <$> w ^? hud . diSelection . _Just . slInt
-
 tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World
 tryPickupSelected k mpos w = do
     guard $ k == 3
@@ -195,8 +168,7 @@ tryPickupSelected k mpos w = do
     guard $ nfreeslots >= slotsneeded
     return $ case mpos of
         Just (0, j) -> foldr (pickUpItemAt j) w (zip is ispickup) & newdisel j 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
+        _ -> foldl' (flip $ pickUpItem (head is)) w ispickup & newdisel (length (cr ^. crInv)) joff
   where
     newdisel j joff = hud . diSelection ?~ Sel 0 (j + joff)
     g i = do
@@ -204,35 +176,37 @@ tryPickupSelected k mpos w = do
         w ^? cWorld . lWorld . items . ix j
 
 updateMouseReleaseInGame :: Config -> World -> World
-updateMouseReleaseInGame cfig w = case w ^. input . mouseContext of
-    --OverInvDrag k mpos ->
+updateMouseReleaseInGame cfig w = input . mouseContext .~ MouseInGame $ case w ^. input . mouseContext of
     OverInvDrag k ->
-        input . mouseContext .~ MouseInGame $
-            fromMaybe w $
-                tryDropSelected mpos w <|> tryPickupSelected k mpos w
-    OverInvDragSelect ssel 
-        | ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
-            w & input . mouseContext .~ MouseInGame
-                & doDragSelect cfig ssel
-    OverInvDragSelect ssel -> w & input . mouseContext .~ MouseInGame
-                & hud . diSections . ix 0 . ssSet .~ mempty
-                & hud . diSections . ix 3 . ssSet .~ mempty
-                & doDragSelect cfig ssel
+        fromMaybe w $
+            tryDropSelected mpos w <|> tryPickupSelected k mpos w
+    OverInvDragSelect ssel ->
+        w
+            & mresetssset
+            & doDragSelect cfig ssel
     _ -> w
   where
+    mresetssset
+        | ScancodeLShift `M.member` (w ^. input . pressedKeys) = id
+        | otherwise = hud . diSections . each . ssSet .~ mempty
     mpos = inverseSelNumPos cfig invDP mpos' disss ^? _Just . nonInf
     mpos' = w ^. input . mousePos
     disss = w ^. hud . diSections
 
-doDragSelect :: Config -> XInfinity (Int,Int) -> World -> World
+doDragSelect :: Config -> XInfinity (Int, Int) -> World -> World
 doDragSelect cfig x w = fromMaybe w $ do
     sss <- w ^? hud . diSections
-    y <- inverseSelNumPos cfig invDP (w^.input.mousePos) sss
+    y <- inverseSelNumPos cfig invDP (w ^. input . mousePos) sss
     return $ IM.foldlWithKey' f w $ sssSelectionSlice sss x y
   where
-    f w' i ss 
-        | i == 0 || i == 3 = w' 
-            & hud . diSections . ix i . ssSet %~ symmetricDifference (IM.keysSet (ss ^. ssItems))
+    f w' i ss
+        | i == 0 || i == 3 =
+            w'
+                & hud
+                . diSections
+                . ix i
+                . ssSet
+                %~ symmetricDifference (IM.keysSet (ss ^. ssItems))
         | otherwise = w'
 
 -- this is in Data.IntSet 0.8
@@ -241,16 +215,23 @@ symmetricDifference x y = (x `IS.union` y) IS.\\ (x `IS.intersection` y)
 
 updateMouseClickInGame :: Config -> World -> World
 updateMouseClickInGame cfig w = case w ^. input . mouseContext of
-    MouseInGame -> w & input . mouseContext .~ OverInvDragSelect
-        (inverseSelSecYint 
-                (posSelSecYint cfig invDP (w ^. input . mousePos . _y))
-                (w ^. hud . diSections))
+    MouseInGame ->
+        w
+            & input
+            . mouseContext
+            .~ OverInvDragSelect
+                ( inverseSelSecYint
+                    (posSelSecYint cfig invDP (w ^. input . mousePos . _y))
+                    (w ^. hud . diSections)
+                )
     OverInvSelect (-1, _)
-        | selsec == Just (-1) -> w
+        | selsec == Just (-1) ->
+            w
                 & hud . diSelection %~ endRegex (-1) w
                 & hud . diInvFilter .~ Nothing
     OverInvSelect (2, _)
-        | selsec == Just 2 -> w
+        | selsec == Just 2 ->
+            w
                 & hud . diSelection %~ endRegex 2 w
                 & hud . diCloseFilter .~ Nothing
     OverInvSelect (5, j) -> fromMaybe w $ do
@@ -258,25 +239,29 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
         but <- w ^? cWorld . lWorld . buttons . ix k
         return $ doButtonEvent (but ^. btEvent) but w
     OverInvSelect x
-        | ScancodeLShift `M.member` (w ^. input . pressedKeys)
-            -> w & input . mouseContext .~ OverInvDragSelect (NonInf x)
+        | ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
+            w & input . mouseContext .~ OverInvDragSelect (NonInf x)
     OverInvSelect x -> startDrag x w
     OverTerminal tmid TerminalTextInput{} -> terminalReturnEffect tmid w
     OverTerminal tmid TerminalPressTo{} -> continueTerminal tmid w
     OutsideTerminal -> w & hud . subInventory .~ NoSubInventory
-    OverCombSelect x -> w
+    OverCombSelect x ->
+        w
             & hud . subInventory . ciSelection ?~ f x
             & worldEventFlags . at CombineInventoryChange ?~ ()
-    OverCombFilter -> w
+    OverCombFilter ->
+        w
             & hud . subInventory . ciFilter .~ Nothing
             & worldEventFlags . at CombineInventoryChange ?~ ()
             & hud . subInventory . ciSelection %~ endCombineRegex w
-    OverCombCombine x -> w
+    OverCombCombine x ->
+        w
             & tryCombine x
             & worldEventFlags . at CombineInventoryChange ?~ ()
             & worldEventFlags . at InventoryChange ?~ ()
             & maybeExitCombine
-    OverCombEscape -> w
+    OverCombEscape ->
+        w
             & worldEventFlags . at InventoryChange ?~ ()
             & hud . subInventory .~ NoSubInventory
     OverCombFiltInv (0, j) -> fromMaybe w $ do
@@ -313,23 +298,16 @@ endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
         return (k - 1)
 
 startDrag :: (Int, Int) -> World -> World
-startDrag (a, b) w = w
-    & input . mouseContext .~ OverInvDrag a
-    & invSetSelectionPos a b
-    & f
+startDrag (a, b) w =
+    w
+        & input . mouseContext .~ OverInvDrag a
+        & invSetSelectionPos a b
+        & f
   where
     f = fromMaybe id $ do
         is <- w ^? hud . diSections . ix a . ssSet
         guard $ not $ b `IS.member` is
         return $ hud . diSections . ix a . ssSet .~ mempty
---  setcontext $ fromMaybe (invSetSelection (Sel a b) w & hud.diSections.ix a.ssSet.~ mempty) $ do
---    i <- w ^? hud . diSelection . _Just . slSec
---    xs <- w ^? hud . diSections . ix a . ssSet
---    guard $ i == a && b `IS.member` xs
---    return w
---  where
---    --setcontext = input . mouseContext .~ OverInvDrag a (Just (a, b))
---    setcontext = input . mouseContext .~ OverInvDrag a
 
 shiftInvItems ::
     Config ->
@@ -356,12 +334,12 @@ shiftInvItems cfig n k x xs ss w = setSelWhileDragging cfig . fromMaybe w $ do
         _ | x < (k, mini) -> do
             guard $ not . null . fst $ IM.split mini ss
             guard $ Just (k, mini - 1) /= ab
-            --return . doDrag cfig (n - 1) k (Just x) $ shiftInvItemsUp k xs w
+            -- return . doDrag cfig (n - 1) k (Just x) $ shiftInvItemsUp k xs w
             return . doDrag cfig (n - 1) k $ shiftInvItemsUp k xs w
         _ | x > (k, maxi) -> do
             guard $ not . null . snd $ IM.split maxi ss
             guard $ Just (k, maxi + 1) /= bn
-            --return . doDrag cfig (n - 1) k (Just x) $ shiftInvItemsDown k xs w
+            -- return . doDrag cfig (n - 1) k (Just x) $ shiftInvItemsDown k xs w
             return . doDrag cfig (n - 1) k $ shiftInvItemsDown k xs w
         _ -> Nothing
 
@@ -369,8 +347,8 @@ setSelWhileDragging :: Config -> World -> World
 setSelWhileDragging cfig w = fromMaybe w $ do
     Sel i _ <- w ^? hud . diSelection . _Just
     xs <- w ^? hud . diSections . ix i . ssSet
-    --(k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
-    (k, j) <- inverseSelNumPos cfig invDP (w^.input.mousePos) (w^.hud.diSections) ^? _Just . nonInf
+    -- (k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
+    (k, j) <- inverseSelNumPos cfig invDP (w ^. input . mousePos) (w ^. hud . diSections) ^? _Just . nonInf
     guard $ i == k && j `IS.member` xs
     return $ w & hud . diSelection . _Just . slInt .~ j
 
@@ -511,17 +489,27 @@ updateBackspaceRegex w = case di ^? subInventory of
     Just NoSubInventory{}
         | secfocus (-1) 0 ->
             w
-                & hud %~ trybackspace (-1) diInvFilter diInvFilter diSelection
-                & worldEventFlags . at InventoryChange ?~ ()
+                & hud
+                %~ trybackspace (-1) diInvFilter diInvFilter diSelection
+                & worldEventFlags
+                . at InventoryChange
+                ?~ ()
     Just NoSubInventory{}
         | secfocus 2 3 ->
             w
-                & hud %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
-                & worldEventFlags . at InventoryChange ?~ ()
+                & hud
+                %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
+                & worldEventFlags
+                . at InventoryChange
+                ?~ ()
     Just CombineInventory{} ->
         w
-            & hud . subInventory %~ trybackspace (-1) ciFilter ciFilter ciSelection
-            & worldEventFlags . at InventoryChange ?~ ()
+            & hud
+            . subInventory
+            %~ trybackspace (-1) ciFilter ciFilter ciSelection
+            & worldEventFlags
+            . at InventoryChange
+            ?~ ()
     _ -> w
   where
     secfocus a b = fromMaybe False $ do
@@ -557,8 +545,12 @@ updateEnterRegex w = case w ^? hud . subInventory of
         | secfocus [2, 3] ->
             -- w & hud . diSelection ?~ Sel 2 0 mempty
             w
-                & hud . diSelection ?~ Sel 2 0
-                & hud . diCloseFilter %~ enterregex
+                & hud
+                . diSelection
+                ?~ Sel 2 0
+                & hud
+                . diCloseFilter
+                %~ enterregex
     Just CombineInventory{} ->
         w
             & hud
@@ -605,7 +597,11 @@ tryCombine (i, j) w = fromMaybe w $ do
     return $
         createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is))
             & soundStart InventorySound p wrench1S Nothing
-            & hud . diSections . ix 1 . ssSet .~ mempty
+            & hud
+            . diSections
+            . ix 1
+            . ssSet
+            .~ mempty
 
 --            & hud . diSelection . _Just . slSet .~ mempty