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

Start to unify selection lists

Browse Source
This commit is contained in:
justin
2022-11-02 09:36:16 +00:00
parent 7d358fde29
commit 7c8958cea7
7 changed files with 122 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/MenuScreen.hs
+15 -13
View File
@@ -3,21 +3,21 @@ module Dodge.Render.MenuScreen (
menuScreen,
) where
import Dodge.ScodeToChar
import qualified Data.Text as T
import Dodge.Base.Window
import Dodge.Data.Universe
import Dodge.ScodeToChar
import Dodge.WindowLayout
import Padding
import Picture
menuScreen :: Universe -> ScreenLayer -> Picture
menuScreen w screen = case screen of
OptionScreen{_scTitle = titf, _scOptions = mos, _scOptionsOffset = off} ->
drawOptions w (titf w) mos off "Use keys to navigate the menu"
-- (WaitScreen sf _) -> drawOptions w (sf w) [] 0 ""
(InputScreen inputstr help) -> drawOptions w ('>' : T.unpack inputstr) [] 0 help
-- (DisplayScreen sd) -> sd w
OptionScreen{_scTitle = titf, _scOptions = mos, _scOptionsOffset = off, _scSelPos = selpos} ->
drawOptions w (titf w) mos off selpos "Use keys to navigate the menu"
-- (WaitScreen sf _) -> drawOptions w (sf w) [] 0 ""
(InputScreen inputstr help) -> drawOptions w ('>' : T.unpack inputstr) [] 0 Nothing help
-- (DisplayScreen sd) -> sd w
(ColumnsScreen titf pairs) -> drawTwoColumnsScreen (_uvConfig w) (titf w) pairs
--displayStringList :: World -> [String] -> Picture
@@ -54,10 +54,12 @@ drawOptions ::
[MenuOption] ->
-- | Options offset
Int ->
-- | Select position
Maybe Int ->
-- | Help Text
String ->
Picture
drawOptions u title ops off footer =
drawOptions u title ops off mselpos footer =
pictures $
[ darkenBackground cfig
, drawTitle cfig title
@@ -77,7 +79,7 @@ drawOptions u title ops off footer =
x | x < length ops -> take (availableMenuLines cfig) (drop off visibleops)
_ -> visibleops
ops'' = case availableMenuLines cfig of
x | x < length ops -> map (menuOptionToString u maxOptionLength) ops' ++ [(white,"SPACE: MORE OPTIONS")]
x | x < length ops -> map (menuOptionToString u maxOptionLength) ops' ++ [(white, "SPACE: MORE OPTIONS")]
_ -> map (menuOptionToString u maxOptionLength) ops'
visibleops = filter notInvisible ops
notInvisible InvisibleToggle{} = False
@@ -118,9 +120,9 @@ placeColorString ::
Float ->
-- | scale
Float ->
(Color,String) ->
(Color, String) ->
Picture
placeColorString x y sc (col,str) = color col . translate x y . scale sc sc . text $ str
placeColorString x y sc (col, str) = color col . translate x y . scale sc sc . text $ str
drawFooterText :: Configuration -> Color -> String -> Picture
drawFooterText cfig col = color col . placeString (- hw + 30) (- hh + 10) 0.1
@@ -128,11 +130,11 @@ drawFooterText cfig col = color col . placeString (- hw + 30) (- hh + 10) 0.1
hh = halfHeight cfig
hw = halfWidth cfig
menuOptionToString :: Universe -> Int -> MenuOption -> (Color,String)
menuOptionToString w padAmount mo = (thecol,theKeys ++ optionText)
menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String)
menuOptionToString w padAmount mo = (thecol, theKeys ++ optionText)
where
thecol = case _moString mo w of
MODBlockedString {} -> greyN 0.5
MODBlockedString{} -> greyN 0.5
_ -> white
optionText = case _moString mo w of
MODStringOption s t -> rightPad padAmount '.' s ++ t