From 988bb7591ddb25436387be762b1cfda845cc2f72 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 5 May 2023 09:58:12 +0100 Subject: [PATCH] Work on rendering lists --- src/Dodge/Render/HUD.hs | 9 ++-- src/Dodge/Render/List.hs | 96 ++++++++++++++++------------------------ 2 files changed, 42 insertions(+), 63 deletions(-) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 13fc5944b..4f1c4223a 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 = listTextPictureAt 252 0 cfig curpos (text str) - let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext)) + 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)) return $ listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es) <> case ae of @@ -241,8 +241,6 @@ drawCarte :: Configuration -> World -> Picture drawCarte cfig w = pictures $ renderListAt 0 0 cfig locs : - -- zipWith bConnect (displayListEndCoords cfig locTexts) locPoss - -- ++ mapOverlay w ++ [mainListCursor white iPos cfig] where @@ -265,9 +263,8 @@ mapOverlay w = (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) : [foldMap (drawMapWall (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)] where - --(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls) - lw = w ^. cWorld . lWorld + --(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls) drawMapWall :: HUD -> Wall -> Picture drawMapWall thehud wl = color c . polygon $ map (cartePosToScreen thehud) [x, x +.+ n2, y +.+ n2, y] diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 514c61068..162fcf9b4 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -1,16 +1,23 @@ -module Dodge.Render.List where +module Dodge.Render.List ( + renderListAt, + listCursorNSW, + listPicturesAt, + drawSelectionList, + listPicturesAtScaleOff, + listTextPictureAtScale, + selSecDrawCursor, + dShadCol, + listPicturesAtOff, + stackPicturesAt, +) where ---import Picture.Text - ---import Data.Foldable - -import Dodge.SelectionSections import Data.Maybe import Dodge.Base.Window import Dodge.Data.CardinalPoint import Dodge.Data.Config import Dodge.Data.SelectionList import Dodge.SelectionList +import Dodge.SelectionSections import Geometry import LensHelp import ListHelp @@ -33,8 +40,6 @@ makeSelectionListPictures sl = concatMap f $ getShownItems sl where f si = map (color (_siColor si) . text) $ _siPictures si ---f si = map (textGrad (_siColor si) (withAlpha 0 (_siColor si))) $ _siPictures si - drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do i <- mi @@ -65,16 +70,18 @@ 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 (listTextPictureAt tx ty cfig) [i ..] +listPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty cfig) [i ..] listPicturesAtScaleOff :: Float -> Float -> Float -> Float -> Configuration -> Int -> [Picture] -> Picture -listPicturesAtScaleOff ygap s tx ty cfig i = mconcat . zipWith (listTextPictureAtScale ygap s tx ty cfig) [i ..] +listPicturesAtScaleOff ygap s tx ty cfig i = + mconcat + . zipWith (listTextPictureAtScale ygap s tx ty cfig) [i ..] stackPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0 stackPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture -stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i, i -1 ..] +stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty cfig) [i, i -1 ..] selSecDrawCursor :: Int -> [CardinalPoint] -> Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture selSecDrawCursor xsize borders cfig ldp sss i j = fromMaybe mempty $ do @@ -120,7 +127,7 @@ listCursorChooseBorderScale :: listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize = translate --(15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig) - (xoff - halfWidth cfig) + (xoff + (10 * s * (fromIntegral xint -1)) - halfWidth cfig) (halfHeight cfig - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1))) . color col $ chooseCursorBorders (s * wth) (s * hgt) borders @@ -130,8 +137,6 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsiz hgt = 20 * fromIntegral cursysize -- TODO this should be changed! -- 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 listCursorChooseBorder :: [CardinalPoint] -> Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture listCursorChooseBorder = listCursorChooseBorderScale 10 1 @@ -145,49 +150,32 @@ chooseCursorBorders w h = foldMap (line . toLine) toLine South = [V2 w 0, V2 0 0] toLine West = [V2 0 0, V2 0 h] -listCursorNS :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture -listCursorNS = listCursorChooseBorder [North, South] - -listCursorNES :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture -listCursorNES = listCursorChooseBorder [North, South, East] - -listCursorNESW :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture -listCursorNESW = listCursorChooseBorder [North, South, East, West] - listCursorNSW :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture listCursorNSW = listCursorChooseBorder [North, South, West] -fillScreenText :: Configuration -> String -> Picture -fillScreenText cfig str = - scale wscale hscale - . centerText - $ str - where - wscale = hw * 0.02 / fromIntegral (length str) - hscale = hh * 0.01 - hw = halfWidth cfig - hh = halfHeight cfig +--fillScreenText :: Configuration -> String -> Picture +--fillScreenText cfig str = +-- scale wscale hscale +-- . centerText +-- $ str +-- where +-- wscale = hw * 0.02 / fromIntegral (length str) +-- hscale = hh * 0.01 +-- hw = halfWidth cfig +-- hh = halfHeight cfig -fillWidthText :: Configuration -> String -> Picture -fillWidthText cfig str = - scale thescale thescale - . centerText - $ str - where - thescale = hw * 0.02 / fromIntegral (length str) - hw = halfWidth cfig - -listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture -listTextPictureAt xoff yoff cfig yint = - translate (xoff + 15 - hw) (negate yoff + hh - (20 * (fromIntegral yint + 1))) - . scale 0.1 0.1 - where - hw = halfWidth cfig - hh = halfHeight cfig +--fillWidthText :: Configuration -> String -> Picture +--fillWidthText cfig str = +-- scale thescale thescale +-- . centerText +-- $ str +-- where +-- 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 + 15 - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1))) + translate (xoff - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1))) . scale (s * 0.1) (s * 0.1) where hw = halfWidth cfig @@ -196,15 +184,9 @@ listTextPictureAtScale ygap s xoff yoff cfig yint = renderListAt :: Float -> Float -> Configuration -> [(String, Color)] -> Picture renderListAt tx ty cfig = listPicturesAt tx ty cfig . map (\(str, col) -> color col $ text str) --- concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..] - --TODO put the following functions in an appropriate place -- | Colour picture and add black drop shadow. dShadCol :: Color -> Picture -> Picture {-# INLINE dShadCol #-} -dShadCol c p = - pictures - [ color black $ translate 1.2 (-1.2) p - , color c p - ] +dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p