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

Attempt to globally translate drawn lists

Browse Source
This commit is contained in:
justin
2023-05-09 00:58:03 +01:00
parent 865706df3b
commit 93519345de
6 changed files with 30 additions and 33 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 debugDraw cfig w
| Enable_debug `S.member` _debug_booleans cfig = | Enable_debug `S.member` _debug_booleans cfig =
pic pic
<> setLayer FixedCoordLayer (toTopLeft cfig (listPicturesAt (0.5 * halfWidth cfig) 0 $ map text ts)) <> setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ listPicturesAt $ map text ts))
| otherwise = mempty | otherwise = mempty
where where
pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig) pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
src/Dodge/Render/HUD.hs
+4 -4
View File
@@ -119,10 +119,10 @@ 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 = toTopLeft cfig $ listTextPictureAtScale 10 1 252 0 curpos (text str) let midtext str = toTopLeft cfig $ translate 252 0 $ listTextPictureAtScale 10 1 curpos (text str)
let extratext str = toTopLeft cfig $ listTextPictureAtScale 10 1 432 0 curpos (text (str ++ deactivatetext)) let extratext str = toTopLeft cfig $ translate 432 0 $ listTextPictureAtScale 10 1 curpos (text (str ++ deactivatetext))
return $ return $
toTopLeft cfig (listPicturesAtOff 342 0 (curpos - i) (map (text . eqPosText) es)) toTopLeft cfig (translate 342 0 $ listPicturesAtOff (curpos - i) (map (text . eqPosText) es))
<> case ae of <> case ae of
DoNotMoveEquipment -> mempty DoNotMoveEquipment -> mempty
PutOnEquipment{} -> PutOnEquipment{} ->
@@ -158,7 +158,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
mconcat mconcat
[ fromMaybe mempty $ do [ fromMaybe mempty $ do
strs <- si ^? siPayload . ciInfo strs <- si ^? siPayload . ciInfo
return $ toTopLeft cfig (listPicturesAtOff (subInvX + 150) 60 cpos $ map (color red . text) strs) return $ toTopLeft cfig (translate (subInvX + 150) 60 $ listPicturesAtOff cpos $ map (color red . text) strs)
, fromMaybe mempty $ do , fromMaybe mempty $ do
lnks <- si ^? siPayload . ciInvIDs lnks <- si ^? siPayload . ciInvIDs
return $ return $
src/Dodge/Render/List.hs
+18 -21
View File
@@ -26,13 +26,12 @@ import Picture
drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
drawSelectionList ldps cfig sl = drawSelectionList ldps cfig sl =
toTopLeft cfig (listPicturesAtScaleOff toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesAtScaleOff
(_ldpVerticalGap ldps) (_ldpVerticalGap ldps)
(_ldpScale ldps) (_ldpScale ldps)
(_ldpPosX ldps) 0
(_ldpPosY ldps)
0 --(_slOffset sl)
(makeSelectionListPictures sl) (makeSelectionListPictures sl)
)
<> drawSelectionCursor ldps sl <> drawSelectionCursor ldps sl
) )
@@ -65,20 +64,19 @@ drawSelectionCursor ldps sl = drawCursorAt ldps (f $ sl ^. slSelPos) (getShownIt
"" | not (sl ^. slRegexInput) -> id "" | not (sl ^. slRegexInput) -> id
_ -> fmap (+ 1) _ -> fmap (+ 1)
listPicturesAtOff :: Int -> [Picture] -> Picture
listPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i ..]
listPicturesAtOff :: Float -> Float -> Int -> [Picture] -> Picture listPicturesAtScaleOff :: Float -> Float -> Int -> [Picture] -> Picture
listPicturesAtOff tx ty i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty) [i ..] listPicturesAtScaleOff ygap s i =
listPicturesAtScaleOff :: Float -> Float -> Float -> Float -> Int -> [Picture] -> Picture
listPicturesAtScaleOff ygap s tx ty i =
mconcat mconcat
. zipWith (listTextPictureAtScale ygap s tx ty) [i ..] . zipWith (listTextPictureAtScale ygap s) [i ..]
stackPicturesAt :: Float -> Float -> [Picture] -> Picture stackPicturesAt :: [Picture] -> Picture
stackPicturesAt tx ty = stackPicturesAtOff tx ty 0 stackPicturesAt = stackPicturesAtOff 0
stackPicturesAtOff :: Float -> Float -> Int -> [Picture] -> Picture stackPicturesAtOff :: Int -> [Picture] -> Picture
stackPicturesAtOff tx ty i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty) [i, i -1 ..] stackPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i, i -1 ..]
selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do
@@ -121,7 +119,6 @@ listCursorChooseBorderScale ::
Picture Picture
listCursorChooseBorderScale ygap s borders xoff yoff yint xint col cursxsize cursysize = listCursorChooseBorderScale ygap s borders xoff yoff yint xint col cursxsize cursysize =
translate translate
--(15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig)
(xoff + (10 * s * (fromIntegral xint -1))) (xoff + (10 * s * (fromIntegral xint -1)))
( - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1))) ( - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
. color col . color col
@@ -168,18 +165,18 @@ listCursorNSW = listCursorChooseBorder [North, South, West]
-- thescale = hw * 0.02 / fromIntegral (length str) -- thescale = hw * 0.02 / fromIntegral (length str)
-- hw = halfWidth cfig -- hw = halfWidth cfig
listTextPictureAtScale :: Float -> Float -> Float -> Float -> Int -> Picture -> Picture listTextPictureAtScale :: Float -> Float -> Int -> Picture -> Picture
listTextPictureAtScale ygap s xoff yoff yint = listTextPictureAtScale ygap s yint =
translate (xoff) (negate yoff - ((s * 10 + ygap) * (fromIntegral yint + 1))) translate 0 (negate ((s * 10 + 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
renderListAt tx ty = listPicturesAt tx ty . map (\(str, col) -> color col $ text str) renderListAt tx ty = translate tx (-ty) . listPicturesAt . map (\(str, col) -> color col $ text str)
-- 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
listPicturesAt :: Float -> Float -> [Picture] -> Picture listPicturesAt :: [Picture] -> Picture
listPicturesAt tx ty = listPicturesAtScaleOff 10 1 tx ty 0 listPicturesAt = listPicturesAtScaleOff 10 1 0
--TODO put the following functions in an appropriate place --TODO put the following functions in an appropriate place
src/Dodge/Render/Picture.hs
+2 -3
View File
@@ -19,7 +19,7 @@ fixedCoordPictures u =
drawMenuOrHUD cfig u drawMenuOrHUD cfig u
<> drawConcurrentMessage u <> drawConcurrentMessage u
<> customMouseCursor u <> customMouseCursor u
<> toTopLeft cfig (listPicturesAt (halfWidth cfig) 0 (map text (_uvTestString u u))) <> toTopLeft cfig (translate (halfWidth cfig) 0 $ listPicturesAt (map text (_uvTestString u u)))
<> displayFrameTicks u <> displayFrameTicks u
where where
cfig = _uvConfig u cfig = _uvConfig u
@@ -51,9 +51,8 @@ drawMenuOrHUD cfig u = case u ^. uvScreenLayers of
drawConcurrentMessage :: Universe -> Picture drawConcurrentMessage :: Universe -> Picture
drawConcurrentMessage u = drawConcurrentMessage u =
translate 0 (50 - halfHeight cfig) $
stackPicturesAt stackPicturesAt
0
(halfHeight cfig - 50)
(map (centerText . f) $ u ^.. uvSideEffects . each) (map (centerText . f) $ u ^.. uvSideEffects . each)
where where
cfig = _uvConfig u cfig = _uvConfig u
src/Dodge/Render/ShapePicture.hs
+2 -1
View File
@@ -142,7 +142,8 @@ extraPics cfig u =
<> debugDraw cfig w <> debugDraw cfig w
<> foldMap (`_debugPic` u) (_uvDebug u) <> foldMap (`_debugPic` u) (_uvDebug u)
<> setLayer FixedCoordLayer <> setLayer FixedCoordLayer
(toTopLeft cfig . listPicturesAt (1.3 * halfWidth cfig) 0 (toTopLeft cfig . translate (1.3* halfWidth cfig) 0
. listPicturesAt
. take 50 . drop (u ^. uvDebugMessageOffset) . take 50 . drop (u ^. uvDebugMessageOffset)
. map text $ foldMap (`_debugMessage` u) (_uvDebug u)) . map text $ foldMap (`_debugMessage` u) (_uvDebug u))
where where
src/Dodge/SelectionSections/Draw.hs
+3 -3
View File
@@ -1,5 +1,6 @@
module Dodge.SelectionSections.Draw where module Dodge.SelectionSections.Draw where
import Picture.Base
import Dodge.Data.CardinalPoint import Dodge.Data.CardinalPoint
import Control.Lens import Control.Lens
import Data.Maybe import Data.Maybe
@@ -10,13 +11,12 @@ 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 (listPicturesAtScaleOff toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesAtScaleOff
(_ldpVerticalGap ldps) (_ldpVerticalGap ldps)
(_ldpScale ldps) (_ldpScale ldps)
(_ldpPosX ldps)
(_ldpPosY ldps)
0 0
pics pics
)
<> thecursor' <> thecursor'
) )
where where