diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index 1c962bb6e..0b1b7517c 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -18,8 +18,8 @@ data LDParams = LDP -- List display parameters } data CursorDisplay - = BoundaryCursor [CardinalPoint] - | BackdropCursor + = BoundCurs [CardinalPoint] + | BackdropCurs data SectionCursor = SectionCursor { _scurPos :: Int diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index 1cbb0e706..692625db0 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -51,19 +51,13 @@ invSelectionItem w indent loc = -- note the convoluted display of the hotkey/equipment, this was done to avoid a -- space leak itemDisplay :: World -> Creature -> CItem -> [String] -itemDisplay w cr ci = -- f - basicItemDisplay itm --- (itemNumberDisplay w cr ci) - `g` anyextra +itemDisplay w cr ci = basicItemDisplay itm `g` anyextra where itm = ci ^. _1 NInt itid = itm ^. itID - --f (x:xs) (y:_) = itemDisplayPad x y : xs - --f xs _ = xs - --g (x:xs) (y:_) = (rightPad 15 ' ' x ++ y) : xs - g (x:xs) (y:_) = (x ++ y) : xs + g (x:xs) (Just y) = (x <> y) : xs g xs _ = xs - anyextra = maybeToList (anyscroll <> anyexternal <> anyhotkey <> anyequippos) + anyextra = anyscroll <> anyexternal <> anyhotkey <> anyequippos anyhotkey = fmap hotkeyToString (w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid) anyequippos = do diff --git a/src/Dodge/ListDisplayParams.hs b/src/Dodge/ListDisplayParams.hs index 8cded8701..faf533445 100644 --- a/src/Dodge/ListDisplayParams.hs +++ b/src/Dodge/ListDisplayParams.hs @@ -17,7 +17,8 @@ import Linear import SDL (MouseButton (..)) defaultLDP :: LDParams -defaultLDP = LDP +defaultLDP = + LDP { _ldpVerticalGap = 0 , _ldpScale = 1 , _ldpPos = @@ -32,10 +33,13 @@ invDP :: LDParams invDP = defaultLDP & ldpPos . spPixelOff .~ V2 16 (-20) invCursorParams :: World -> CursorDisplay -invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of --- Just ExamineInventory{} -> [North, South, East, West] +invCursorParams w = BoundCurs $ case w ^? hud . subInventory of + -- Just ExamineInventory{} -> [North, South, East, West] Just CombineInventory{} -> [] - _ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West] + _ + | ButtonRight `M.member` _mouseButtons (_input w) + && (null $ w ^? rbState . opSel) -> + [North, South, East, West] _ -> [North, South, West] secondColumnLDP :: LDParams diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 4e5c35003..f782a13d7 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -79,8 +79,8 @@ drawInventory sss w cfig = \case Just (_ : _) -> Nothing _ -> return . drawItemConnections sss cfig $ invAdj inv -drawRootCursor - :: World -> IMSS () -> Maybe Selection -> LDParams -> Config -> Picture +drawRootCursor :: + World -> IMSS () -> Maybe Selection -> LDParams -> Config -> Picture drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do cr <- w ^? cWorld . lWorld . creatures . ix 0 guard $ crIsAiming cr @@ -90,13 +90,17 @@ drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv' (x, y) <- getRootItemBounds j $ _unNIntMap inv + let curs = + if null (w ^? rbState . opSel) + then BoundCurs [minBound ..] + else BoundCurs [North, South, West] return $ drawSSMultiCursor sss (Just (0, x)) (Just (y - x)) ldp - (BoundaryCursor [minBound ..]) + curs cfig getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int) @@ -125,7 +129,7 @@ drawMouseOver cfig w = -- . color white $ selSecDrawCursor invDP curs sss (Sel j i mempty) -- curs = BoundaryCursor [West] - curs = BackdropCursor + curs = BackdropCurs combinvsel = do (j, i) <- (w ^? input . mouseContext . mcoCombSelect) @@ -148,7 +152,7 @@ drawDragSelected cfig w = do ) Sel i _ _ <- w ^? hud . diSelection . _Just sss <- w ^? hud . diSections - let f x = (selSecDrawCursor invDP BackdropCursor sss (Sel i x mempty) <>) + let f x = (selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty) <>) return . translateScreenPos cfig (invDP ^. ldpPos) . color (0.2 *^ white) @@ -159,7 +163,7 @@ drawDragSelecting :: Config -> World -> Maybe Picture drawDragSelecting cfig w = do OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext sss <- w ^? hud . diSections - let f x = selSecDrawCursor invDP BackdropCursor sss (Sel i x mempty) + let f x = selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty) return . translateScreenPos cfig (invDP ^. ldpPos) . color (0.2 *^ white) @@ -189,7 +193,7 @@ drawCombineInventory cfig sss w = <> foldMap (drawSSCursor sss secondColumnLDP curs cfig) msel <> combineInventoryExtra sss msel cfig w where - curs = BoundaryCursor [North, South, West] + curs = BoundCurs [North, South, West] msel = w ^? hud . subInventory . ciSelection . _Just drawExamineInventory :: Config -> World -> Picture @@ -259,49 +263,51 @@ drawRBOptions cfig w = fold $ do sss <- w ^? hud . diSections Sel i' j _ <- w ^? hud . diSelection . _Just curpos <- selSecYint i' j sss + itext <- sss ^? ix i' . ssItems . ix j . siPictures . ix 0 + ind <- sss ^? ix i' . ssItems . ix j . siOffX let ytext = drawListElement 0 1 0 curpos . text midstr = equipAllocString ae extrastr = case ae of SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} -> - "SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp + " SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp ReplaceEquipment{_allocRemoveID = rid} -> - "REMOVES " ++ otheritem rid + " REMOVES " ++ otheritem rid _ -> "" - return $ - --toTopLeft cfig $ - translateScreenPos cfig (invDP ^. ldpPos) $ - --translate 290 (-1) (ytext midstr) - translate 290 0 (ytext midstr) - <> translate - 160 + return + . translateScreenPos cfig (invDP ^. ldpPos) + . translate (10 * fromIntegral (ind + length itext)) 0 + $ translate (290 - xt) 0 (ytext midstr) + <> translate + (120 - xt) + 0 + ( listCursor 0 - ( listCursorChooseBorderScale - 0 - 1 - (BoundaryCursor [North, South]) - curpos - 0 - white - 21 - 1 - ) - <> translate - 380 + 1 + (BoundCurs [North, South]) + curpos 0 - ( drawListYoff (curpos - i) (map (text . eqPosText) eslist) - <> listCursorChooseBorderScale 0 1 (bc East) (curpos - i) 0 white 7 (length eslist) - <> listCursorChooseBorderScale 0 1 (bc West) (curpos + 1) 0 white 7 (length eslist - (i + 1)) - <> listCursorChooseBorderScale 0 1 (bc West) (curpos - i) 0 white 7 i - <> maybetopborder i curpos - <> maybebottomborder i (length eslist) curpos - ) - <> translate 460 0 (ytext extrastr) + white + 25 + 1 + ) + <> translate + (380 - xt) + 0 + ( drawListYoff (curpos - i) (map (text . eqPosText) eslist) + <> listCursor 0 1 (bc East) (curpos - i) 0 white 7 (length eslist) + <> listCursor 0 1 (bc West) (curpos + 1) 0 white 7 (length eslist - (i + 1)) + <> listCursor 0 1 (bc West) (curpos - i) 0 white 7 i + <> maybetopborder i curpos + <> maybebottomborder i (length eslist) curpos + ) + <> translate (460 - xt) 0 (ytext extrastr) where - bc x = BoundaryCursor [x] - maybetopborder 0 curpos = listCursorChooseBorderScale 0 1 (bc North) curpos 0 white 7 1 + xt = 260 + bc x = BoundCurs [x] + maybetopborder 0 curpos = listCursor 0 1 (bc North) curpos 0 white 7 1 maybetopborder _ _ = mempty maybebottomborder a b curpos - | a == b - 1 = listCursorChooseBorderScale 0 1 (bc South) curpos 0 white 7 1 + | a == b - 1 = listCursor 0 1 (bc South) curpos 0 white 7 1 | otherwise = mempty otheritem (NInt j) = fromMaybe "" $ do itype <- w ^? cWorld . lWorld . items . ix j . itType @@ -344,7 +350,7 @@ combineInventoryExtra sss msel cfig w = fold $ do translateScreenPos cfig (invDP ^. ldpPos) $ selSecDrawCursor invDP - (BoundaryCursor [North, South, East, West]) + (BoundCurs [North, South, East, West]) (w ^. hud . diSections) (Sel 0 i mempty) @@ -353,7 +359,7 @@ drawTerminalDisplay w cfig tid = fold $ do tm <- w ^? cWorld . lWorld . terminals . ix tid let toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing NoSIDisplayMod f = - --toselitm ("TERMINAL " ++ show tid, white) + -- toselitm ("TERMINAL " ++ show tid, white) toselitm ("", white) : ( map (toselitm . (_1 %~ (" " <>))) . displayTermInput @@ -395,7 +401,7 @@ drawTerminalCursorLink w cfig tm = fold $ do (invDP ^. ldpPos) ( selSecDrawCursor invDP - (BoundaryCursor [North, South, East, West]) + (BoundCurs [North, South, East, West]) (w ^. hud . diSections) (Sel 5 j mempty) ) diff --git a/src/Dodge/Render/InfoBox.hs b/src/Dodge/Render/InfoBox.hs index 9c03d0d77..d82ccfcc3 100644 --- a/src/Dodge/Render/InfoBox.hs +++ b/src/Dodge/Render/InfoBox.hs @@ -28,10 +28,10 @@ renderInfoListAt x y cfig cam (p, ss) = <> toTopLeft cfig ( translate x (- y) $ - listCursorChooseBorderScale + listCursor 0 1 - (BoundaryCursor [North, South]) + (BoundCurs [North, South]) 0 0 white diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 149f7e1d6..af32b0017 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -10,7 +10,7 @@ module Dodge.Render.List ( drawListYoff, stackPicturesAt, toTopLeft, - listCursorChooseBorderScale, + listCursor, selSecDrawCursor, drawTitleBackground, -- should be renamed, made sensible drawCursorAt, @@ -76,7 +76,7 @@ drawCursorAt mi lis ldps width curs = fromMaybe mempty $ do i <- mi selit <- lis !? i return $ - listCursorChooseBorderScale + listCursor (_ldpVerticalGap ldps) (_ldpScale ldps) curs @@ -106,7 +106,7 @@ selSecDrawCursor ldp curs sss sel = fold $ do sindent <- sss ^? ix i . ssIndent si <- sss ^? ix i . ssItems . ix j return $ - listCursorChooseBorderScale + listCursor (ldp ^. ldpVerticalGap) (ldp ^. ldpScale) curs @@ -117,7 +117,7 @@ selSecDrawCursor ldp curs sss sel = fold $ do (_siHeight si) -- displays a cursor that should match up to list text pictures -listCursorChooseBorderScale :: +listCursor :: Float -> Float -> CursorDisplay -> @@ -127,7 +127,7 @@ listCursorChooseBorderScale :: Int -> Int -> Picture -listCursorChooseBorderScale ygap s curs yint xint col cursxsize cursysize = +listCursor ygap s curs yint xint col cursxsize cursysize = translate ((10 * fromIntegral xint - 5) * s) (-(ygap + (s * 20 + ygap) * fromIntegral yint)) @@ -140,8 +140,8 @@ listCursorChooseBorderScale ygap s curs yint xint col cursxsize cursysize = -- note we cannot simply scale lines because they are drawn as solid rectangles chooseCursorBorders :: Float -> Float -> CursorDisplay -> Picture chooseCursorBorders w h = \case - BoundaryCursor ps -> foldMap (line . toLine) ps - BackdropCursor -> polygon $ rectNSWE 0 h' 0 w + BoundCurs ps -> foldMap (line . toLine) ps + BackdropCurs -> polygon $ rectNSWE 0 h' 0 w where h' = negate h toLine North = [V2 0 0, V2 w 0] diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 26596c2a9..2cf13eba6 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -41,7 +41,7 @@ drawOptions title msel sl cf = <> translateScreenPos cf (menuLDP ^. ldpPos) - (drawCursorAt msel sl menuLDP 50 (BoundaryCursor [North, South])) + (drawCursorAt msel sl menuLDP 50 (BoundCurs [North, South])) darkenBackground :: Config -> Picture darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox diff --git a/src/Dodge/SelectionSections.hs b/src/Dodge/SelectionSections.hs index 970cb1295..e240d399f 100644 --- a/src/Dodge/SelectionSections.hs +++ b/src/Dodge/SelectionSections.hs @@ -10,17 +10,17 @@ module Dodge.SelectionSections ( inverseSelNumPos, ) where -import Dodge.Data.HUD -import Dodge.Data.CardinalPoint -import qualified Data.IntSet as IS 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 qualified Data.IntSet as IS import Data.Maybe +import Dodge.Data.CardinalPoint import Dodge.Data.Config +import Dodge.Data.HUD import Dodge.Data.SelectionList import Dodge.ScreenPos import Geometry.Data @@ -86,14 +86,14 @@ ssLookupDown i j sss = case ssLookupGT i j sss of ssLookupNextMax :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a) ssLookupNextMax i j sss = case ssLookupGT i j sss of - Just x@(i',j',_) | i' == i && j' > j -> Just x + Just x@(i', j', _) | i' == i && j' > j -> Just x _ -> ssLookupMaxInSection i sss <|> ssLookupDown i j sss ssLookupMaxInSection :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a) ssLookupMaxInSection i sss = do ss <- sss ^? ix i . ssItems - (j,s) <- IM.lookupMax ss - return (i,j,s) + (j, s) <- IM.lookupMax ss + return (i, j, s) ssLookupLT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a) ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do @@ -152,7 +152,8 @@ posSelSecYint cfig ldp y = floor $ (y0 - y) / (20 / ldp ^. ldpScale + ldp ^. ldp selSecYint :: Int -> Int -> IMSS a -> Maybe Int selSecYint i j sss = do ss <- sss ^? ix i - return . (secpos +) + return + . (secpos +) . subtract (ss ^. ssOffset) . sum . fmap _siHeight @@ -162,7 +163,7 @@ selSecYint i j sss = do secpos = sum . fmap _ssShownLength . fst $ IM.split i sss inverseSelSecYint :: Int -> IMSS a -> XInfinity (Int, Int) -inverseSelSecYint yint sss +inverseSelSecYint yint sss | yint < 0 = NegInf | otherwise = fromMaybe PosInf $ do ((i, ss), othersss) <- IM.minViewWithKey sss @@ -171,19 +172,19 @@ inverseSelSecYint yint sss then return $ inverseSelSecYint (yint - l) othersss else do let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss) - (j,_) <- L.fold (L.find (\(_,x) -> x - _ssOffset ss > yint)) $ IM.toList ls + (j, _) <- L.fold (L.find (\(_, x) -> x - _ssOffset ss > yint)) $ IM.toList ls return $ NonInf (i, j) -inverseSelSecYintXPosCheck :: - Config -> LDParams -> Float -> Int -> IMSS a -> Maybe (Int,Int) +inverseSelSecYintXPosCheck :: + Config -> LDParams -> Float -> Int -> IMSS a -> Maybe (Int, Int) inverseSelSecYintXPosCheck cfig ldp x yint sss = do - (i,j) <- inverseSelSecYint yint sss ^? nonInf + (i, j) <- inverseSelSecYint yint sss ^? nonInf let V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos) sindent <- sss ^? ix i . ssIndent itindent <- sss ^? ix i . ssItems . ix j . siOffX let x1 = x0 + _ldpScale ldp * 10 * (fromIntegral (sindent + itindent) - 0.5) guard $ x - x1 < 160 && x > x1 - return (i,j) + return (i, j) inverseSelNumPos :: Config -> LDParams -> Point2 -> IMSS a -> Maybe (Int, Int) inverseSelNumPos cfig ldp (V2 x y) = diff --git a/src/Dodge/SelectionSections/Draw.hs b/src/Dodge/SelectionSections/Draw.hs index 5c3dfcbd2..d009febb8 100644 --- a/src/Dodge/SelectionSections/Draw.hs +++ b/src/Dodge/SelectionSections/Draw.hs @@ -55,7 +55,7 @@ drawSSMultiCursor sss msel mextra ldp curs cfig = translateScreenPos cfig (ldp ^ maxxoff = maximum . fmap _siOffX $ selitms minxoff = minimum . fmap _siOffX $ selitms return $ - listCursorChooseBorderScale + listCursor (ldp ^. ldpVerticalGap) (ldp ^. ldpScale) curs