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

Refactor window size, update selection cursor on new screen

Browse Source
This commit is contained in:
justin
2023-03-25 09:27:27 +00:00
parent 20c05be23f
commit ea0c942887
57 changed files with 346 additions and 310 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/List.hs
+16 -19
View File
@@ -1,19 +1,20 @@
module Dodge.Render.List where
--import Picture.Text
import Dodge.Inventory
--import Data.Foldable
import Dodge.SelectionList
import Data.Maybe
import Dodge.Base.WinScale
import Dodge.Base.Window
import Dodge.Data.CardinalPoint
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.Inventory
import Dodge.SelectionList
import Geometry
import LensHelp
import ListHelp
import Picture
import LensHelp
drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
drawSelectionList ldps cfig sl =
@@ -31,7 +32,8 @@ makeSelectionListPictures :: SelectionList a -> [Picture]
makeSelectionListPictures sl = concatMap f $ getShownItems sl
where
f si = map (color (_siColor si) . text) $ _siPictures si
--f si = map (textGrad (_siColor si) (withAlpha 0 (_siColor si))) $ _siPictures si
--f si = map (textGrad (_siColor si) (withAlpha 0 (_siColor si))) $ _siPictures si
drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture
drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
@@ -55,7 +57,7 @@ drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) (
f = case sl ^. slRegex of
_ | sl ^. slRegexInput -> const (Just 0)
"" | not (sl ^. slRegexInput) -> id
_ -> fmap (+1)
_ -> fmap (+ 1)
-- given a list of pictures that are each the size of a "text" call, displays them as
-- a list on the screen
@@ -81,7 +83,7 @@ selSecDrawCursor xsize borders cfig ldp sss i j = fromMaybe mempty $ do
si <- sss ^? sssSections . ix i . ssItems . ix j
return $ listCursorDisplayParams ldp borders cfig yint xint (_siColor si) xsize (length $ _siPictures si)
listCursorDisplayParams ::
listCursorDisplayParams ::
ListDisplayParams ->
[CardinalPoint] ->
Configuration ->
@@ -116,10 +118,9 @@ listCursorChooseBorderScale ::
Int ->
Picture
listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize =
winScale cfig
. translate
(15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig)
(halfHeight cfig + s * 12.5 - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
translate
(15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig)
(halfHeight cfig + s * 12.5 - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
. color col
$ chooseCursorBorders (s * wth) (s * hgt) borders
where
@@ -160,8 +161,7 @@ listCursorNSW = listCursorChooseBorder [North, South, West]
fillScreenText :: Configuration -> String -> Picture
fillScreenText cfig str =
winScale cfig
. scale wscale hscale
scale wscale hscale
. centerText
$ str
where
@@ -172,8 +172,7 @@ fillScreenText cfig str =
fillWidthText :: Configuration -> String -> Picture
fillWidthText cfig str =
winScale cfig
. scale thescale thescale
scale thescale thescale
. centerText
$ str
where
@@ -182,8 +181,7 @@ fillWidthText cfig str =
listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture
listTextPictureAt xoff yoff cfig yint =
winScale cfig
. translate (xoff + 15 - hw) (negate yoff + hh - (20 * (fromIntegral yint + 1)))
translate (xoff + 15 - hw) (negate yoff + hh - (20 * (fromIntegral yint + 1)))
. scale 0.1 0.1
where
hw = halfWidth cfig
@@ -191,8 +189,7 @@ listTextPictureAt xoff yoff cfig yint =
listTextPictureAtScale :: Float -> Float -> Float -> Float -> Configuration -> Int -> Picture -> Picture
listTextPictureAtScale ygap s xoff yoff cfig yint =
winScale cfig
. translate (xoff + 15 - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1)))
translate (xoff + 15 - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1)))
. scale (s * 0.1) (s * 0.1)
where
hw = halfWidth cfig