From 865706df3b1251816edba1244c1436dfadd704bf Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 5 May 2023 10:22:46 +0100 Subject: [PATCH] List rendering work --- src/Dodge/Debug/Picture.hs | 2 +- src/Dodge/Render/HUD.hs | 14 ++--- src/Dodge/Render/InfoBox.hs | 4 +- src/Dodge/Render/List.hs | 83 +++++++++++++++-------------- src/Dodge/Render/Picture.hs | 7 ++- src/Dodge/Render/ShapePicture.hs | 2 +- src/Dodge/SelectionSections/Draw.hs | 6 +-- 7 files changed, 60 insertions(+), 58 deletions(-) diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index 7e2529e98..03b6ab2a6 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 (listPicturesAt (0.5 * halfWidth cfig) 0 cfig $ map text ts) + <> setLayer FixedCoordLayer (toTopLeft cfig (listPicturesAt (0.5 * halfWidth cfig) 0 $ map text ts)) | otherwise = mempty where pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 4f1c4223a..6db1914e1 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -119,10 +119,10 @@ 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 = listTextPictureAtScale 10 1 252 0 cfig curpos (text str) - let extratext str = listTextPictureAtScale 10 1 432 0 cfig curpos (text (str ++ deactivatetext)) + let midtext str = toTopLeft cfig $ listTextPictureAtScale 10 1 252 0 curpos (text str) + let extratext str = toTopLeft cfig $ listTextPictureAtScale 10 1 432 0 curpos (text (str ++ deactivatetext)) return $ - listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es) + toTopLeft cfig (listPicturesAtOff 342 0 (curpos - i) (map (text . eqPosText) es)) <> case ae of DoNotMoveEquipment -> mempty PutOnEquipment{} -> @@ -146,7 +146,7 @@ examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do tweaki <- mtweaki -- consider moving this functionality out into a tweaks module tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki - return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15 + return $ toTopLeft cfig $ listCursorNSW subInvX 60 tweaki 0 white (length $ showTweak tparam) 15 combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture combineInventoryExtra sss cfig w = fromMaybe mempty $ do @@ -158,7 +158,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do mconcat [ fromMaybe mempty $ do strs <- si ^? siPayload . ciInfo - return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs + return $ toTopLeft cfig (listPicturesAtOff (subInvX + 150) 60 cpos $ map (color red . text) strs) , fromMaybe mempty $ do lnks <- si ^? siPayload . ciInvIDs return $ @@ -169,7 +169,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do where invcursor i = fromMaybe mempty $ do sss' <- w ^? hud . hudElement . diSections - return $ selSecDrawCursor 17 [North, South, East] cfig (invDisplayParams w) sss' 0 i + return $ toTopLeft cfig $ selSecDrawCursor 17 [North, South, East] (invDisplayParams w) sss' 0 i displayTerminal :: Int -> Configuration -> LWorld -> Picture displayTerminal tid cfig w = fromMaybe mempty $ do @@ -240,7 +240,7 @@ invHead cfig = drawCarte :: Configuration -> World -> Picture drawCarte cfig w = pictures $ - renderListAt 0 0 cfig locs : + toTopLeft cfig (renderListAt 0 0 locs) : mapOverlay w ++ [mainListCursor white iPos cfig] where diff --git a/src/Dodge/Render/InfoBox.hs b/src/Dodge/Render/InfoBox.hs index e529f7230..5115e009c 100644 --- a/src/Dodge/Render/InfoBox.hs +++ b/src/Dodge/Render/InfoBox.hs @@ -13,9 +13,9 @@ import Picture renderInfoListAt :: Float -> Float -> Configuration -> Camera -> (Point2, [String]) -> Picture renderInfoListAt x y cfig cam (p, ss) = - renderListAt x y cfig (zip ss (repeat white)) + toTopLeft cfig (renderListAt x y (zip ss (repeat white))) <> color white (lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p)) - <> listCursorNSW x y cfig 0 0 white 19 (length ss) + <> toTopLeft cfig (listCursorNSW x y 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 162fcf9b4..0c40d2562 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -9,6 +9,7 @@ module Dodge.Render.List ( dShadCol, listPicturesAtOff, stackPicturesAt, + toTopLeft, ) where import Data.Maybe @@ -25,23 +26,23 @@ import Picture drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture drawSelectionList ldps cfig sl = - listPicturesAtScaleOff + toTopLeft cfig (listPicturesAtScaleOff (_ldpVerticalGap ldps) (_ldpScale ldps) (_ldpPosX ldps) (_ldpPosY ldps) - cfig 0 --(_slOffset sl) (makeSelectionListPictures sl) - <> drawSelectionCursor ldps cfig sl + <> drawSelectionCursor ldps sl + ) makeSelectionListPictures :: SelectionList a -> [Picture] -makeSelectionListPictures sl = concatMap f $ getShownItems sl +makeSelectionListPictures = concatMap f . getShownItems where f si = map (color (_siColor si) . text) $ _siPictures si -drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture -drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do +drawCursorAt :: ListDisplayParams -> Maybe Int -> [SelectionItem a] -> Picture +drawCursorAt ldps mi lis = fromMaybe mempty $ do i <- mi selit <- lis !? i f <- case _ldpCursorType ldps of @@ -49,14 +50,14 @@ drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do NoCursor -> Nothing let j = sum . map _siHeight $ take i lis col = _siColor selit - return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j 0 col wdth (_siHeight selit) + return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) j 0 col wdth (_siHeight selit) where wdth = case _ldpWidth ldps of FixedSelectionWidth x -> x _ -> 1 -drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture -drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) (getShownItems sl) +drawSelectionCursor :: ListDisplayParams -> SelectionList a -> Picture +drawSelectionCursor ldps sl = drawCursorAt ldps (f $ sl ^. slSelPos) (getShownItems sl) where -- the following is quite hacky f = case sl ^. slRegex of @@ -64,36 +65,31 @@ drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) ( "" | not (sl ^. slRegexInput) -> id _ -> fmap (+ 1) --- given a list of pictures that are each the size of a "text" call, displays them as --- a list on the screen -listPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture -listPicturesAt tx ty cfig = listPicturesAtScaleOff 10 1 tx ty cfig 0 -listPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture -listPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty cfig) [i ..] +listPicturesAtOff :: Float -> Float -> Int -> [Picture] -> Picture +listPicturesAtOff tx ty i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty) [i ..] -listPicturesAtScaleOff :: Float -> Float -> Float -> Float -> Configuration -> Int -> [Picture] -> Picture -listPicturesAtScaleOff ygap s tx ty cfig i = +listPicturesAtScaleOff :: Float -> Float -> Float -> Float -> Int -> [Picture] -> Picture +listPicturesAtScaleOff ygap s tx ty i = mconcat - . zipWith (listTextPictureAtScale ygap s tx ty cfig) [i ..] + . zipWith (listTextPictureAtScale ygap s tx ty) [i ..] -stackPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture -stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0 +stackPicturesAt :: Float -> Float -> [Picture] -> Picture +stackPicturesAt tx ty = stackPicturesAtOff tx ty 0 -stackPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture -stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty cfig) [i, i -1 ..] +stackPicturesAtOff :: Float -> Float -> Int -> [Picture] -> Picture +stackPicturesAtOff tx ty i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty) [i, i -1 ..] -selSecDrawCursor :: Int -> [CardinalPoint] -> Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture -selSecDrawCursor xsize borders cfig ldp sss i j = fromMaybe mempty $ do +selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture +selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do yint <- selSecSelPos i j sss xint <- sss ^? sssSections . ix i . ssIndent si <- sss ^? sssSections . ix i . ssItems . ix j - return $ listCursorDisplayParams ldp borders cfig yint xint (_siColor si) xsize (length $ _siPictures si) + return $ listCursorDisplayParams ldp borders yint xint (_siColor si) xsize (length $ _siPictures si) listCursorDisplayParams :: ListDisplayParams -> [CardinalPoint] -> - Configuration -> Int -> Int -> Color -> @@ -117,18 +113,17 @@ listCursorChooseBorderScale :: [CardinalPoint] -> Float -> Float -> - Configuration -> Int -> Int -> Color -> Int -> Int -> Picture -listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize = +listCursorChooseBorderScale ygap s borders xoff yoff yint xint col cursxsize cursysize = translate --(15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig) - (xoff + (10 * s * (fromIntegral xint -1)) - halfWidth cfig) - (halfHeight cfig - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1))) + (xoff + (10 * s * (fromIntegral xint -1))) + ( - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1))) . color col $ chooseCursorBorders (s * wth) (s * hgt) borders where @@ -138,7 +133,7 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsiz -- displays a cursor that should match up to list text pictures listCursorChooseBorder :: - [CardinalPoint] -> Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture + [CardinalPoint] -> Float -> Float -> Int -> Int -> Color -> Int -> Int -> Picture listCursorChooseBorder = listCursorChooseBorderScale 10 1 -- note we cannot simply scale lines because they are drawn as solid rectangles @@ -150,7 +145,7 @@ chooseCursorBorders w h = foldMap (line . toLine) toLine South = [V2 w 0, V2 0 0] toLine West = [V2 0 0, V2 0 h] -listCursorNSW :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture +listCursorNSW :: Float -> Float -> Int -> Int -> Color -> Int -> Int -> Picture listCursorNSW = listCursorChooseBorder [North, South, West] --fillScreenText :: Configuration -> String -> Picture @@ -173,16 +168,18 @@ listCursorNSW = listCursorChooseBorder [North, South, West] -- thescale = hw * 0.02 / fromIntegral (length str) -- hw = halfWidth cfig -listTextPictureAtScale :: Float -> Float -> Float -> Float -> Configuration -> Int -> Picture -> Picture -listTextPictureAtScale ygap s xoff yoff cfig yint = - translate (xoff - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1))) +listTextPictureAtScale :: Float -> Float -> Float -> Float -> Int -> Picture -> Picture +listTextPictureAtScale ygap s xoff yoff yint = + translate (xoff) (negate yoff - ((s * 10 + ygap) * (fromIntegral yint + 1))) . scale (s * 0.1) (s * 0.1) - where - hw = halfWidth cfig - hh = halfHeight cfig -renderListAt :: Float -> Float -> Configuration -> [(String, Color)] -> Picture -renderListAt tx ty cfig = listPicturesAt tx ty cfig . map (\(str, col) -> color col $ text str) +renderListAt :: Float -> Float -> [(String, Color)] -> Picture +renderListAt tx ty = listPicturesAt tx ty . 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 :: Float -> Float -> [Picture] -> Picture +listPicturesAt tx ty = listPicturesAtScaleOff 10 1 tx ty 0 --TODO put the following functions in an appropriate place @@ -190,3 +187,9 @@ renderListAt tx ty cfig = listPicturesAt tx ty cfig . map (\(str, col) -> color dShadCol :: Color -> Picture -> Picture {-# INLINE dShadCol #-} dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p + +toTopLeft :: Configuration -> Picture -> Picture +toTopLeft cfig = translate (-hw) (hh) + where + hw = halfWidth cfig + hh = halfHeight cfig diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index f5f4f16a2..90f08503e 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 - <> listPicturesAt (halfWidth cfig) 0 cfig (map text (_uvTestString u u)) + <> toTopLeft cfig (listPicturesAt (halfWidth cfig) 0 (map text (_uvTestString u u))) <> displayFrameTicks u where cfig = _uvConfig u @@ -52,9 +52,8 @@ drawMenuOrHUD cfig u = case u ^. uvScreenLayers of drawConcurrentMessage :: Universe -> Picture drawConcurrentMessage u = stackPicturesAt - (halfWidth cfig) - (windowYFloat cfig - 50) - cfig + 0 + (halfHeight cfig - 50) (map (centerText . f) $ u ^.. uvSideEffects . each) where cfig = _uvConfig u diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 99470b37c..101c4b9b2 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -142,7 +142,7 @@ extraPics cfig u = <> debugDraw cfig w <> foldMap (`_debugPic` u) (_uvDebug u) <> setLayer FixedCoordLayer - (listPicturesAt (1.3 * halfWidth cfig) 0 cfig + (toTopLeft cfig . listPicturesAt (1.3 * halfWidth cfig) 0 . 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 4fc239fd0..3d008f176 100644 --- a/src/Dodge/SelectionSections/Draw.hs +++ b/src/Dodge/SelectionSections/Draw.hs @@ -10,17 +10,17 @@ import Dodge.Data.SelectionList drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture drawSelectionSections sss ldps cfig = - listPicturesAtScaleOff + toTopLeft cfig (listPicturesAtScaleOff (_ldpVerticalGap ldps) (_ldpScale ldps) (_ldpPosX ldps) (_ldpPosY ldps) - cfig 0 pics <> thecursor' + ) where thecursor' = fromMaybe mempty $ do (i, j) <- sss ^? sssExtra . sssSelPos . _Just - return $ selSecDrawCursor 15 [North, South, West] cfig ldps sss i j + return $ selSecDrawCursor 15 [North, South, West] ldps sss i j pics = foldMap _ssShownItems (_sssSections sss)