diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index 9db7932cd..70c38c2b7 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -1,20 +1,20 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} module Dodge.Data.HUD where -import Dodge.Data.Combine -import Dodge.Data.SelectionList -import Dodge.Data.Button -import Dodge.Data.FloorItem import Control.Lens -import Geometry.Data import Data.IntMap.Strict (IntMap) +import Dodge.Data.Button +import Dodge.Data.Combine +import Dodge.Data.FloorItem +import Dodge.Data.SelectionList +import Geometry.Data data HUDElement - = DisplayInventory + = DisplayInventory { _subInventory :: SubInventory , _diSections :: SelectionSections () } @@ -23,12 +23,13 @@ data HUDElement data SubInventory = NoSubInventory | ExamineInventory {_subInvMSel :: Maybe Int} --- | CombineInventory {_subInvMap :: SelectionIntMap CombinableItem} - | CombineInventory {_ciCombinations :: IntMap (SelectionItem CombinableItem) + | CombineInventory + { _ciCombinations :: IntMap (SelectionItem CombinableItem) , _ciSections :: SelectionSections CombinableItem } | LockedInventory | DisplayTerminal {_termID :: Int} + -- deriving (Eq, Ord, Show, Read) --Generic, Flat) data HUD = HUD @@ -38,6 +39,7 @@ data HUD = HUD , _carteRot :: Float , _closeObjects :: [Either FloorItem Button] } + -- deriving (Eq, Ord, Show, Read) --Generic, Flat) makeLenses ''HUD diff --git a/src/Dodge/ListDisplayParams.hs b/src/Dodge/ListDisplayParams.hs index 567c48186..5a60bf301 100644 --- a/src/Dodge/ListDisplayParams.hs +++ b/src/Dodge/ListDisplayParams.hs @@ -33,21 +33,20 @@ invDisplayParams w = & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w) & ldpPos . spPixelOff .~ V2 6 (-1) where - selcursortype - | isexaminesub || ButtonRight `M.member` _mouseButtons (_input w) = [North, South, East, West] - | otherwise = [North, South, West] - isexaminesub = case w ^? hud . hudElement . subInventory of - Just ExamineInventory{} -> True - _ -> False + selcursortype = case w ^? hud . hudElement . subInventory of + _ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West] + Just ExamineInventory{} -> [North, South, East, West] + Just CombineInventory{} -> [] + _ -> [North, South, West] secondColumnParams :: ListDisplayParams secondColumnParams = defaultListDisplayParams - & ldpPos . spPixelOff .~ V2 subInvX (-71) + & ldpPos . spPixelOff .~ V2 subInvX (-81) & ldpCursorSides .~ [North, South, West] subInvX :: Float -subInvX = 10 * fromIntegral topInvW + 50 +subInvX = 10 * fromIntegral topInvW + 70 topInvW :: Int topInvW = 15 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index f4214ac68..28e13e4e9 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -3,7 +3,6 @@ module Dodge.Render.HUD ( drawHUD, ) where -import Dodge.Item.Display import Control.Lens import Control.Monad import qualified Data.Map.Strict as M @@ -20,6 +19,7 @@ import Dodge.Data.World import Dodge.Default.SelectionList import Dodge.Equipment.Text import Dodge.Inventory +import Dodge.Item.Display import Dodge.Item.Info import Dodge.ListDisplayParams import Dodge.Render.Connectors @@ -74,14 +74,14 @@ drawCombineInventory cfig sss w = drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture drawExamineInventory cfig mtweaki w = invHead cfig "EXAMINE" - <> examineInventoryExtra mtweaki itm cfig + <> examineInventoryExtra mtweaki cfig <> drawSelectionList secondColumnParams cfig - ( defaultSelectionList & slItems .~ ammoTweakSelectionItems itm + ( defaultSelectionList & slItems .~ tweakItems itm ++ map f - ( makeParagraph 60 $ + ( makeParagraph 55 $ yourAugmentedItem itemInfo (yourInfo (you w)) @@ -127,8 +127,8 @@ drawRBOptions cfig w = fromMaybe mempty $ do ae <- w ^? rbOptions . opAllocateEquipment sss <- w ^? hud . hudElement . diSections (i', j) <- sss ^? sssExtra . sssSelPos . _Just - curpos <- selSecSelPos i' j sss - let ytext = drawListElement 0 1 curpos . text + curpos <- selSecYint i' j sss + let ytext = drawListElement 0 1 0 curpos . text midstr = case ae of DoNotMoveEquipment -> "" PutOnEquipment{} -> " PUT ON" @@ -143,62 +143,71 @@ drawRBOptions cfig w = fromMaybe mempty $ do "REMOVES " ++ otheritem rid _ -> "" return $ - toTopLeft cfig - $ translate 290 (-1) (ytext midstr) - <> translate 160 (-1) (listCursorChooseBorderScale 0 1 [North,South] curpos 0 white 21 1) - <> translate 380 (-1) (drawListYoff (curpos - i) (map (text . eqPosText) es)) - <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length es)) - <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length es - (i+1))) - <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i) - <> translate 380 (-1) (maybetopborder i curpos) - <> translate 380 (-1) (maybebottomborder i (length es) curpos) - <> translate 460 (-1) (ytext extrastr) + toTopLeft cfig $ + translate 290 (-1) (ytext midstr) + <> translate 160 (-1) (listCursorChooseBorderScale 0 1 [North, South] curpos 0 white 21 1) + <> translate + 380 + (-1) + ( drawListYoff (curpos - i) (map (text . eqPosText) es) + <> listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length es) + <> listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length es - (i + 1)) + <> listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i + <> maybetopborder i curpos + <> maybebottomborder i (length es) curpos + ) + <> translate 460 (-1) (ytext extrastr) where - maybetopborder 0 curpos= listCursorChooseBorderScale 0 1 [North] curpos 0 white 7 1 + maybetopborder 0 curpos = listCursorChooseBorderScale 0 1 [North] curpos 0 white 7 1 maybetopborder _ _ = mempty - maybebottomborder a b curpos - | a == b - 1 - = listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1 + maybebottomborder a b curpos + | a == b - 1 = + listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1 | otherwise = mempty otheritem j = fromMaybe "" $ do itm <- you w ^? crInv . ix j return $ itemBaseName itm -examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture -examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do +examineInventoryExtra :: Maybe Int -> Configuration -> Picture +examineInventoryExtra mtweaki cfig = fromMaybe mempty $ do tweaki <- mtweaki -- consider moving this functionality out into a tweaks module - tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki + --tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki return $ toTopLeft cfig $ - translate subInvX (-60) $ - listCursorNSW tweaki 0 white (length $ showTweak tparam) 15 + translate subInvX (-71) $ + --listCursorChooseBorderScale 0 1 [North,South,West] tweaki 0 white (length $ showTweak tparam) 1 + listCursorChooseBorderScale 0 1 [North, South, West] tweaki 0 white 10 1 combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture combineInventoryExtra sss cfig w = fromMaybe mempty $ do (i, j) <- sss ^? sssExtra . sssSelPos . _Just + cpos <- selSecYint i j sss si <- sss ^? sssSections . ix i . ssItems . ix j - cpos <- selSecSelPos i j sss let col = _siColor si return $ mconcat [ fromMaybe mempty $ do strs <- si ^? siPayload . ciInfo - return $ toTopLeft cfig (translate (subInvX + 150) 60 $ drawListYoff cpos $ map (color red . text) strs) + return + . translate 160 0 + -- it would be better to get the width of the selection list from elsewhere + . translateScreenPos cfig (secondColumnParams ^. ldpPos) + $ drawListYoff cpos $ map (color red . text) strs , fromMaybe mempty $ do lnks <- si ^? siPayload . ciInvIDs return $ - lnkMidPosInvSelsCol cfig w cpos col lnks + lnkMidPosInvSelsCol cfig w j col lnks <> foldMap invcursor lnks <> combineCounts cfig w lnks ] where invcursor i = fromMaybe mempty $ do sss' <- w ^? hud . hudElement . diSections - let idp = invDisplayParams w + let idp = (invDisplayParams w & ldpCursorSides .~ [North, South, East, West]) return $ translateScreenPos cfig (idp ^. ldpPos) $ - selSecDrawCursor 17 [North, South, East] idp sss' 0 i + selSecDrawCursor 17 idp (sss' & sssExtra . sssSelPos ?~ (0, i)) displayTerminal :: Int -> Configuration -> LWorld -> Picture displayTerminal tid cfig w = fromMaybe mempty $ do @@ -231,9 +240,16 @@ combineCounts cfig w = foldMap f . group f (i : is) = fromMaybe mempty $ do _ <- yourInv w ^? ix i . itUse . useAmount sss <- w ^? hud . hudElement . diSections - p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i + --p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i col <- selSecSelCol 0 i sss - return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1)) + yint <- selSecYint 0 i sss + --return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1)) + return + . translateScreenPos cfig (invDisplayParams w ^. ldpPos) + . color col + . drawListElement 0 1 15 yint + . text + $ ('-' : show (length is + 1)) f _ = mempty lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture @@ -241,15 +257,14 @@ lnkMidPosInvSelsCol cfig w i col = foldMap f where f j = fromMaybe mempty $ do sss <- w ^? hud . hudElement . diSections - h <- selNumEndMidHeight cfig (invDisplayParams w) sss 0 j + combinesss <- w ^? hud . hudElement . subInventory . ciSections + lp <- selNumPos cfig (invDisplayParams w) sss 0 j + rp <- selNumPos cfig secondColumnParams combinesss 0 i invcol <- selSecSelCol 0 j sss - return $ zConnectCol rp (V2 18 0 + h) col white white invcol - rp = V2 (190 - hw) (hh - (20 * fromIntegral i + 77.5)) - hh = halfHeight cfig - hw = halfWidth cfig + return $ zConnectCol (rp - V2 5 0) (lp + V2 175 0) col white white invcol -ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()] -ammoTweakSelectionItems = textSelItems . ammoTweakStrings +tweakItems :: Maybe Item -> [SelectionItem ()] +tweakItems = textSelItems . ammoTweakStrings ammoTweakStrings :: Maybe Item -> [String] ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of @@ -261,7 +276,7 @@ tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp invHead :: Configuration -> String -> Picture invHead cfig = - translateScreenPos cfig (fromTopLeft (V2 subInvX 80)) + translateScreenPos cfig (fromTopLeft (V2 (subInvX - 5) 80)) . dShadCol white . scale 0.4 0.4 . textJustifyLeft @@ -323,34 +338,22 @@ picsToSelectable pics = , _siPayload = () } --- there are still more ListDisplayParams to integrate here -selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2 -selNumTextEndPos cfig ldp sss i j = do - ipos <- selSecSelPos i j sss - return $ V2 (150 - hw) (hh - ((s * 10 + ygap) * (fromIntegral ipos + 1))) - where - s = _ldpScale ldp - ygap = _ldpVerticalGap ldp - hh = halfHeight cfig - hw = halfWidth cfig - -selNumEndMidHeight :: +selNumPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2 -selNumEndMidHeight cfig ldp sss i j = do - ipos <- selSecSelPos i j sss +selNumPos cfig ldp sss i j = do + ipos <- selSecYint i j sss size <- selSecSelSize i j sss - --let bump = negate $ (10 * s + ygap) * fromIntegral size - return $ V2 (150 - hw) (hh - ((10 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5))) + return $ + screenPosAbs cfig (ldp ^. ldpPos) + + V2 0 (negate (20 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5)) where s = _ldpScale ldp ygap = _ldpVerticalGap ldp - hh = halfHeight cfig - hw = halfWidth cfig selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor diff --git a/src/Dodge/Render/InfoBox.hs b/src/Dodge/Render/InfoBox.hs index 6b01756d1..af30362dc 100644 --- a/src/Dodge/Render/InfoBox.hs +++ b/src/Dodge/Render/InfoBox.hs @@ -3,6 +3,7 @@ module Dodge.Render.InfoBox , renderInfoListsAt ) where +import Dodge.Data.CardinalPoint -- this should be imported implicitly import Dodge.Base import Dodge.Data.Camera import Dodge.Data.Config @@ -15,7 +16,7 @@ renderInfoListAt :: Float -> Float -> Configuration -> Camera -> (Point2, [Strin renderInfoListAt x y cfig cam (p, ss) = toTopLeft cfig (renderListAt x y (zip ss (repeat white))) <> color white (lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p)) - <> toTopLeft cfig (translate x (-y) $ listCursorNSW 0 0 white 19 (length ss)) + <> toTopLeft cfig (translate x (-y) $ listCursorChooseBorderScale 0 1 [North,South] 0 0 white 19 (length ss)) where hw = halfWidth cfig hh = halfHeight cfig diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 517d9da8f..eadff0548 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -1,6 +1,5 @@ module Dodge.Render.List ( renderListAt, - listCursorNSW, drawList, drawSelectionList, listPicturesYgapScaleYoff, @@ -10,15 +9,15 @@ module Dodge.Render.List ( drawListYoff, stackPicturesAt, toTopLeft, - listCursorChooseBorderScale , + listCursorChooseBorderScale, ) where -import Dodge.ScreenPos import Data.Maybe import Dodge.Base.Window import Dodge.Data.CardinalPoint import Dodge.Data.Config import Dodge.Data.SelectionList +import Dodge.ScreenPos import Dodge.SelectionList import Dodge.SelectionSections import Geometry @@ -30,39 +29,13 @@ drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Pi drawSelectionList ldps cfig sl = translateScreenPos cfig - (ldps ^. ldpPos) $ - listPicturesYgapScaleYoff - (_ldpVerticalGap ldps) - (_ldpScale ldps) - 0 - (makeSelectionListPictures sl) - <> drawSelectionCursor sl ldps - -makeSelectionListPictures :: SelectionList a -> [Picture] -makeSelectionListPictures = concatMap f . getShownItems - where - f si = map (color (_siColor si) . text) $ _siPictures si - -drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> Picture -drawCursorAt mi lis ldps = fromMaybe mempty $ do - i <- mi - selit <- lis !? i - let j = sum . map _siHeight $ take i lis - col = _siColor selit - return $ - listCursorChooseBorderScale + (ldps ^. ldpPos) + $ listPicturesYgapScaleYoff (_ldpVerticalGap ldps) (_ldpScale ldps) - (ldps ^. ldpCursorSides) - j - (_siOffX selit) - col - wdth - (_siHeight selit) - where - wdth = case _ldpWidth ldps of - FixedSelectionWidth x -> x - _ -> 1 + 0 + (makeSelectionListPictures sl) + <> drawSelectionCursor sl ldps drawSelectionCursor :: SelectionList a -> ListDisplayParams -> Picture drawSelectionCursor sl = drawCursorAt (f $ sl ^. slSelPos) (getShownItems sl) @@ -73,43 +46,61 @@ drawSelectionCursor sl = drawCursorAt (f $ sl ^. slSelPos) (getShownItems sl) "" | not (sl ^. slRegexInput) -> id _ -> fmap (+ 1) +makeSelectionListPictures :: SelectionList a -> [Picture] +makeSelectionListPictures = concatMap f . getShownItems + where + f si = map (color (_siColor si) . text) $ _siPictures si + +drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> Picture +drawCursorAt mi lis ldps = fromMaybe mempty $ do + i <- mi + selit <- lis !? i + return $ + listCursorChooseBorderScale + (_ldpVerticalGap ldps) + (_ldpScale ldps) + (ldps ^. ldpCursorSides) + (sum . map _siHeight $ take i lis) + (_siOffX selit) + (_siColor selit) + (getLDPWidth ldps) + (_siHeight selit) + +getLDPWidth :: ListDisplayParams -> Int +getLDPWidth ldps = case _ldpWidth ldps of + FixedSelectionWidth x -> x + _ -> 1 + drawListYoff :: Int -> [Picture] -> Picture drawListYoff = listPicturesYgapScaleYoff 0 1 listPicturesYgapScaleYoff :: Float -> Float -> Int -> [Picture] -> Picture -listPicturesYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s) [i ..] +listPicturesYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s 0) [i ..] stackPicturesAt :: [Picture] -> Picture stackPicturesAt = stackPicturesAtOff 0 stackPicturesAtOff :: Int -> [Picture] -> Picture -stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1) [i, i -1 ..] +stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..] -selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture -selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do - yint <- selSecSelPos i j sss +selSecDrawCursor :: Int -> ListDisplayParams -> SelectionSections a -> Picture +selSecDrawCursor xsize ldp sss = fromMaybe mempty $ do + (i, j) <- sss ^? sssExtra . sssSelPos . _Just + yint <- selSecYint i j sss xint <- sss ^? sssSections . ix i . ssIndent si <- sss ^? sssSections . ix i . ssItems . ix j - return $ listCursorDisplayParams ldp borders yint xint (_siColor si) xsize (length $ _siPictures si) - -listCursorDisplayParams :: - ListDisplayParams -> - [CardinalPoint] -> - Int -> - Int -> - Color -> - Int -> - Int -> - Picture -listCursorDisplayParams ldp borders a b c d = - listCursorChooseBorderScale ygap s borders a b c d - where - ygap = _ldpVerticalGap ldp - s = _ldpScale ldp + return $ + listCursorChooseBorderScale + (ldp ^. ldpVerticalGap) + (ldp ^. ldpScale) + (ldp ^. ldpCursorSides) + yint + xint + (_siColor si) + xsize + (length $ _siPictures si) -- displays a cursor that should match up to list text pictures --- the width of a character appears to be 9(?!) --- this is probably because it is 8 pixels plus one for the border listCursorChooseBorderScale :: Float -> Float -> @@ -130,11 +121,6 @@ listCursorChooseBorderScale ygap s borders yint xint col cursxsize cursysize = wth = 10 * (fromIntegral cursxsize + 1) hgt = 20 * fromIntegral cursysize + ygap * (fromIntegral cursysize - 1) --- displays a cursor that should match up to list text pictures -listCursorChooseBorder :: - [CardinalPoint] -> Int -> Int -> Color -> Int -> Int -> Picture -listCursorChooseBorder = listCursorChooseBorderScale 10 1 - -- note we cannot simply scale lines because they are drawn as solid rectangles chooseCursorBorders :: Float -> Float -> [CardinalPoint] -> Picture chooseCursorBorders w h = foldMap (line . toLine) @@ -145,9 +131,6 @@ chooseCursorBorders w h = foldMap (line . toLine) toLine South = [V2 w h', V2 0 h'] toLine West = [V2 0 h', V2 0 0] -listCursorNSW :: Int -> Int -> Color -> Int -> Int -> Picture -listCursorNSW a b c d = listCursorChooseBorder [North, South, West] a b c d - --fillScreenText :: Configuration -> String -> Picture --fillScreenText cfig str = -- scale wscale hscale @@ -168,9 +151,9 @@ listCursorNSW a b c d = listCursorChooseBorder [North, South, West] a b c d -- thescale = hw * 0.02 / fromIntegral (length str) -- hw = halfWidth cfig -drawListElement :: Float -> Float -> Int -> Picture -> Picture -drawListElement ygap s yint = - translate 0 (negate ((s * 20 + ygap) * (fromIntegral yint + 1))) +drawListElement :: Float -> Float -> Int -> Int -> Picture -> Picture +drawListElement ygap s xint yint = + translate (s * 10 * fromIntegral xint) (negate ((s * 20 + ygap) * (fromIntegral yint + 1))) . scale (s * 0.1) (s * 0.1) renderListAt :: Float -> Float -> [(String, Color)] -> Picture diff --git a/src/Dodge/ScreenPos.hs b/src/Dodge/ScreenPos.hs index 92e930268..40e4a6d2e 100644 --- a/src/Dodge/ScreenPos.hs +++ b/src/Dodge/ScreenPos.hs @@ -10,11 +10,10 @@ fromTopLeft :: Point2 -> ScreenPos fromTopLeft (V2 x y) = ScreenPos (V2 (-0.5) 0.5) (V2 x (- y)) translateScreenPos :: Configuration -> ScreenPos -> Picture -> Picture -translateScreenPos cfig sp = translate x y - where - V2 x y = sp ^. spScreenOff * V2 w h + sp ^. spPixelOff - w = fromIntegral $ cfig ^. windowX - h = fromIntegral $ cfig ^. windowY +translateScreenPos cfig = uncurryV translate . screenPosAbs cfig screenPosAbs :: Configuration -> ScreenPos -> Point2 -screenPosAbs = undefined +screenPosAbs cfig sp = sp ^. spScreenOff * V2 w h + sp ^. spPixelOff + where + w = fromIntegral $ cfig ^. windowX + h = fromIntegral $ cfig ^. windowY diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index f7736df28..f1424ab7d 100644 --- a/src/Dodge/SelectionList.hs +++ b/src/Dodge/SelectionList.hs @@ -1,4 +1,7 @@ -module Dodge.SelectionList where +module Dodge.SelectionList ( + getShownItems, + getAvailableListLines, +) where import Color import Data.Maybe diff --git a/src/Dodge/SelectionSections.hs b/src/Dodge/SelectionSections.hs index 05eb25f6e..1cb9e0f04 100644 --- a/src/Dodge/SelectionSections.hs +++ b/src/Dodge/SelectionSections.hs @@ -4,7 +4,7 @@ module Dodge.SelectionSections ( ssLookupGT, ssSetCursor, setFirstPosSelectionSections, - selSecSelPos, + selSecYint, selSecSelSize, ) where @@ -124,8 +124,8 @@ ssLookupGE' i sss = do selSecSelSize :: Int -> Int -> SelectionSections a -> Maybe Int selSecSelSize i j sss = fmap length $ sss ^? sssSections . ix i . ssItems . ix j . siPictures -selSecSelPos :: Int -> Int -> SelectionSections a -> Maybe Int -selSecSelPos i j sss = do +selSecYint :: Int -> Int -> SelectionSections a -> Maybe Int +selSecYint i j sss = do ss <- sss ^? sssSections . ix i return . (secpos +) . subtract (ss ^. ssOffset) diff --git a/src/Dodge/SelectionSections/Draw.hs b/src/Dodge/SelectionSections/Draw.hs index 82ad498d8..d2549d481 100644 --- a/src/Dodge/SelectionSections/Draw.hs +++ b/src/Dodge/SelectionSections/Draw.hs @@ -1,25 +1,20 @@ module Dodge.SelectionSections.Draw where -import Dodge.ScreenPos import Control.Lens -import Data.Maybe -import Dodge.Data.CardinalPoint import Dodge.Data.Config import Dodge.Data.SelectionList import Dodge.Render.List +import Dodge.ScreenPos import Picture.Base drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture -drawSelectionSections sss ldps cfig = - translateScreenPos cfig (ldps ^. ldpPos) $ +drawSelectionSections sss ldp cfig = + translateScreenPos cfig (ldp ^. ldpPos) $ listPicturesYgapScaleYoff - (_ldpVerticalGap ldps) - (_ldpScale ldps) + (_ldpVerticalGap ldp) + (_ldpScale ldp) 0 pics - <> thecursor' + <> selSecDrawCursor 15 ldp sss where - thecursor' = fromMaybe mempty $ do - (i, j) <- sss ^? sssExtra . sssSelPos . _Just - return $ selSecDrawCursor 15 [North, South, West] ldps sss i j pics = foldMap _ssShownItems (_sssSections sss)