{- The menu picture. -} module Dodge.Render.MenuScreen ( menuScreen, menuScreen', ) where import Dodge.Data.CardinalPoint import Dodge.Render.List import Dodge.Data.SelectionList import qualified Data.Text as T import Dodge.Base.Window import Dodge.Data.Universe import Dodge.ScodeToChar import Dodge.WindowLayout import Padding import Picture import qualified Data.Set as Set menuScreen' :: Universe -> ScreenLayer -> Picture menuScreen' w screen = case screen of 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 menuScreen :: Universe -> ScreenLayer -> Picture menuScreen w screen = case screen of 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 --displayStringList w ss = pictures -- ( polygon (screenBox w) -- : zipWith f ys ss -- ) -- where -- hw = halfWidth w -- ys = [0,22..] -- f y s = translate (10-hw) y . scale 0.15 0.15 $ text s drawTwoColumnsScreen :: Configuration -> String -> [(String, String)] -> Picture drawTwoColumnsScreen cfig title lps = pictures [ darkenBackground cfig , drawTitle cfig title , drawTwoColumns cfig lps ] drawTwoColumns :: Configuration -> [(String, String)] -> Picture drawTwoColumns cfig lps = pictures $ zipWith f [hh -100, hh -130 ..] lps where f y (s1, s2) = placeString (50 - hw) y 0.15 $ rightPad ln '.' s1 ++ s2 hh = halfHeight cfig hw = halfWidth cfig ln = maximum (map (length . fst) lps) + 3 drawOptions :: Universe -> -- | Title String -> -- | Options [MenuOption] -> -- | Options offset Int -> -- | Select position Maybe Int -> -- | Help Text String -> Picture drawOptions u title ops off mselpos footer = pictures $ [ darkenBackground cfig , drawTitle cfig title , drawFooterText cfig red footer , drawSelectionList cfig (makeOptionsSelectionList mselpos u ops) ] -- ++ zipWith -- (\s vpos -> placeColorString (- hw + 50) vpos 0.2 s) -- ops'' -- [hh -100, hh -150 ..] where -- ++ [color yellow $ concat [line [V2 (negate hw) (hh-y), V2 hw (hh-y)] | -- y <- map (+75) [0,50..hh*2]] -- ] maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops') ops' = case availableMenuLines cfig of 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")] _ -> map (menuOptionToString u maxOptionLength) ops' visibleops = filter notInvisible ops notInvisible InvisibleToggle{} = False notInvisible _ = True hh = halfHeight cfig hw = halfWidth cfig cfig = _uvConfig u defaultSelectionItem :: SelectionItem defaultSelectionItem = SelectionItem { _siPictures = [color white $ text "HELLOW"] , _siHeight = 1 , _siIsSelectable = True , _siColor = white , _siOffX = 0 } makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> SelectionList makeOptionsSelectionList mselpos u mos = SelectionList { _slPosX = 50 , _slPosY = 50 , _slOffset = 0 , _slScale = 2 , _slVerticalGap = 30 , _slItems = optionsToSelections u mos , _slSelPos = mselpos , _slCursorType = BorderCursor (Set.fromList [North,South,West]) , _slWidth = FixedSelectionWidth 15 } colStrToSelItem :: (Color,String) -> SelectionItem colStrToSelItem (col,str) = SelectionItem { _siPictures = [color col $ text str] , _siHeight = 1 , _siIsSelectable = True , _siColor = col , _siOffX = 0 } optionsToSelections :: Universe -> [MenuOption] -> [SelectionItem] optionsToSelections u ops = map colStrToSelItem colstrs where maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) visibleops) colstrs = map (menuOptionToString u maxOptionLength) visibleops visibleops = filter notInvisible ops notInvisible InvisibleToggle{} = False notInvisible _ = True optionValueOffset :: Universe -> MenuOption -> Int optionValueOffset u mo = case _moString mo u of MODStringOption s _ -> length s _ -> 0 darkenBackground :: Configuration -> Picture darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox drawTitle :: Configuration -> String -> Picture drawTitle cfig = placeString (- hw + 30) (hh - 50) 0.4 where hh = halfHeight cfig hw = halfWidth cfig placeString :: -- | x distance from center Float -> -- | y distance from center Float -> -- | scale Float -> String -> Picture placeString x y sc = color white . translate x y . scale sc sc . text placeColorString :: -- | x distance from center Float -> -- | y distance from center Float -> -- | scale Float -> (Color, String) -> Picture 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 where hh = halfHeight cfig hw = halfWidth cfig menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String) menuOptionToString w padAmount mo = (thecol, theKeys ++ optionText) where thecol = case _moString mo w of MODBlockedString{} -> greyN 0.5 _ -> white optionText = case _moString mo w of MODStringOption s t -> rightPad padAmount '.' s ++ t x -> _modString x theKeys = case mo of Toggle{_moKey = k} -> stc k : ":" Toggle2{_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":" _ -> undefined stc = scodeToChar