diff --git a/ghcidOutput b/ghcidOutput index f762ff240..5eb8f3a6c 100644 --- a/ghcidOutput +++ b/ghcidOutput @@ -1,30 +1,25 @@ -/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:124:1-15: warning: [-Wunused-top-binds] - Defined but not used: ‘tryDropSelected’ +/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:128:9-18: warning: [-Wunused-local-binds] + Defined but not used: ‘nfreeslots’ | -124 | tryDropSelected w = do - | ^^^^^^^^^^^^^^^ -/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:131:1-17: warning: [-Wunused-top-binds] - Defined but not used: ‘tryPickupSelected’ +128 | let nfreeslots = crNumFreeSlots cr + | ^^^^^^^^^^ +/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:130:5-6: warning: [-Wunused-matches] + Defined but not used: ‘xs’ | -131 | tryPickupSelected w = do - | ^^^^^^^^^^^^^^^^^ -/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:135:19: warning: [-Wunused-matches] +130 | xs <- w ^? hud . hudElement . diSelectionExtra + | ^^ +/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:131:19: warning: [-Wunused-matches] Defined but not used: ‘x’ | -135 | OverInvDrag 3 x <- w ^? input . mouseContext +131 | OverInvDrag 3 x <- w ^? input . mouseContext | ^ +/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:137:17: warning: [-Wunused-matches] + Defined but not used: ‘i’ + | +137 | OverInvDrag i mpos -> + | ^ /home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:209:9: warning: [-Wunused-matches] Defined but not used: ‘j’ | 209 | (i, j) <- w ^? hud . hudElement . diSelection . _Just | ^ -/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:227:1-12: warning: [-Wunused-top-binds] - Defined but not used: ‘dragInvItems’ - | -227 | dragInvItems j is cfig mpos ldp sss w - | ^^^^^^^^^^^^ -/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:297:1-13: warning: [-Wunused-top-binds] - Defined but not used: ‘shiftInvItems’ - | -297 | shiftInvItems j xs cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of - | ^^^^^^^^^^^^^ diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index e2d142393..90b9e7934 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -14,7 +14,6 @@ module Dodge.Creature.Action ( sizeSelf, youDropItem, pickUpItem, - -- pickUpItemID, ) where import Control.Applicative diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index cb74b8470..642abbf5c 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -84,8 +84,11 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of MouseMenuClick {} -> drawMenuClick 5 MouseMenuCursor -> drawMenuCursor 5 MouseInGame -> drawPlus 5 + OverInvDrag 0 (Just (3,_)) -> drawDragDrop 5 + OverInvDrag 0 Nothing -> drawDragDrop 5 OverInvDrag 0 (Just (0,_)) -> drawDrag 5 - OverInvDrag 0 _ -> drawDragDrop 5 + OverInvDrag 0 _ -> drawEmptySet 5 +-- OverInvDrag 0 _ -> drawDragDrop 5 OverInvDrag 3 (Just (3,_)) -> drawDrag 5 OverInvDrag 3 _ -> drawDragPickup 5 OverInvDrag _ _ -> drawEmptySet 5 diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index f9a7713c4..67034ef2a 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -105,7 +105,7 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of x <- mmouseover is <- w ^? hud . hudElement . diSelectionExtra return $ if concurrentIS is - then shiftInvItems' k x is ss w + then shiftInvItems k x is ss w else collectInvItems is w -- let mpos = w ^. input . mousePos -- return $ w & dragInvItems k xs cfig mpos ldp sss @@ -113,34 +113,34 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of where ldp = invDisplayParams w -dropSelected :: World -> World -dropSelected w = fromMaybe w $ do +tryDropSelected :: Maybe (Int,Int) -> World -> Maybe World +tryDropSelected mpos w = do + guard $ maybe True (\(i,_) -> i == 3) mpos cr <- w ^? cWorld . lWorld . creatures . ix 0 (0, _) <- w ^? hud . hudElement . diSelection . _Just xs <- w ^? hud . hudElement . diSelectionExtra return $ IS.foldr (dropItem cr) w xs -tryDropSelected :: World -> Maybe World -tryDropSelected w = do - cr <- w ^? cWorld . lWorld . creatures . ix 0 - (0, _) <- w ^? hud . hudElement . diSelection . _Just - xs <- w ^? hud . hudElement . diSelectionExtra - return $ IS.foldr (dropItem cr) w xs - -tryPickupSelected :: World -> Maybe World -tryPickupSelected w = do +tryPickupSelected :: Maybe (Int,Int) -> World -> Maybe World +tryPickupSelected mpos w = do + guard $ maybe True (\(i,_) -> i == 0) mpos cr <- w ^? cWorld . lWorld . creatures . ix 0 + let nfreeslots = crNumFreeSlots cr (3, _) <- w ^? hud . hudElement . diSelection . _Just xs <- w ^? hud . hudElement . diSelectionExtra OverInvDrag 3 x <- w ^? input . mouseContext - return $ IS.foldr (dropItem cr) w xs + return w +-- return $ IS.foldr (dropItem cr) w xs updateMouseReleaseInGame :: World -> World updateMouseReleaseInGame w = case w ^. input . mouseContext of - OverInvDrag i mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do - j <- mpos - guard $ fst j == i - return $ w & input . mouseContext .~ OverInvSelect j + OverInvDrag i mpos -> + input . mouseContext .~ MouseInGame $ + fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected mpos w +-- OverInvDrag i mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do +-- j <- mpos +-- guard $ fst j == i +-- return $ w & input . mouseContext .~ OverInvSelect j OverInvDragSelect _ Nothing -> w & input . mouseContext .~ MouseInGame & hud . hudElement . diSelectionExtra .~ mempty @@ -215,21 +215,6 @@ startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w (input . mouseContext .~ OverInvDrag a (Just (a, b))) . (hud . hudElement . diSelectionExtra .~ x) -dragInvItems :: - Int -> - IS.IntSet -> - Configuration -> - Point2 -> - ListDisplayParams -> - IM.IntMap (SelectionSection a) -> - World -> - World -dragInvItems j is cfig mpos ldp sss w - | nonconcurrent = collectInvItems is w - | otherwise = shiftInvItems j is cfig mpos ldp sss w - where - nonconcurrent = not $ concurrentIS is - concurrentIS :: IS.IntSet -> Bool concurrentIS = go . IS.minView where @@ -247,14 +232,14 @@ collectInvItems is w = fromMaybe w $ do (k, ks) <- IS.minView js return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w' -shiftInvItems' :: +shiftInvItems :: Int -> (Int,Int) -> IS.IntSet -> IM.IntMap (SelectionItem a) -> World -> World -shiftInvItems' k x xs ss w = fromMaybe w $ do +shiftInvItems k x xs ss w = fromMaybe w $ do (maxi,_) <- IS.maxView xs (mini,_) <- IS.minView xs if x < (k,mini) @@ -267,50 +252,6 @@ shiftInvItems' k x xs ss w = fromMaybe w $ do maxss <- IM.lookupMax ss guard (maxi < fst maxss) return $ shiftInvItemsDown k xs w --- if --- Just p -> fromMaybe w $ do --- (k,_) <- IS.minView xs --- guard $ p < (j,k) --- ss <- sss ^? ix j . ssItems --- minsss <- IM.lookupMin ss --- guard (k > fst minsss) --- return $ shiftInvItemsUp j xs w --- _ -> case inverseSelBoundaryDown cfig ldp sss mpos of --- Just p -> fromMaybe w $ do --- (k,_) <- IS.maxView xs --- guard $ p > (j,k) --- ss <- sss ^? ix j . ssItems --- maxsss <- IM.lookupMax ss --- guard (k < fst maxsss) --- return $ shiftInvItemsDown j xs w --- _ -> w - -shiftInvItems :: - Int -> - IS.IntSet -> - Configuration -> - Point2 -> - ListDisplayParams -> - IM.IntMap (SelectionSection a) -> - World -> - World -shiftInvItems j xs cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of - Just p -> fromMaybe w $ do - (k,_) <- IS.minView xs - guard $ p < (j,k) - ss <- sss ^? ix j . ssItems - minsss <- IM.lookupMin ss - guard (k > fst minsss) - return $ shiftInvItemsUp j xs w - _ -> case inverseSelBoundaryDown cfig ldp sss mpos of - Just p -> fromMaybe w $ do - (k,_) <- IS.maxView xs - guard $ p > (j,k) - ss <- sss ^? ix j . ssItems - maxsss <- IM.lookupMax ss - guard (k < fst maxsss) - return $ shiftInvItemsDown j xs w - _ -> w shiftInvItemsUp :: Int -> IS.IntSet -> World -> World shiftInvItemsUp j is w = IS.foldl' f w is