This commit is contained in:
2023-05-10 02:47:22 +01:00
parent 12aa1361eb
commit ab714d63db
5 changed files with 25 additions and 28 deletions
+1 -1
View File
@@ -15,7 +15,7 @@ import Control.Lens
defaultListDisplayParams :: ListDisplayParams
defaultListDisplayParams =
ListDisplayParams
{ _ldpVerticalGap = 10
{ _ldpVerticalGap = 0
, _ldpScale = 1
, _ldpPosX = 0
, _ldpPosY = 0
+1 -1
View File
@@ -17,7 +17,7 @@ optionListDisplayParams =
{ _ldpPosX = 50
, _ldpPosY = 50
, _ldpScale = 2
, _ldpVerticalGap = 30
, _ldpVerticalGap = 0
, _ldpWidth = FixedSelectionWidth 25
, _ldpCursorSides = [North, South, West]
}
+2 -2
View File
@@ -122,7 +122,7 @@ drawRBOptions cfig w = fromMaybe mempty $ do
let midtext str = toTopLeft cfig $ translate 252 0 $ drawListElement 10 1 curpos (text str)
let extratext str = toTopLeft cfig $ translate 432 0 $ drawListElement 10 1 curpos (text (str ++ deactivatetext))
return $
toTopLeft cfig (translate 342 0 $ listPicturesAtOff (curpos - i) (map (text . eqPosText) es))
toTopLeft cfig (translate 342 0 $ drawListYoff (curpos - i) (map (text . eqPosText) es))
<> case ae of
DoNotMoveEquipment -> mempty
PutOnEquipment{} ->
@@ -159,7 +159,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
mconcat
[ fromMaybe mempty $ do
strs <- si ^? siPayload . ciInfo
return $ toTopLeft cfig (translate (subInvX + 150) 60 $ listPicturesAtOff cpos $ map (color red . text) strs)
return $ toTopLeft cfig (translate (subInvX + 150) 60 $ drawListYoff cpos $ map (color red . text) strs)
, fromMaybe mempty $ do
lnks <- si ^? siPayload . ciInvIDs
return $
+20 -23
View File
@@ -3,11 +3,11 @@ module Dodge.Render.List (
listCursorNSW,
drawList,
drawSelectionList,
listPicturesScaleOff,
listPicturesYgapScaleYoff,
drawListElement,
selSecDrawCursor,
dShadCol,
listPicturesAtOff,
drawListYoff,
stackPicturesAt,
toTopLeft,
) where
@@ -28,14 +28,13 @@ drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Pi
drawSelectionList ldps cfig sl =
toTopLeft
cfig
( ( translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $
listPicturesScaleOff
(_ldpVerticalGap ldps)
(_ldpScale ldps)
0
(makeSelectionListPictures sl)
)
<> drawSelectionCursor ldps sl
( translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $
listPicturesYgapScaleYoff
(_ldpVerticalGap ldps)
(_ldpScale ldps)
0
(makeSelectionListPictures sl)
<> drawSelectionCursor sl ldps
)
makeSelectionListPictures :: SelectionList a -> [Picture]
@@ -43,15 +42,13 @@ makeSelectionListPictures = concatMap f . getShownItems
where
f si = map (color (_siColor si) . text) $ _siPictures si
drawCursorAt :: ListDisplayParams -> Maybe Int -> [SelectionItem a] -> Picture
drawCursorAt ldps mi lis = fromMaybe mempty $ do
drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> Picture
drawCursorAt mi lis ldps = fromMaybe mempty $ do
i <- mi
selit <- lis !? i
let j = sum . map _siHeight $ take i lis
col = _siColor selit
return $
translate (_ldpPosX ldps)
(- _ldpPosY ldps) $
listCursorChooseBorderScale
(_ldpVerticalGap ldps)
(_ldpScale ldps)
@@ -66,8 +63,8 @@ drawCursorAt ldps mi lis = fromMaybe mempty $ do
FixedSelectionWidth x -> x
_ -> 1
drawSelectionCursor :: ListDisplayParams -> SelectionList a -> Picture
drawSelectionCursor ldps sl = drawCursorAt ldps (f $ sl ^. slSelPos) (getShownItems sl)
drawSelectionCursor :: SelectionList a -> ListDisplayParams -> Picture
drawSelectionCursor sl = drawCursorAt (f $ sl ^. slSelPos) (getShownItems sl)
where
-- the following is quite hacky
f = case sl ^. slRegex of
@@ -75,11 +72,11 @@ drawSelectionCursor ldps sl = drawCursorAt ldps (f $ sl ^. slSelPos) (getShownIt
"" | not (sl ^. slRegexInput) -> id
_ -> fmap (+ 1)
listPicturesAtOff :: Int -> [Picture] -> Picture
listPicturesAtOff = listPicturesScaleOff 0 1
drawListYoff :: Int -> [Picture] -> Picture
drawListYoff = listPicturesYgapScaleYoff 0 1
listPicturesScaleOff :: Float -> Float -> Int -> [Picture] -> Picture
listPicturesScaleOff ygap s i =
listPicturesYgapScaleYoff :: Float -> Float -> Int -> [Picture] -> Picture
listPicturesYgapScaleYoff ygap s i =
mconcat
. zipWith (drawListElement ygap s) [i ..]
@@ -106,7 +103,7 @@ listCursorDisplayParams ::
Int ->
Picture
listCursorDisplayParams ldp borders a b c d =
translate xoff (-yoff) . listCursorChooseBorderScale ygap s borders a b c d
translate xoff (- yoff) . listCursorChooseBorderScale ygap s borders a b c d
where
ygap = _ldpVerticalGap ldp
s = _ldpScale ldp
@@ -128,7 +125,7 @@ listCursorChooseBorderScale ::
Picture
listCursorChooseBorderScale ygap s borders yint xint col cursxsize cursysize =
translate
( (10 * s * (fromIntegral xint ) - 5 * s))
((10 * s * (fromIntegral xint) - 5 * s))
(- (ygap + (s * 20 + ygap) * (fromIntegral yint) + 1))
. color col
$ chooseCursorBorders (s * wth) (s * hgt) borders
@@ -185,7 +182,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
-- a list on the screen
drawList :: [Picture] -> Picture
drawList = listPicturesScaleOff 0 1 0
drawList = listPicturesYgapScaleYoff 0 1 0
--TODO put the following functions in an appropriate place
+1 -1
View File
@@ -10,7 +10,7 @@ import Dodge.Data.SelectionList
drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture
drawSelectionSections sss ldps cfig =
toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesScaleOff
toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesYgapScaleYoff
(_ldpVerticalGap ldps)
(_ldpScale ldps)
0