From cd42e29012650694d0430e098c2ba99a7f94d28d Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 10 May 2023 01:44:42 +0100 Subject: [PATCH] Work on cursor for lists --- src/Dodge/Data/SelectionList.hs | 2 +- src/Dodge/Debug/Picture.hs | 2 +- src/Dodge/ListDisplayParams.hs | 6 +-- src/Dodge/Menu.hs | 2 +- src/Dodge/Menu/Option.hs | 2 +- src/Dodge/Render/HUD.hs | 4 +- src/Dodge/Render/List.hs | 57 +++++++++++++++++------------ src/Dodge/Render/MenuScreen.hs | 18 ++++----- src/Dodge/Render/Picture.hs | 2 +- src/Dodge/Render/ShapePicture.hs | 2 +- src/Dodge/SelectionSections/Draw.hs | 1 - 11 files changed, 53 insertions(+), 45 deletions(-) diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index 2671f6b7b..956f13857 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -16,7 +16,7 @@ data ListDisplayParams = ListDisplayParams , _ldpPosY :: Float , _ldpScale :: Float , _ldpVerticalGap :: Float - , _ldpCursorType :: CursorType + , _ldpCursorSides :: [CardinalPoint] , _ldpWidth :: SelectionWidth -- , _ldpSizeRestriction :: SelectionSizeRestriction } diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index d4db71b24..ee15a771b 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -124,7 +124,7 @@ debugDraw :: Configuration -> World -> Picture debugDraw cfig w | Enable_debug `S.member` _debug_booleans cfig = pic - <> setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ listPicturesAt $ map text ts)) + <> setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ drawList $ map text ts)) | otherwise = mempty where pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig) diff --git a/src/Dodge/ListDisplayParams.hs b/src/Dodge/ListDisplayParams.hs index d13827fc0..c46f21993 100644 --- a/src/Dodge/ListDisplayParams.hs +++ b/src/Dodge/ListDisplayParams.hs @@ -19,14 +19,14 @@ defaultListDisplayParams = , _ldpScale = 1 , _ldpPosX = 0 , _ldpPosY = 0 - , _ldpCursorType = NoCursor + , _ldpCursorSides = mempty , _ldpWidth = FixedSelectionWidth 15 } invDisplayParams :: World -> ListDisplayParams invDisplayParams w = defaultListDisplayParams - & ldpCursorType .~ BorderCursor selcursortype + & ldpCursorSides .~ selcursortype & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w) where selcursortype @@ -41,7 +41,7 @@ secondColumnParams = defaultListDisplayParams & ldpPosX .~ subInvX & ldpPosY .~ 60 - & ldpCursorType .~ BorderCursor [North, South, West] + & ldpCursorSides .~ [North, South, West] subInvX :: Float subInvX = 9 * fromIntegral topInvW + 50 diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 99872bb41..0265d79a5 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -28,7 +28,7 @@ import Text.Read splashMenu :: Universe -> ScreenLayer splashMenu u = - initializeOptionMenu "AMNESIS" splashMenuOptions NoPositionedMenuOption u + initializeOptionMenu "GAME TITLE" splashMenuOptions NoPositionedMenuOption u & scOptionFlag .~ SplashOptions splashMenuOptions :: [MenuOption] diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index 4e0509f73..f5152a30a 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -19,7 +19,7 @@ optionListDisplayParams = , _ldpScale = 2 , _ldpVerticalGap = 30 , _ldpWidth = FixedSelectionWidth 25 - , _ldpCursorType = BorderCursor [North, South, West] + , _ldpCursorSides = [North, South, West] } initializeOptionMenu :: String -> [MenuOption] -> PositionedMenuOption -> Universe -> ScreenLayer diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index b58fb4296..a2b63fadc 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -119,8 +119,8 @@ drawRBOptions cfig w = fromMaybe mempty $ do sss <- w ^? hud . hudElement . diSections (i', j) <- sss ^? sssExtra . sssSelPos . _Just curpos <- selSecSelPos i' j sss - let midtext str = toTopLeft cfig $ translate 252 0 $ listTextPictureAtScale 10 1 curpos (text str) - let extratext str = toTopLeft cfig $ translate 432 0 $ listTextPictureAtScale 10 1 curpos (text (str ++ deactivatetext)) + let midtext str = toTopLeft cfig $ translate 252 0 $ drawListElement 10 1 curpos (text str) + let extratext str = toTopLeft cfig $ translate 432 0 $ drawListElement 10 1 curpos (text (str ++ deactivatetext)) return $ toTopLeft cfig (translate 342 0 $ listPicturesAtOff (curpos - i) (map (text . eqPosText) es)) <> case ae of diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 01e75b632..018806463 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -1,10 +1,10 @@ module Dodge.Render.List ( renderListAt, listCursorNSW, - listPicturesAt, + drawList, drawSelectionList, listPicturesAtScaleOff, - listTextPictureAtScale, + drawListElement, selSecDrawCursor, dShadCol, listPicturesAtOff, @@ -26,13 +26,16 @@ import Picture drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture drawSelectionList ldps cfig sl = - toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesAtScaleOff - (_ldpVerticalGap ldps) - (_ldpScale ldps) - 0 - (makeSelectionListPictures sl) - ) - <> drawSelectionCursor ldps sl + toTopLeft + cfig + ( ( translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ + listPicturesAtScaleOff + (_ldpVerticalGap ldps) + (_ldpScale ldps) + 0 + (makeSelectionListPictures sl) + ) + <> drawSelectionCursor ldps sl ) makeSelectionListPictures :: SelectionList a -> [Picture] @@ -44,12 +47,20 @@ drawCursorAt :: ListDisplayParams -> Maybe Int -> [SelectionItem a] -> Picture drawCursorAt ldps mi lis = fromMaybe mempty $ do i <- mi selit <- lis !? i - f <- case _ldpCursorType ldps of - BorderCursor cps -> Just $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) cps - NoCursor -> Nothing let j = sum . map _siHeight $ take i lis col = _siColor selit - return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) j 0 col wdth (_siHeight selit) + return $ + listCursorChooseBorderScale + (_ldpVerticalGap ldps) + (_ldpScale ldps) + (ldps ^. ldpCursorSides) + (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) + (_ldpPosY ldps) + j + 0 + col + wdth + (_siHeight selit) where wdth = case _ldpWidth ldps of FixedSelectionWidth x -> x @@ -65,18 +76,18 @@ drawSelectionCursor ldps sl = drawCursorAt ldps (f $ sl ^. slSelPos) (getShownIt _ -> fmap (+ 1) listPicturesAtOff :: Int -> [Picture] -> Picture -listPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i ..] +listPicturesAtOff = listPicturesAtScaleOff 10 1 listPicturesAtScaleOff :: Float -> Float -> Int -> [Picture] -> Picture listPicturesAtScaleOff ygap s i = mconcat - . zipWith (listTextPictureAtScale ygap s) [i ..] + . zipWith (drawListElement ygap s) [i ..] stackPicturesAt :: [Picture] -> Picture stackPicturesAt = stackPicturesAtOff 0 stackPicturesAtOff :: Int -> [Picture] -> Picture -stackPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i, i -1 ..] +stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1) [i, i -1 ..] selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do @@ -120,7 +131,7 @@ listCursorChooseBorderScale :: listCursorChooseBorderScale ygap s borders xoff yoff yint xint col cursxsize cursysize = translate (xoff + (10 * s * (fromIntegral xint -1))) - ( - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1))) + (- (yoff + (s * 10 + ygap) * (fromIntegral yint + 1))) . color col $ chooseCursorBorders (s * wth) (s * hgt) borders where @@ -165,18 +176,18 @@ listCursorNSW = listCursorChooseBorder [North, South, West] -- thescale = hw * 0.02 / fromIntegral (length str) -- hw = halfWidth cfig -listTextPictureAtScale :: Float -> Float -> Int -> Picture -> Picture -listTextPictureAtScale ygap s yint = +drawListElement :: Float -> Float -> Int -> Picture -> Picture +drawListElement ygap s yint = translate 0 (negate ((s * 10 + ygap) * (fromIntegral yint + 1))) . scale (s * 0.1) (s * 0.1) renderListAt :: Float -> Float -> [(String, Color)] -> Picture -renderListAt tx ty = translate tx (-ty) . listPicturesAt . map (\(str, col) -> color col $ text str) +renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color col $ text str) -- given a list of pictures that are each the size of a "text" call, displays them as -- a list on the screen -listPicturesAt :: [Picture] -> Picture -listPicturesAt = listPicturesAtScaleOff 10 1 0 +drawList :: [Picture] -> Picture +drawList = listPicturesAtScaleOff 10 1 0 --TODO put the following functions in an appropriate place @@ -186,7 +197,7 @@ dShadCol :: Color -> Picture -> Picture dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p toTopLeft :: Configuration -> Picture -> Picture -toTopLeft cfig = translate (-hw) (hh) +toTopLeft cfig = translate (- hw) (hh) where hw = halfWidth cfig hh = halfHeight cfig diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 1006c6da2..ec872a4e8 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -3,10 +3,10 @@ module Dodge.Render.MenuScreen ( drawMenuScreen, ) where -import Dodge.Data.SelectionList -import Dodge.Render.List import Dodge.Base.Window +import Dodge.Data.SelectionList import Dodge.Data.Universe +import Dodge.Render.List import Picture drawMenuScreen :: Configuration -> ScreenLayer -> Picture @@ -15,7 +15,7 @@ drawMenuScreen cfig screen = case screen of drawOptions ldps cfig titf selpos InputScreen inputstr help -> drawInputMenu cfig ('>' : inputstr) help -drawInputMenu :: +drawInputMenu :: Configuration -> -- | Title String -> @@ -23,7 +23,7 @@ drawInputMenu :: String -> Picture drawInputMenu cfig title footer = - pictures + pictures [ darkenBackground cfig , drawTitle cfig title , drawFooterText cfig red footer @@ -38,17 +38,15 @@ drawOptions :: SelectionList a -> Picture drawOptions ldps cfig title sl = - pictures - [ darkenBackground cfig - , drawTitle cfig title - , drawSelectionList ldps cfig sl - ] + darkenBackground cfig + <> drawTitle cfig title + <> drawSelectionList ldps cfig sl darkenBackground :: Configuration -> Picture darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox drawTitle :: Configuration -> String -> Picture -drawTitle cfig = translate (30 - hw) (hh-50) . scale 0.4 0.4 . text +drawTitle cfig = translate (- hw) (hh -80) . scale 0.4 0.4 . text where hh = halfHeight cfig hw = halfWidth cfig diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 251d9e347..b9354241e 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -19,7 +19,7 @@ fixedCoordPictures u = drawMenuOrHUD cfig u <> drawConcurrentMessage u <> customMouseCursor u - <> toTopLeft cfig (translate (halfWidth cfig) 0 $ listPicturesAt (map text (_uvTestString u u))) + <> toTopLeft cfig (translate (halfWidth cfig) 0 $ drawList (map text (_uvTestString u u))) <> displayFrameTicks u where cfig = _uvConfig u diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index b114232c4..be54f1e7b 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -143,7 +143,7 @@ extraPics cfig u = <> foldMap (`_debugPic` u) (_uvDebug u) <> setLayer FixedCoordLayer (toTopLeft cfig . translate (1.3* halfWidth cfig) 0 - . listPicturesAt + . drawList . take 50 . drop (u ^. uvDebugMessageOffset) . map text $ foldMap (`_debugMessage` u) (_uvDebug u)) where diff --git a/src/Dodge/SelectionSections/Draw.hs b/src/Dodge/SelectionSections/Draw.hs index aeecef650..728eff375 100644 --- a/src/Dodge/SelectionSections/Draw.hs +++ b/src/Dodge/SelectionSections/Draw.hs @@ -4,7 +4,6 @@ import Picture.Base import Dodge.Data.CardinalPoint import Control.Lens import Data.Maybe -import Picture.Data import Dodge.Data.Config import Dodge.Render.List import Dodge.Data.SelectionList