From 9e0ef2ed1df125a237d019d87337551ed9a59c8a Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 26 Nov 2024 21:27:09 +0000 Subject: [PATCH] Cleanup --- src/Dodge/Render/HUD.hs | 16 +++++++------- src/Dodge/Update/Input/InGame.hs | 36 ++------------------------------ 2 files changed, 10 insertions(+), 42 deletions(-) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 3003b7567..c98cbb384 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -56,17 +56,17 @@ drawInventory sss w cfig = drawSelectionSections sss ldp cfig <> drawSSCursor sss (f $ w ^? hud . hudElement . diSelection . _Just) ldp curs cfig <> drawRootCursor w sss (f $ w ^? hud . hudElement . diSelection . _Just) ldp cfig - <> iextra + <> itemconnections <> drawMouseOver cfig w where f = fmap (\(x, y, _) -> (x, y)) ldp = invDisplayParams w curs = invCursorParams w - iextra = fromMaybe mempty $ do + itemconnections = fromMaybe mempty $ do inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv case w ^? hud . hudElement . diInvFilter . _Just of Just (_ : _) -> Nothing - _ -> return . inventoryExtra sss cfig w $ invAdj inv + _ -> return . drawItemConnections sss cfig w $ invAdj inv drawRootCursor :: World -> @@ -304,25 +304,25 @@ equipAllocString = \case ReplaceEquipment{} -> " PUT ON" RemoveEquipment{} -> "TAKE OFF" -inventoryExtra :: +drawItemConnections :: IM.IntMap (SelectionSection ()) -> Configuration -> World -> IM.IntMap (Maybe (Int, Int), [Int], [Int]) -> Picture -inventoryExtra sss cfig w = +drawItemConnections sss cfig w = translate (negate 5) 0 - . IM.foldMapWithKey (inventoryExtraH sss cfig w) + . IM.foldMapWithKey (drawItemChildrenConnect sss cfig w) . fmap (\(_, a, b) -> a <> b) -inventoryExtraH :: +drawItemChildrenConnect :: IM.IntMap (SelectionSection ()) -> Configuration -> World -> Int -> [Int] -> Picture -inventoryExtraH sss cfig w i is = fromMaybe mempty $ do +drawItemChildrenConnect sss cfig w i is = fromMaybe mempty $ do p <- snum i let ps = mapMaybe snum is return $ color white $ lConnectMulti ps p diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index e33686b22..a85049699 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -91,13 +91,6 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of guard $ Just (fst sstart) == fmap fst msel || isNothing msel return $ w & input . mouseContext . mcoSelEnd .~ fmap snd msel OverInvDrag k mmouseover ab bn -> doDrag 30 k mmouseover ab bn w --- OverInvDrag k mmouseover ab bn -> fromMaybe w $ do --- ss <- w ^? hud . hudElement . diSections . ix k . ssItems --- x <- mmouseover --- is <- w ^? hud . hudElement . diSelection . _Just . _3 --- return $ if concurrentIS is --- then shiftInvItems k x ab bn is ss w --- else collectInvItems k is w _ -> w where ldp = invDisplayParams w @@ -116,7 +109,7 @@ doDrag n k mmouseover ab bn w = fromMaybe w $ do x <- mmouseover is <- w ^? hud . hudElement . diSelection . _Just . _3 return $ if concurrentIS is - then shiftInvItems' n k x ab bn is ss w + then shiftInvItems n k x ab bn is ss w else collectInvItems k is w tryDropSelected :: Maybe (Int,Int) -> World -> Maybe World @@ -297,31 +290,6 @@ collectInvItems secid is w = fromMaybe w $ do return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w' shiftInvItems :: - Int -> -- section where drag started - (Int,Int) -> -- selection item mouse is over - Maybe (Int,Int) -> -- selection item "above" mouse position (can be same as over) - Maybe (Int,Int) -> -- selection item "below" mouse position (can be same as over) - IS.IntSet -> - IM.IntMap (SelectionItem a) -> - World -> - World -shiftInvItems k x ab bn xs ss w = setSelWhileDragging . fromMaybe w $ do - let xk = fst x - guard $ xk == k || xk + 1 == k || xk -1 == k - (maxi,_) <- IS.maxView xs - (mini,_) <- IS.minView xs - case True of - _ | x < (k,mini) -> do - guard $ not . null . fst $ IM.split mini ss - guard $ Just (k,mini-1) /= ab - return $ shiftInvItemsUp k xs w - _ | x > (k,maxi) -> do - guard $ not . null . snd $ IM.split maxi ss - guard $ Just (k,maxi+1) /= bn - return $ shiftInvItemsDown k xs w - _ -> Nothing - -shiftInvItems' :: Int -> -- recurse limit Int -> -- section where drag started (Int,Int) -> -- selection item mouse is over @@ -331,7 +299,7 @@ shiftInvItems' :: IM.IntMap (SelectionItem a) -> World -> World -shiftInvItems' n k x ab bn xs ss w = setSelWhileDragging . fromMaybe w $ do +shiftInvItems n k x ab bn xs ss w = setSelWhileDragging . fromMaybe w $ do let xk = fst x guard $ xk == k || xk + 1 == k || xk -1 == k (maxi,_) <- IS.maxView xs