justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Work on rendering lists

Browse Source
This commit is contained in:
justin
2023-05-05 09:58:12 +01:00
parent be37de18cb
commit 988bb7591d
2 changed files with 42 additions and 63 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+3 -6
View File
@@ -119,8 +119,8 @@ drawRBOptions cfig w = fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
(i', j) <- sss ^? sssExtra . sssSelPos . _Just (i', j) <- sss ^? sssExtra . sssSelPos . _Just
curpos <- selSecSelPos i' j sss curpos <- selSecSelPos i' j sss
let midtext str = listTextPictureAt 252 0 cfig curpos (text str) let midtext str = listTextPictureAtScale 10 1 252 0 cfig curpos (text str)
let extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext)) let extratext str = listTextPictureAtScale 10 1 432 0 cfig curpos (text (str ++ deactivatetext))
return $ return $
listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es) listPicturesAtOff 342 0 cfig (curpos - i) (map (text . eqPosText) es)
<> case ae of <> case ae of
@@ -241,8 +241,6 @@ drawCarte :: Configuration -> World -> Picture
drawCarte cfig w = drawCarte cfig w =
pictures $ pictures $
renderListAt 0 0 cfig locs : renderListAt 0 0 cfig locs :
-- zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
-- ++
mapOverlay w mapOverlay w
++ [mainListCursor white iPos cfig] ++ [mainListCursor white iPos cfig]
where where
@@ -265,9 +263,8 @@ mapOverlay w =
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) : (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
[foldMap (drawMapWall (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)] [foldMap (drawMapWall (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
where where
--(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
lw = w ^. cWorld . lWorld lw = w ^. cWorld . lWorld
--(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
drawMapWall :: HUD -> Wall -> Picture drawMapWall :: HUD -> Wall -> Picture
drawMapWall thehud wl = color c . polygon $ map (cartePosToScreen thehud) [x, x +.+ n2, y +.+ n2, y] drawMapWall thehud wl = color c . polygon $ map (cartePosToScreen thehud) [x, x +.+ n2, y +.+ n2, y]
src/Dodge/Render/List.hs
+39 -57
View File
@@ -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 Data.Maybe
import Dodge.Base.Window import Dodge.Base.Window
import Dodge.Data.CardinalPoint import Dodge.Data.CardinalPoint
import Dodge.Data.Config import Dodge.Data.Config
import Dodge.Data.SelectionList import Dodge.Data.SelectionList
import Dodge.SelectionList import Dodge.SelectionList
import Dodge.SelectionSections
import Geometry import Geometry
import LensHelp import LensHelp
import ListHelp import ListHelp
@@ -33,8 +40,6 @@ makeSelectionListPictures sl = concatMap f $ getShownItems sl
where where
f si = map (color (_siColor si) . text) $ _siPictures si 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 :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture
drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
i <- mi i <- mi
@@ -65,16 +70,18 @@ listPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
listPicturesAt tx ty cfig = listPicturesAtScaleOff 10 1 tx ty cfig 0 listPicturesAt tx ty cfig = listPicturesAtScaleOff 10 1 tx ty cfig 0
listPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture 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 :: 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 :: Float -> Float -> Configuration -> [Picture] -> Picture
stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0 stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0
stackPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture 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 :: Int -> [CardinalPoint] -> Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
selSecDrawCursor xsize borders cfig ldp sss i j = fromMaybe mempty $ do 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 = listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize =
translate translate
--(15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig) --(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))) (halfHeight cfig - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
. color col . color col
$ chooseCursorBorders (s * wth) (s * hgt) borders $ 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! hgt = 20 * fromIntegral cursysize -- TODO this should be changed!
-- displays a cursor that should match up to list text pictures -- 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 :: listCursorChooseBorder ::
[CardinalPoint] -> Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture [CardinalPoint] -> Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
listCursorChooseBorder = listCursorChooseBorderScale 10 1 listCursorChooseBorder = listCursorChooseBorderScale 10 1
@@ -145,49 +150,32 @@ chooseCursorBorders w h = foldMap (line . toLine)
toLine South = [V2 w 0, V2 0 0] toLine South = [V2 w 0, V2 0 0]
toLine West = [V2 0 0, V2 0 h] 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 :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
listCursorNSW = listCursorChooseBorder [North, South, West] listCursorNSW = listCursorChooseBorder [North, South, West]
fillScreenText :: Configuration -> String -> Picture --fillScreenText :: Configuration -> String -> Picture
fillScreenText cfig str = --fillScreenText cfig str =
scale wscale hscale -- scale wscale hscale
. centerText -- . centerText
$ str -- $ str
where -- where
wscale = hw * 0.02 / fromIntegral (length str) -- wscale = hw * 0.02 / fromIntegral (length str)
hscale = hh * 0.01 -- hscale = hh * 0.01
hw = halfWidth cfig -- hw = halfWidth cfig
hh = halfHeight cfig -- hh = halfHeight cfig
fillWidthText :: Configuration -> String -> Picture --fillWidthText :: Configuration -> String -> Picture
fillWidthText cfig str = --fillWidthText cfig str =
scale thescale thescale -- scale thescale thescale
. centerText -- . centerText
$ str -- $ str
where -- where
thescale = hw * 0.02 / fromIntegral (length str) -- thescale = hw * 0.02 / fromIntegral (length str)
hw = halfWidth cfig -- 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
listTextPictureAtScale :: Float -> Float -> Float -> Float -> Configuration -> Int -> Picture -> Picture listTextPictureAtScale :: Float -> Float -> Float -> Float -> Configuration -> Int -> Picture -> Picture
listTextPictureAtScale ygap s xoff yoff cfig yint = 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) . scale (s * 0.1) (s * 0.1)
where where
hw = halfWidth cfig hw = halfWidth cfig
@@ -196,15 +184,9 @@ listTextPictureAtScale ygap s xoff yoff cfig yint =
renderListAt :: Float -> Float -> Configuration -> [(String, Color)] -> Picture renderListAt :: Float -> Float -> Configuration -> [(String, Color)] -> Picture
renderListAt tx ty cfig = listPicturesAt tx ty cfig . map (\(str, col) -> color col $ text str) 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 --TODO put the following functions in an appropriate place
-- | Colour picture and add black drop shadow. -- | Colour picture and add black drop shadow.
dShadCol :: Color -> Picture -> Picture dShadCol :: Color -> Picture -> Picture
{-# INLINE dShadCol #-} {-# INLINE dShadCol #-}
dShadCol c p = dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p
pictures
[ color black $ translate 1.2 (-1.2) p
, color c p
]