justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Remove SelectionSections

Browse Source
This commit is contained in:
justin
2024-10-25 22:19:04 +01:00
parent a20fc48eaa
commit d93c548d3c
15 changed files with 202 additions and 195 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+1 -1
View File
@@ -185,7 +185,7 @@ youDropItem :: World -> World
youDropItem w = fromMaybe w $ do
curpos <-
you w ^? crManipulation . manObject . imSelectedItem
<|> fmap fst (IM.lookupMax =<< w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems)
<|> fmap fst (IM.lookupMax =<< w ^? hud . hudElement . diSections . ix 0 . ssItems)
guard $ not $ _crInvLock (you w)
return $
w
src/Dodge/Data/HUD.hs
+2 -2
View File
@@ -16,7 +16,7 @@ import Geometry.Data
data HUDElement
= DisplayInventory
{ _subInventory :: SubInventory
, _diSections :: SelectionSections ()
, _diSections :: IntMap (SelectionSection ())
, _diSelection :: Maybe (Int, Int)
, _diFilters :: IntMap (Maybe String)
, _diSelectionExtra :: Int
@@ -36,7 +36,7 @@ data SubInventory
}
| ExamineInventory
| CombineInventory
{ _ciSections :: SelectionSections CombinableItem
{ _ciSections :: IntMap (SelectionSection CombinableItem)
, _ciSelection :: Maybe (Int, Int)
, _ciFilters :: IntMap (Maybe String)
}
src/Dodge/Data/SelectionList.hs
+4 -13
View File
@@ -33,17 +33,9 @@ data SelectionList a = SelectionList
, _slSelPos :: Maybe Int
}
data SelectionSections a = SelectionSections
{ _sssSections :: IntMap (SelectionSection a)
-- , _sssExtra :: SSSExtra
}
-- note that filters are arbitrary: the sssFilters point to the lower of
-- a pair of ints (i,i+1) such that the lower is the regex section, the higher
-- is the items section.
newtype SSSExtra = SSSExtra
{ _sssFilters :: IntMap (Maybe String)
}
--data SelectionSections a = SelectionSections
-- { _sssSections :: IntMap (SelectionSection a)
-- }
data SectionCursor = SectionCursor
{ _scurPos :: Int
@@ -87,8 +79,7 @@ makeLenses ''ListDisplayParams
makeLenses ''SelectionList
makeLenses ''SelectionItem
makeLenses ''SelectionSection
makeLenses ''SelectionSections
makeLenses ''SSSExtra
--makeLenses ''SelectionSections
makeLenses ''SectionCursor
makeLenses ''CursorDisplay
src/Dodge/Default/World.hs
+2 -7
View File
@@ -177,11 +177,8 @@ defaultDisplayInventory =
-- { _sssFilters = IM.fromList [(-1, mempty), (2, mempty)]
-- }
defaultInvSections :: SelectionSections ()
defaultInvSections =
SelectionSections
{ _sssSections =
IM.fromDistinctAscList $
defaultInvSections :: IM.IntMap (SelectionSection ())
defaultInvSections = IM.fromDistinctAscList $
zip
[-1 ..]
[ defaultFiltSection
@@ -191,8 +188,6 @@ defaultInvSections =
& ssDescriptor .~ "NEARBY"
, defaultCOSection
]
-- , _sssExtra = defaultSSSExtra
}
defaultSS :: SelectionSection a
defaultSS =
src/Dodge/DisplayInventory.hs
+21 -16
View File
@@ -36,10 +36,13 @@ updateCombinePositioning u =
u & uvWorld . hud . hudElement . subInventory . ciSections
%~ updateCombineSections (_uvWorld u) (_uvConfig u)
updateCombineSections :: World -> Configuration -> SelectionSections CombinableItem -> SelectionSections CombinableItem
updateCombineSections ::
World ->
Configuration ->
IM.IntMap (SelectionSection CombinableItem) ->
IM.IntMap (SelectionSection CombinableItem)
updateCombineSections w cfig =
sssSections
%~ updateSectionsPositioning
updateSectionsPositioning
mselpos
availablelines
[(0, showncombs), (-1, filtinv)]
@@ -49,11 +52,12 @@ updateCombineSections w cfig =
allcombs = IM.fromDistinctAscList $ zip [0 ..] $ combineList w
filtcombs = fromMaybe allcombs $ do
str <- mstr
invitms <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems
invitms <- w ^? hud . hudElement . diSections . ix 0 . ssItems
return $ IM.filter (flip (andOrRegex $ regexCombs invitms) str) allcombs
showncombs
| null filtcombs = IM.singleton 0
$ SelectionInfo ["No possible combinations"] 1 False white 0
| null filtcombs =
IM.singleton 0 $
SelectionInfo ["No possible combinations"] 1 False white 0
| otherwise = filtcombs
filtinv = fromMaybe mempty $ do
str <- mstr
@@ -90,14 +94,14 @@ updateInventoryPositioning u =
updateDisplaySections ::
World ->
Configuration ->
SelectionSections () ->
SelectionSections ()
IM.IntMap (SelectionSection ()) ->
IM.IntMap (SelectionSection ())
updateDisplaySections w cfig sss =
sss & sssSections
%~ updateSectionsPositioning
updateSectionsPositioning
mselpos
availablelines
addorder
sss
where
mselpos = w ^? hud . hudElement . diSelection . _Just
addorder = case mselpos of
@@ -246,17 +250,18 @@ listSelectionColorPicture = foldMap f
g str = (_siColor si, translate indent 0 . color (_siColor si) $ text str)
enterCombineInv :: Configuration -> World -> World
enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory sss selpos
(IM.singleton (-1) Nothing)
enterCombineInv cfig w =
w & hud . hudElement . subInventory
.~ CombineInventory
sss
selpos
(IM.singleton (-1) Nothing)
where
cm' = IM.fromDistinctAscList . zip [0 ..] $ combineList w
cm
| null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
| otherwise = cm'
sss =
SelectionSections
{ _sssSections = IM.fromDistinctAscList [(-1, filtsection), (0, combsection)]
}
sss = IM.fromDistinctAscList [(-1, filtsection), (0, combsection)]
selpos
| null cm' = Nothing
| otherwise = Just (0, 0)
src/Dodge/InputFocus.hs
-1
View File
@@ -11,7 +11,6 @@ module Dodge.InputFocus (
import Control.Monad
import Data.Maybe
import Dodge.Data.SelectionList
import Dodge.Data.World
import LensHelp
src/Dodge/Inventory.hs
+4 -4
View File
@@ -122,7 +122,7 @@ updateCloseObjects w =
case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject of
Just i
| i >= length newcloseobjects -> scrollAugInvSel 1
| isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) ->
| isNothing (w ^? hud . hudElement . diSections . ix 3 . ssItems . ix i) ->
scrollAugInvSel (-1)
_ -> id
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
@@ -159,7 +159,7 @@ changeSwapClose ::
World ->
World
changeSwapClose f i w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems
ss <- w ^? hud . hudElement . diSections . ix 3 . ssItems
k <- f i ss
return $
w
@@ -176,7 +176,7 @@ swapInvItems ::
World ->
World
swapInvItems f i w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems
ss <- w ^? hud . hudElement . diSections . ix 0 . ssItems
k <- f i ss
let updateselection = case w ^? hud . hudElement . diSelection . _Just of
Just (0, j) | j == k -> hud . hudElement . diSelection . _Just . _2 .~ i
@@ -239,5 +239,5 @@ selectedCloseObject :: World -> Maybe (Either FloorItem Button)
selectedCloseObject w = do
i <-
you w ^? crManipulation . manObject . ispCloseObject
<|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems)
<|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . ix 3 . ssItems)
w ^? hud . closeObjects . ix i
src/Dodge/Render/HUD.hs
+21 -11
View File
@@ -56,7 +56,7 @@ drawHP cfig =
. show
. (^?! cWorld . lWorld . creatures . ix 0 . crHP)
drawInventory :: SelectionSections () -> World -> Configuration -> Picture
drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Picture
drawInventory sss w cfig =
drawSelectionSections sss ldp cfig
<> drawSSCursor sss (w ^? hud . hudElement . diSelection . _Just) ldp curs cfig
@@ -123,7 +123,11 @@ drawSubInventory subinv cfig w = case subinv of
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
drawCombineInventory :: Configuration -> SelectionSections CombinableItem -> World -> Picture
drawCombineInventory ::
Configuration ->
IM.IntMap (SelectionSection CombinableItem) ->
World ->
Picture
drawCombineInventory cfig sss w =
invHead cfig "COMBINE"
<> drawSelectionSections sss secondColumnParams cfig
@@ -249,7 +253,7 @@ equipAllocString = \case
RemoveEquipment{} -> "TAKE OFF"
inventoryExtra ::
SelectionSections () ->
IM.IntMap (SelectionSection ()) ->
Configuration ->
World ->
IM.IntMap (Maybe (Int, Int), [Int], [Int]) ->
@@ -259,7 +263,13 @@ inventoryExtra sss cfig w =
. IM.foldMapWithKey (inventoryExtraH sss cfig w)
. fmap (\(_, a, b) -> a <> b)
inventoryExtraH :: SelectionSections () -> Configuration -> World -> Int -> [Int] -> Picture
inventoryExtraH ::
IM.IntMap (SelectionSection ()) ->
Configuration ->
World ->
Int ->
[Int] ->
Picture
inventoryExtraH sss cfig w i is = fromMaybe mempty $ do
p <- snum i
let ps = mapMaybe snum is
@@ -268,7 +278,7 @@ inventoryExtraH sss cfig w i is = fromMaybe mempty $ do
snum = selNumPos cfig (invDisplayParams w) sss 0
combineInventoryExtra ::
SelectionSections CombinableItem ->
IM.IntMap (SelectionSection CombinableItem) ->
Maybe (Int, Int) ->
Configuration ->
World ->
@@ -276,7 +286,7 @@ combineInventoryExtra ::
combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
(i, j) <- msel
cpos <- selSecYint i j sss
si <- sss ^? sssSections . ix i . ssItems . ix j
si <- sss ^? ix i . ssItems . ix j
let col = _siColor si
mconcat
[ do
@@ -403,7 +413,7 @@ invHead cfig =
selNumPos ::
Configuration ->
ListDisplayParams ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Int ->
Int ->
Maybe Point2
@@ -427,14 +437,14 @@ selNumPosCardinal ::
CardinalEightPoint ->
Configuration ->
ListDisplayParams ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Int ->
Int ->
Maybe Point2
selNumPosCardinal card cfig ldp sss i j = do
ipos <- selSecYint i j sss
size <- selSecSelSize i j sss
indent <- sss ^? sssSections . ix i . ssItems . ix j . siOffX
indent <- sss ^? ix i . ssItems . ix j . siOffX
let offset = cardEightVec card * V2 0 (fromIntegral size * 0.5 * 20 * s)
return $
screenPosAbs cfig (ldp ^. ldpPos)
@@ -446,5 +456,5 @@ selNumPosCardinal card cfig ldp sss i j = do
s = _ldpScale ldp
ygap = _ldpVerticalGap ldp
selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor
selSecSelCol :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Color
selSecSelCol i j sss = sss ^? ix i . ssItems . ix j . siColor
src/Dodge/Render/List.hs
+5 -4
View File
@@ -14,6 +14,7 @@ module Dodge.Render.List (
selSecDrawCursorAt,
) where
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Base.Window
import Dodge.Data.CardinalPoint
@@ -86,13 +87,13 @@ selSecDrawCursorAt ::
Int ->
ListDisplayParams ->
CursorDisplay ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
(Int, Int) ->
Picture
selSecDrawCursorAt xsize ldp curs sss (i, j) = fromMaybe mempty $ do
yint <- selSecYint i j sss
xint <- sss ^? sssSections . ix i . ssIndent
si <- sss ^? sssSections . ix i . ssItems . ix j
xint <- sss ^? ix i . ssIndent
si <- sss ^? ix i . ssItems . ix j
return $
listCursorChooseBorderScale
(ldp ^. ldpVerticalGap)
@@ -108,7 +109,7 @@ selSecDrawCursor ::
Int ->
ListDisplayParams ->
CursorDisplay ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Picture
selSecDrawCursor xsize ldp curs = maybe mempty . selSecDrawCursorAt xsize ldp curs
src/Dodge/SelectionSections.hs
+60 -41
View File
@@ -17,17 +17,17 @@ import Control.Applicative
import qualified Control.Foldl as L
import Control.Lens
import Control.Monad
import Data.Foldable
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.ScreenPos
import Geometry.Data
import Data.Foldable
scrollSelectionSections ::
Int ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
scrollSelectionSections yi sss msel
@@ -41,18 +41,18 @@ scrollSelectionSections yi sss msel
-- return $ sss & sssExtra . sssSelPos ?~ (i, j)
ssScrollUsing ::
(Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
SelectionSections a ->
(Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
ssScrollUsing g =
ssScrollMinOnFail
g
. (sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))
. fmap (ssItems %~ IM.filter _siIsSelectable)
ssScrollMinOnFail ::
(Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
SelectionSections a ->
(Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j)) $ l <|> ssLookupMin sss
@@ -62,76 +62,95 @@ ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j)) $ l <|> ssLookupMin s
f i j sss
ssSetCursor ::
(SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
SelectionSections a ->
(IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
ssSetCursor f sss msel = fromMaybe msel $ do
(i, j, _) <- f sss
return $ Just (i, j)
ssLookupMax :: SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupMax :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupMax sss = do
(i, _) <- IM.lookupMax (sss ^. sssSections)
(i, _) <- IM.lookupMax sss
ssLookupLE' i sss
ssLookupUp :: Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupUp ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupUp i j sss = case ssLookupLT i j sss of
Nothing -> ssLookupMax sss
x -> x
ssLookupDown :: Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupDown ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupDown i j sss = case ssLookupGT i j sss of
Nothing -> ssLookupMin sss
x -> x
ssLookupLT :: Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupLT ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do
ss <- sss ^? sssSections . ix i
ss <- sss ^? ix i
(j', si) <- IM.lookupLT j (ss ^. ssItems)
return $ Just (i, j', si)
ssLookupLT' :: Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupLT' ::
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupLT' i sss = do
(i', ss) <- IM.lookupLT i (sss ^. sssSections)
(i', ss) <- IM.lookupLT i sss
case IM.lookupMax (ss ^. ssItems) of
Just (j', si) -> return (i', j', si)
Nothing -> ssLookupLT' i' sss
ssLookupLE' :: Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupLE' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupLE' i sss = do
(i', ss) <- IM.lookupLE i (sss ^. sssSections)
(i', ss) <- IM.lookupLE i sss
case IM.lookupMax (ss ^. ssItems) of
Just (j', si) -> return (i', j', si)
Nothing -> ssLookupLT' i' sss
ssLookupMin :: SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupMin :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupMin sss = do
(i, _) <- IM.lookupMin (sss ^. sssSections)
(i, _) <- IM.lookupMin sss
ssLookupGE' i sss
ssLookupGT :: Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupGT ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupGT i j sss = fromMaybe (ssLookupGT' i sss) $ do
ss <- sss ^? sssSections . ix i
ss <- sss ^? ix i
(j', si) <- IM.lookupGT j (ss ^. ssItems)
return $ Just (i, j', si)
ssLookupGT' :: Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupGT' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupGT' i sss = do
(i', ss) <- IM.lookupGT i (sss ^. sssSections)
(i', ss) <- IM.lookupGT i sss
case IM.lookupMin (ss ^. ssItems) of
Just (j', si) -> return (i', j', si)
Nothing -> ssLookupGT' i' sss
ssLookupGE' :: Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupGE' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupGE' i sss = do
(i', ss) <- IM.lookupGE i (sss ^. sssSections)
(i', ss) <- IM.lookupGE i sss
case IM.lookupMin (ss ^. ssItems) of
Just (j', si) -> return (i', j', si)
Nothing -> ssLookupGT' i' sss
selSecSelSize :: Int -> Int -> SelectionSections a -> Maybe Int
selSecSelSize i j sss = fmap length $ sss ^? sssSections . ix i . ssItems . ix j . siPictures
selSecSelSize :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Int
selSecSelSize i j = fmap length . (^? ix i . ssItems . ix j . siPictures)
-- need to check that the vertical gap is correctly put in here
posSelSecYint :: Configuration -> ListDisplayParams -> Float -> Int
@@ -139,9 +158,9 @@ posSelSecYint cfig ldp y = floor $ (y0 - y) / (20 / ldp ^. ldpScale + ldp ^. ldp
where
V2 _ y0 = screenPosAbs cfig (ldp ^. ldpPos)
selSecYint :: Int -> Int -> SelectionSections a -> Maybe Int
selSecYint :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Int
selSecYint i j sss = do
ss <- sss ^? sssSections . ix i
ss <- sss ^? ix i
return . (secpos +)
. subtract (ss ^. ssOffset)
. sum
@@ -149,16 +168,16 @@ selSecYint i j sss = do
. fst
$ IM.split j (ss ^. ssItems)
where
secpos = sum . fmap (length . _ssShownItems) . fst $ IM.split i $ sss ^. sssSections
secpos = sum . fmap (length . _ssShownItems) . fst $ IM.split i $ sss
-- it is annoying that Control.Foldl doesn't seem to allow for scans to be done
-- at the same time as folds
inverseSelSecYint :: Int -> SelectionSections a -> Maybe (Int, Int)
inverseSelSecYint :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int)
inverseSelSecYint yint sss = do
((i, ss), othersss) <- IM.minViewWithKey (_sssSections sss)
((i, ss), othersss) <- IM.minViewWithKey sss
let l = length $ _ssShownItems ss
if l <= yint
then inverseSelSecYint (yint - l) (sss & sssSections .~ othersss)
then inverseSelSecYint (yint - l) othersss
else do
let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
j <- L.fold (L.findIndex (\x -> x - _ssOffset ss > yint)) ls
@@ -169,15 +188,15 @@ inverseSelSecYintXPosCheck ::
ListDisplayParams ->
Float ->
Int ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int)
inverseSelSecYintXPosCheck cfig ldp x yint sss = do
((i, ss), othersss) <- IM.minViewWithKey (_sssSections sss)
((i, ss), othersss) <- IM.minViewWithKey sss
let l = length $ _ssShownItems ss
V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
guard (x - x0 < 150) -- HACK, should determine selection item width and offset below
if l <= yint
then inverseSelSecYint (yint - l) (sss & sssSections .~ othersss)
then inverseSelSecYint (yint - l) othersss
else do
let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
j <- L.fold (L.findIndex (\val -> val - _ssOffset ss > yint)) ls
@@ -186,7 +205,7 @@ inverseSelSecYintXPosCheck cfig ldp x yint sss = do
inverseSelNumPos ::
Configuration ->
ListDisplayParams ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Point2 ->
Maybe (Int, Int)
inverseSelNumPos cfig ldp sss (V2 x y) =
@@ -195,7 +214,7 @@ inverseSelNumPos cfig ldp sss (V2 x y) =
inverseSelBoundaryUp ::
Configuration ->
ListDisplayParams ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Point2 ->
Maybe (Int, Int)
inverseSelBoundaryUp cfig ldp sss (V2 _ y) = do
@@ -208,7 +227,7 @@ inverseSelBoundaryUp cfig ldp sss (V2 _ y) = do
inverseSelBoundaryDown ::
Configuration ->
ListDisplayParams ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Point2 ->
Maybe (Int, Int)
inverseSelBoundaryDown cfig ldp sss (V2 _ y) = do
src/Dodge/SelectionSections/Draw.hs
+4 -3
View File
@@ -9,9 +9,10 @@ import Dodge.Data.SelectionList
import Dodge.Render.List
import Dodge.ScreenPos
import Picture.Base
import qualified Data.IntMap.Strict as IM
drawSelectionSections
:: SelectionSections a
:: IM.IntMap (SelectionSection a)
-> ListDisplayParams
-> Configuration
-> Picture
@@ -21,10 +22,10 @@ drawSelectionSections sss ldp cfig =
(_ldpVerticalGap ldp)
(_ldpScale ldp)
0
(foldMap _ssShownItems (_sssSections sss))
(foldMap _ssShownItems sss)
drawSSCursor
:: SelectionSections a
:: IM.IntMap (SelectionSection a)
-> Maybe (Int,Int)
-> ListDisplayParams
-> CursorDisplay
src/Dodge/Update.hs
+7 -3
View File
@@ -301,7 +301,11 @@ updateMouseInventorySelection cfig w = fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
return $ updateMouseInventorySelection' sss cfig w
updateMouseInventorySelection' :: SelectionSections a -> Configuration -> World -> World
updateMouseInventorySelection' ::
IM.IntMap (SelectionSection a) ->
Configuration ->
World ->
World
updateMouseInventorySelection' sss cfig w
| leftclickstart = case msel of
Nothing -> fromMaybe w $ do
@@ -350,7 +354,7 @@ shiftInvItems ::
Configuration ->
Point2 ->
ListDisplayParams ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
World ->
World
shiftInvItems topsel x cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of
@@ -368,7 +372,7 @@ shiftInvItemsUp (_, i) x w = foldl' f w [i .. i + x]
shiftInvItemsDown :: (Int, Int) -> Int -> World -> World
shiftInvItemsDown (_, i) x w = fromMaybe w $ do
guard . isJust $
w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems . ix (i + x + 1)
w ^? hud . hudElement . diSections . ix 0 . ssItems . ix (i + x + 1)
return $ foldl' f w $ reverse [i .. i + x]
where
f w' i' = swapInvItems g i' w'
src/Dodge/Update/Input/InGame.hs
+17 -14
View File
@@ -70,7 +70,7 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
sss <- ci ^? ciSections
msel <- ci ^? ciSelection
filts <- ci ^? ciFilters
let (sss', msel',filts') = doRegexInput (u ^. uvWorld . input) (-1) sss msel filts
let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) (-1) sss msel filts
return $
ci & ciSections .~ sss'
& ciSelection .~ msel'
@@ -79,7 +79,7 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
sss <- di ^? diSections
msel <- di ^? diSelection
filts <- di ^? diFilters
let (sss', msel',filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts
let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts
return $
di & diSections .~ sss'
& diSelection .~ msel'
@@ -156,10 +156,10 @@ updateLongPressInGame uv sc = case sc of
doRegexInput ::
Input ->
Int ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
IM.IntMap (Maybe String) ->
(SelectionSections a, Maybe (Int, Int), IM.IntMap (Maybe String))
(IM.IntMap (SelectionSection a), Maybe (Int, Int), IM.IntMap (Maybe String))
doRegexInput inp i sss msel filts
| backspacetonothing || escapekey = endregex i 0
| endkeys || endmouse = endregex (i + 1) (j -1)
@@ -170,13 +170,12 @@ doRegexInput inp i sss msel filts
)
where
endregex a b =
( sss
& sssSections . ix i . ssItems .~ mempty
( sss & ix i . ssItems .~ mempty
, msel & ssSetCursor (ssLookupDown a b) sss
, filts & ix i .~ Nothing
)
j = fromMaybe 0 $ do
itms <- sss ^? sssSections . ix (i + 1) . ssItems
itms <- sss ^? ix (i + 1) . ssItems
fst <$> IM.lookupMin itms
escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress
endkeys =
@@ -208,7 +207,6 @@ updateBackspaceRegex w = case di ^? subInventory of
i <- di ^? diSelection . _Just . _1
return $ i == a || i == b
trybackspace x he = fromMaybe he $ do
sss <- he ^? diSections
str <- he ^? diFilters . ix x . _Just
return $ case str of
(_ : _) ->
@@ -216,7 +214,6 @@ updateBackspaceRegex w = case di ^? subInventory of
& diSelection ?~ (x, 0)
[] -> he & diFilters . ix x .~ Nothing
trybackspace' x ci = fromMaybe ci $ do
sss <- ci ^? ciSections
str <- ci ^? ciFilters . ix x . _Just
return $ case str of
(_ : _) ->
@@ -288,7 +285,8 @@ toggleMap u = case u ^. uvWorld . hud . hudElement of
toggleTweakInv :: World -> World
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
Just ExamineInventory{} -> w
Just ExamineInventory{} ->
w
& thepointer .~ NoSubInventory MouseInvNothing Nothing
_ -> w & thepointer .~ ExamineInventory -- mi
where
@@ -296,10 +294,14 @@ toggleTweakInv w = case w ^? hud . hudElement . subInventory of
-- mi = 0 <$ (yourSelectedItem w >>= (^? itTweaks . tweakParams . ix 0))
tryCombine :: SelectionSections CombinableItem -> Maybe (Int, Int) -> World -> World
tryCombine ::
IM.IntMap (SelectionSection CombinableItem) ->
Maybe (Int, Int) ->
World ->
World
tryCombine sss msel w = fromMaybe w $ do
(i, j) <- msel
CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload
CombinableItem is it _ <- sss ^? ix i . ssItems . ix j . siPayload
return $
snd (createItemYou it (foldr (destroyInvItem 0) w (sort is)))
& cWorld . lWorld . creatures . ix 0 . crHammerPosition .~ HammerDown
@@ -307,5 +309,6 @@ tryCombine sss msel w = fromMaybe w $ do
maybeExitCombine :: Universe -> Universe
maybeExitCombine u
| ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons) = u
| otherwise = u & uvWorld . hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing
| otherwise =
u & uvWorld . hud . hudElement . subInventory
.~ NoSubInventory MouseInvNothing Nothing