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

List rendering work

Browse Source
This commit is contained in:
justin
2023-05-05 10:22:46 +01:00
parent 988bb7591d
commit 865706df3b
7 changed files with 60 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Debug/Picture.hs
+1 -1
View File
@@ -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)
src/Dodge/Render/HUD.hs
+7 -7
View File
@@ -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
src/Dodge/Render/InfoBox.hs
+2 -2
View File
@@ -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
src/Dodge/Render/List.hs
+43 -40
View File
@@ -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
src/Dodge/Render/Picture.hs
+3 -4
View File
@@ -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
src/Dodge/Render/ShapePicture.hs
+1 -1
View File
@@ -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
src/Dodge/SelectionSections/Draw.hs
+3 -3
View File
@@ -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)