Cleanup
This commit is contained in:
@@ -56,17 +56,17 @@ drawInventory sss w cfig =
|
|||||||
drawSelectionSections sss ldp cfig
|
drawSelectionSections sss ldp cfig
|
||||||
<> drawSSCursor sss (f $ w ^? hud . hudElement . diSelection . _Just) ldp curs cfig
|
<> drawSSCursor sss (f $ w ^? hud . hudElement . diSelection . _Just) ldp curs cfig
|
||||||
<> drawRootCursor w sss (f $ w ^? hud . hudElement . diSelection . _Just) ldp cfig
|
<> drawRootCursor w sss (f $ w ^? hud . hudElement . diSelection . _Just) ldp cfig
|
||||||
<> iextra
|
<> itemconnections
|
||||||
<> drawMouseOver cfig w
|
<> drawMouseOver cfig w
|
||||||
where
|
where
|
||||||
f = fmap (\(x, y, _) -> (x, y))
|
f = fmap (\(x, y, _) -> (x, y))
|
||||||
ldp = invDisplayParams w
|
ldp = invDisplayParams w
|
||||||
curs = invCursorParams w
|
curs = invCursorParams w
|
||||||
iextra = fromMaybe mempty $ do
|
itemconnections = fromMaybe mempty $ do
|
||||||
inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
||||||
case w ^? hud . hudElement . diInvFilter . _Just of
|
case w ^? hud . hudElement . diInvFilter . _Just of
|
||||||
Just (_ : _) -> Nothing
|
Just (_ : _) -> Nothing
|
||||||
_ -> return . inventoryExtra sss cfig w $ invAdj inv
|
_ -> return . drawItemConnections sss cfig w $ invAdj inv
|
||||||
|
|
||||||
drawRootCursor ::
|
drawRootCursor ::
|
||||||
World ->
|
World ->
|
||||||
@@ -304,25 +304,25 @@ equipAllocString = \case
|
|||||||
ReplaceEquipment{} -> " PUT ON"
|
ReplaceEquipment{} -> " PUT ON"
|
||||||
RemoveEquipment{} -> "TAKE OFF"
|
RemoveEquipment{} -> "TAKE OFF"
|
||||||
|
|
||||||
inventoryExtra ::
|
drawItemConnections ::
|
||||||
IM.IntMap (SelectionSection ()) ->
|
IM.IntMap (SelectionSection ()) ->
|
||||||
Configuration ->
|
Configuration ->
|
||||||
World ->
|
World ->
|
||||||
IM.IntMap (Maybe (Int, Int), [Int], [Int]) ->
|
IM.IntMap (Maybe (Int, Int), [Int], [Int]) ->
|
||||||
Picture
|
Picture
|
||||||
inventoryExtra sss cfig w =
|
drawItemConnections sss cfig w =
|
||||||
translate (negate 5) 0
|
translate (negate 5) 0
|
||||||
. IM.foldMapWithKey (inventoryExtraH sss cfig w)
|
. IM.foldMapWithKey (drawItemChildrenConnect sss cfig w)
|
||||||
. fmap (\(_, a, b) -> a <> b)
|
. fmap (\(_, a, b) -> a <> b)
|
||||||
|
|
||||||
inventoryExtraH ::
|
drawItemChildrenConnect ::
|
||||||
IM.IntMap (SelectionSection ()) ->
|
IM.IntMap (SelectionSection ()) ->
|
||||||
Configuration ->
|
Configuration ->
|
||||||
World ->
|
World ->
|
||||||
Int ->
|
Int ->
|
||||||
[Int] ->
|
[Int] ->
|
||||||
Picture
|
Picture
|
||||||
inventoryExtraH sss cfig w i is = fromMaybe mempty $ do
|
drawItemChildrenConnect sss cfig w i is = fromMaybe mempty $ do
|
||||||
p <- snum i
|
p <- snum i
|
||||||
let ps = mapMaybe snum is
|
let ps = mapMaybe snum is
|
||||||
return $ color white $ lConnectMulti ps p
|
return $ color white $ lConnectMulti ps p
|
||||||
|
|||||||
@@ -91,13 +91,6 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
|
|||||||
guard $ Just (fst sstart) == fmap fst msel || isNothing msel
|
guard $ Just (fst sstart) == fmap fst msel || isNothing msel
|
||||||
return $ w & input . mouseContext . mcoSelEnd .~ fmap snd 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 -> 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
|
_ -> w
|
||||||
where
|
where
|
||||||
ldp = invDisplayParams w
|
ldp = invDisplayParams w
|
||||||
@@ -116,7 +109,7 @@ doDrag n k mmouseover ab bn w = fromMaybe w $ do
|
|||||||
x <- mmouseover
|
x <- mmouseover
|
||||||
is <- w ^? hud . hudElement . diSelection . _Just . _3
|
is <- w ^? hud . hudElement . diSelection . _Just . _3
|
||||||
return $ if concurrentIS is
|
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
|
else collectInvItems k is w
|
||||||
|
|
||||||
tryDropSelected :: Maybe (Int,Int) -> World -> Maybe World
|
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'
|
return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
|
||||||
|
|
||||||
shiftInvItems ::
|
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 -> -- recurse limit
|
||||||
Int -> -- section where drag started
|
Int -> -- section where drag started
|
||||||
(Int,Int) -> -- selection item mouse is over
|
(Int,Int) -> -- selection item mouse is over
|
||||||
@@ -331,7 +299,7 @@ shiftInvItems' ::
|
|||||||
IM.IntMap (SelectionItem a) ->
|
IM.IntMap (SelectionItem a) ->
|
||||||
World ->
|
World ->
|
||||||
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
|
let xk = fst x
|
||||||
guard $ xk == k || xk + 1 == k || xk -1 == k
|
guard $ xk == k || xk + 1 == k || xk -1 == k
|
||||||
(maxi,_) <- IS.maxView xs
|
(maxi,_) <- IS.maxView xs
|
||||||
|
|||||||
Reference in New Issue
Block a user