Fix bug not allowing dragging at extreme bottom edge
This commit is contained in:
+1
-1
@@ -1 +1 @@
|
||||
All good (594 modules, at 20:03:59)
|
||||
All good (594 modules, at 20:39:56)
|
||||
|
||||
@@ -1,6 +1,9 @@
|
||||
{-# OPTIONS_GHC -Wno-unused-imports #-}
|
||||
module Dodge.TestString where
|
||||
|
||||
import Linear
|
||||
import Dodge.ListDisplayParams
|
||||
import Dodge.SelectionSections
|
||||
import qualified Control.Foldl as L
|
||||
import Dodge.DoubleTree
|
||||
import Dodge.Data.DoubleTree
|
||||
@@ -24,7 +27,20 @@ testStringInit :: Universe -> [String]
|
||||
testStringInit u =
|
||||
[ show $ u ^? uvWorld . input . mouseContext . mcoSelEnd
|
||||
, show $ u ^? uvWorld . hud . hudElement . diSelection
|
||||
, show $ u ^? uvWorld . input . mouseContext
|
||||
, show $ u ^? uvWorld . input . mouseContext . mcoDragSection
|
||||
, show $ u ^? uvWorld . input . mouseContext . mcoMaybeSelect
|
||||
, show $ u ^? uvWorld . input . mouseContext . mcoAboveSelect
|
||||
, show $ u ^? uvWorld . input . mouseContext . mcoBelowSelect
|
||||
, show mpos
|
||||
, show yint
|
||||
, show $ u ^? uvWorld . hud . hudElement . diSections >>= inverseSelSecYint yint
|
||||
]
|
||||
where
|
||||
idp = invDisplayParams $ u ^. uvWorld
|
||||
cfig = u ^. uvConfig
|
||||
yint = posSelSecYint cfig idp y
|
||||
mpos@(V2 _ y) = u ^. uvWorld . input . mousePos
|
||||
-- , show . fmap (fmap _siPictures) $ u ^? uvWorld . hud . hudElement . diSections . ix (-1) . ssItems
|
||||
-- <> [[toEnum (i+j * 32) | i <- [0..31]] | j <- [0..7]]
|
||||
-- <> map show (IM.elems (L.postscan (L.premap _siHeight L.sum)
|
||||
|
||||
@@ -292,7 +292,7 @@ shiftInvItems k x ab bn xs ss w = setSelWhileDragging . fromMaybe w $ do
|
||||
return $ shiftInvItemsUp k xs w
|
||||
else do
|
||||
guard $ not . null . snd $ IM.split maxi ss
|
||||
guard $ Just (k,maxi+1) < bn
|
||||
guard $ Just (k,maxi+1) /= bn
|
||||
return $ shiftInvItemsDown k xs w
|
||||
|
||||
setSelWhileDragging :: World -> World
|
||||
|
||||
Reference in New Issue
Block a user