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

Make parameters for display of list pictures more sensible

Browse Source
This commit is contained in:
justin
2023-05-10 02:25:38 +01:00
parent f569f3f173
commit 12aa1361eb
5 changed files with 29 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/SelectionList.hs
-1
View File
@@ -18,7 +18,6 @@ data ListDisplayParams = ListDisplayParams
, _ldpVerticalGap :: Float , _ldpVerticalGap :: Float
, _ldpCursorSides :: [CardinalPoint] , _ldpCursorSides :: [CardinalPoint]
, _ldpWidth :: SelectionWidth , _ldpWidth :: SelectionWidth
-- , _ldpSizeRestriction :: SelectionSizeRestriction
} }
data SelectionList a = SelectionList data SelectionList a = SelectionList
src/Dodge/Render/HUD.hs
+2 -1
View File
@@ -146,7 +146,8 @@ examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
tweaki <- mtweaki tweaki <- mtweaki
-- consider moving this functionality out into a tweaks module -- consider moving this functionality out into a tweaks module
tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
return $ toTopLeft cfig $ listCursorNSW subInvX 60 tweaki 0 white (length $ showTweak tparam) 15 return $ toTopLeft cfig $ translate subInvX (-60)
$ listCursorNSW tweaki 0 white (length $ showTweak tparam) 15
combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
combineInventoryExtra sss cfig w = fromMaybe mempty $ do combineInventoryExtra sss cfig w = fromMaybe mempty $ do
src/Dodge/Render/InfoBox.hs
+1 -1
View File
@@ -15,7 +15,7 @@ renderInfoListAt :: Float -> Float -> Configuration -> Camera -> (Point2, [Strin
renderInfoListAt x y cfig cam (p, ss) = renderInfoListAt x y cfig cam (p, ss) =
toTopLeft cfig (renderListAt x y (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)) <> color white (lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p))
<> toTopLeft cfig (listCursorNSW x y 0 0 white 19 (length ss)) <> toTopLeft cfig (translate x (-y) $ listCursorNSW 0 0 white 19 (length ss))
where where
hw = halfWidth cfig hw = halfWidth cfig
hh = halfHeight cfig hh = halfHeight cfig
src/Dodge/Render/List.hs
+25 -27
View File
@@ -3,7 +3,7 @@ module Dodge.Render.List (
listCursorNSW, listCursorNSW,
drawList, drawList,
drawSelectionList, drawSelectionList,
listPicturesAtScaleOff, listPicturesScaleOff,
drawListElement, drawListElement,
selSecDrawCursor, selSecDrawCursor,
dShadCol, dShadCol,
@@ -29,7 +29,7 @@ drawSelectionList ldps cfig sl =
toTopLeft toTopLeft
cfig cfig
( ( translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ ( ( translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $
listPicturesAtScaleOff listPicturesScaleOff
(_ldpVerticalGap ldps) (_ldpVerticalGap ldps)
(_ldpScale ldps) (_ldpScale ldps)
0 0
@@ -50,14 +50,14 @@ drawCursorAt ldps mi lis = fromMaybe mempty $ do
let j = sum . map _siHeight $ take i lis let j = sum . map _siHeight $ take i lis
col = _siColor selit col = _siColor selit
return $ return $
translate (_ldpPosX ldps)
(- _ldpPosY ldps) $
listCursorChooseBorderScale listCursorChooseBorderScale
(_ldpVerticalGap ldps) (_ldpVerticalGap ldps)
(_ldpScale ldps) (_ldpScale ldps)
(ldps ^. ldpCursorSides) (ldps ^. ldpCursorSides)
(_ldpPosX ldps + (9 * fromIntegral (_siOffX selit)))
(_ldpPosY ldps)
j j
0 (_siOffX selit)
col col
wdth wdth
(_siHeight selit) (_siHeight selit)
@@ -76,10 +76,10 @@ drawSelectionCursor ldps sl = drawCursorAt ldps (f $ sl ^. slSelPos) (getShownIt
_ -> fmap (+ 1) _ -> fmap (+ 1)
listPicturesAtOff :: Int -> [Picture] -> Picture listPicturesAtOff :: Int -> [Picture] -> Picture
listPicturesAtOff = listPicturesAtScaleOff 10 1 listPicturesAtOff = listPicturesScaleOff 0 1
listPicturesAtScaleOff :: Float -> Float -> Int -> [Picture] -> Picture listPicturesScaleOff :: Float -> Float -> Int -> [Picture] -> Picture
listPicturesAtScaleOff ygap s i = listPicturesScaleOff ygap s i =
mconcat mconcat
. zipWith (drawListElement ygap s) [i ..] . zipWith (drawListElement ygap s) [i ..]
@@ -105,8 +105,8 @@ listCursorDisplayParams ::
Int -> Int ->
Int -> Int ->
Picture Picture
listCursorDisplayParams ldp borders = listCursorDisplayParams ldp borders a b c d =
listCursorChooseBorderScale ygap s borders xoff yoff translate xoff (-yoff) . listCursorChooseBorderScale ygap s borders a b c d
where where
ygap = _ldpVerticalGap ldp ygap = _ldpVerticalGap ldp
s = _ldpScale ldp s = _ldpScale ldp
@@ -120,41 +120,39 @@ listCursorChooseBorderScale ::
Float -> Float ->
Float -> Float ->
[CardinalPoint] -> [CardinalPoint] ->
Float ->
Float ->
Int -> Int ->
Int -> Int ->
Color -> Color ->
Int -> Int ->
Int -> Int ->
Picture Picture
listCursorChooseBorderScale ygap s borders xoff yoff yint xint col cursxsize cursysize = listCursorChooseBorderScale ygap s borders yint xint col cursxsize cursysize =
translate translate
(xoff + (10 * s * (fromIntegral xint -1))) ( (10 * s * (fromIntegral xint ) - 5 * s))
(- (yoff + (s * 10 + ygap) * (fromIntegral yint + 1))) (- (ygap + (s * 20 + ygap) * (fromIntegral yint) + 1))
. color col . color col
$ chooseCursorBorders (s * wth) (s * hgt) borders $ chooseCursorBorders (s * wth) (s * hgt) borders
where where
x = 9 wth = 10 * (fromIntegral cursxsize + 1)
wth = x * fromIntegral cursxsize + 10 hgt = 20 * fromIntegral cursysize + ygap * (fromIntegral cursysize - 1)
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
listCursorChooseBorder :: listCursorChooseBorder ::
[CardinalPoint] -> Float -> Float -> Int -> Int -> Color -> Int -> Int -> Picture [CardinalPoint] -> Int -> Int -> Color -> Int -> Int -> Picture
listCursorChooseBorder = listCursorChooseBorderScale 10 1 listCursorChooseBorder = listCursorChooseBorderScale 10 1
-- note we cannot simply scale lines because they are drawn as solid rectangles -- note we cannot simply scale lines because they are drawn as solid rectangles
chooseCursorBorders :: Float -> Float -> [CardinalPoint] -> Picture chooseCursorBorders :: Float -> Float -> [CardinalPoint] -> Picture
chooseCursorBorders w h = foldMap (line . toLine) chooseCursorBorders w h = foldMap (line . toLine)
where where
toLine North = [V2 0 h, V2 w h] h' = negate h
toLine East = [V2 w h, V2 w 0] toLine North = [V2 0 0, V2 w 0]
toLine South = [V2 w 0, V2 0 0] toLine East = [V2 w 0, V2 w h']
toLine West = [V2 0 0, V2 0 h] toLine South = [V2 w h', V2 0 h']
toLine West = [V2 0 h', V2 0 0]
listCursorNSW :: Float -> Float -> Int -> Int -> Color -> Int -> Int -> Picture listCursorNSW :: Int -> Int -> Color -> Int -> Int -> Picture
listCursorNSW = listCursorChooseBorder [North, South, West] listCursorNSW a b c d = listCursorChooseBorder [North, South, West] a b c d
--fillScreenText :: Configuration -> String -> Picture --fillScreenText :: Configuration -> String -> Picture
--fillScreenText cfig str = --fillScreenText cfig str =
@@ -178,7 +176,7 @@ listCursorNSW = listCursorChooseBorder [North, South, West]
drawListElement :: Float -> Float -> Int -> Picture -> Picture drawListElement :: Float -> Float -> Int -> Picture -> Picture
drawListElement ygap s yint = drawListElement ygap s yint =
translate 0 (negate ((s * 10 + ygap) * (fromIntegral yint + 1))) translate 0 (negate ((s * 20 + ygap) * (fromIntegral yint + 1)))
. scale (s * 0.1) (s * 0.1) . scale (s * 0.1) (s * 0.1)
renderListAt :: Float -> Float -> [(String, Color)] -> Picture renderListAt :: Float -> Float -> [(String, Color)] -> Picture
@@ -187,7 +185,7 @@ renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color
-- given a list of pictures that are each the size of a "text" call, displays them as -- given a list of pictures that are each the size of a "text" call, displays them as
-- a list on the screen -- a list on the screen
drawList :: [Picture] -> Picture drawList :: [Picture] -> Picture
drawList = listPicturesAtScaleOff 10 1 0 drawList = listPicturesScaleOff 0 1 0
--TODO put the following functions in an appropriate place --TODO put the following functions in an appropriate place
src/Dodge/SelectionSections/Draw.hs
+1 -1
View File
@@ -10,7 +10,7 @@ import Dodge.Data.SelectionList
drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture
drawSelectionSections sss ldps cfig = drawSelectionSections sss ldps cfig =
toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesAtScaleOff toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesScaleOff
(_ldpVerticalGap ldps) (_ldpVerticalGap ldps)
(_ldpScale ldps) (_ldpScale ldps)
0 0