From 93519345de27162c172b71e74c4ac69940f73130 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 9 May 2023 00:58:03 +0100 Subject: [PATCH] Attempt to globally translate drawn lists --- src/Dodge/Debug/Picture.hs | 2 +- src/Dodge/Render/HUD.hs | 8 +++--- src/Dodge/Render/List.hs | 39 +++++++++++++---------------- src/Dodge/Render/Picture.hs | 5 ++-- src/Dodge/Render/ShapePicture.hs | 3 ++- src/Dodge/SelectionSections/Draw.hs | 6 ++--- 6 files changed, 30 insertions(+), 33 deletions(-) diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index 03b6ab2a6..d4db71b24 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 (listPicturesAt (0.5 * halfWidth cfig) 0 $ map text ts)) + <> setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ listPicturesAt $ 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 6db1914e1..b58fb4296 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 = toTopLeft cfig $ listTextPictureAtScale 10 1 252 0 curpos (text str) - let extratext str = toTopLeft cfig $ listTextPictureAtScale 10 1 432 0 curpos (text (str ++ deactivatetext)) + 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)) return $ - toTopLeft cfig (listPicturesAtOff 342 0 (curpos - i) (map (text . eqPosText) es)) + toTopLeft cfig (translate 342 0 $ listPicturesAtOff (curpos - i) (map (text . eqPosText) es)) <> case ae of DoNotMoveEquipment -> mempty PutOnEquipment{} -> @@ -158,7 +158,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do mconcat [ fromMaybe mempty $ do strs <- si ^? siPayload . ciInfo - return $ toTopLeft cfig (listPicturesAtOff (subInvX + 150) 60 cpos $ map (color red . text) strs) + return $ toTopLeft cfig (translate (subInvX + 150) 60 $ listPicturesAtOff cpos $ map (color red . text) strs) , fromMaybe mempty $ do lnks <- si ^? siPayload . ciInvIDs return $ diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 0c40d2562..01e75b632 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -26,13 +26,12 @@ import Picture drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture drawSelectionList ldps cfig sl = - toTopLeft cfig (listPicturesAtScaleOff + toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesAtScaleOff (_ldpVerticalGap ldps) (_ldpScale ldps) - (_ldpPosX ldps) - (_ldpPosY ldps) - 0 --(_slOffset sl) + 0 (makeSelectionListPictures sl) + ) <> drawSelectionCursor ldps sl ) @@ -65,20 +64,19 @@ drawSelectionCursor ldps sl = drawCursorAt ldps (f $ sl ^. slSelPos) (getShownIt "" | not (sl ^. slRegexInput) -> id _ -> fmap (+ 1) +listPicturesAtOff :: Int -> [Picture] -> Picture +listPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i ..] -listPicturesAtOff :: Float -> Float -> Int -> [Picture] -> Picture -listPicturesAtOff tx ty i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty) [i ..] - -listPicturesAtScaleOff :: Float -> Float -> Float -> Float -> Int -> [Picture] -> Picture -listPicturesAtScaleOff ygap s tx ty i = +listPicturesAtScaleOff :: Float -> Float -> Int -> [Picture] -> Picture +listPicturesAtScaleOff ygap s i = mconcat - . zipWith (listTextPictureAtScale ygap s tx ty) [i ..] + . zipWith (listTextPictureAtScale ygap s) [i ..] -stackPicturesAt :: Float -> Float -> [Picture] -> Picture -stackPicturesAt tx ty = stackPicturesAtOff tx ty 0 +stackPicturesAt :: [Picture] -> Picture +stackPicturesAt = stackPicturesAtOff 0 -stackPicturesAtOff :: Float -> Float -> Int -> [Picture] -> Picture -stackPicturesAtOff tx ty i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty) [i, i -1 ..] +stackPicturesAtOff :: Int -> [Picture] -> Picture +stackPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i, i -1 ..] selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do @@ -121,7 +119,6 @@ listCursorChooseBorderScale :: Picture 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))) ( - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1))) . color col @@ -168,18 +165,18 @@ listCursorNSW = listCursorChooseBorder [North, South, West] -- thescale = hw * 0.02 / fromIntegral (length str) -- hw = halfWidth cfig -listTextPictureAtScale :: Float -> Float -> Float -> Float -> Int -> Picture -> Picture -listTextPictureAtScale ygap s xoff yoff yint = - translate (xoff) (negate yoff - ((s * 10 + ygap) * (fromIntegral yint + 1))) +listTextPictureAtScale :: Float -> Float -> Int -> Picture -> Picture +listTextPictureAtScale 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 = listPicturesAt tx ty . map (\(str, col) -> color col $ text str) +renderListAt tx ty = translate tx (-ty) . listPicturesAt . 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 +listPicturesAt :: [Picture] -> Picture +listPicturesAt = listPicturesAtScaleOff 10 1 0 --TODO put the following functions in an appropriate place diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 90f08503e..251d9e347 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 (listPicturesAt (halfWidth cfig) 0 (map text (_uvTestString u u))) + <> toTopLeft cfig (translate (halfWidth cfig) 0 $ listPicturesAt (map text (_uvTestString u u))) <> displayFrameTicks u where cfig = _uvConfig u @@ -51,9 +51,8 @@ drawMenuOrHUD cfig u = case u ^. uvScreenLayers of drawConcurrentMessage :: Universe -> Picture drawConcurrentMessage u = + translate 0 (50 - halfHeight cfig) $ stackPicturesAt - 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 101c4b9b2..b114232c4 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -142,7 +142,8 @@ extraPics cfig u = <> debugDraw cfig w <> foldMap (`_debugPic` u) (_uvDebug u) <> setLayer FixedCoordLayer - (toTopLeft cfig . listPicturesAt (1.3 * halfWidth cfig) 0 + (toTopLeft cfig . translate (1.3* halfWidth cfig) 0 + . listPicturesAt . 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 3d008f176..aeecef650 100644 --- a/src/Dodge/SelectionSections/Draw.hs +++ b/src/Dodge/SelectionSections/Draw.hs @@ -1,5 +1,6 @@ module Dodge.SelectionSections.Draw where +import Picture.Base import Dodge.Data.CardinalPoint import Control.Lens import Data.Maybe @@ -10,13 +11,12 @@ import Dodge.Data.SelectionList drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture drawSelectionSections sss ldps cfig = - toTopLeft cfig (listPicturesAtScaleOff + toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesAtScaleOff (_ldpVerticalGap ldps) (_ldpScale ldps) - (_ldpPosX ldps) - (_ldpPosY ldps) 0 pics + ) <> thecursor' ) where