{- The menu picture. -} module Dodge.Render.MenuScreen ( menuScreen ) where import Dodge.Data import Dodge.Base.Window import Picture import Dodge.Menu import Padding menuScreen :: World -> ScreenLayer -> Picture menuScreen w screen = case screen of OptionScreen {_scTitle = titf, _scOptions = mos} -> drawOptions w (titf w) mos (WaitScreen sf _) -> drawOptions w (sf w) [] (InputScreen s) -> drawOptions w ('>':s) [] (TerminalScreen t xs ) -> displayStringList w $ map snd $ filter (( > t) . fst) xs (DisplayScreen sd ) -> sd w (ColumnsScreen title pairs) -> drawTwoColumnsScreen w title 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 :: World -> String -> [(String,String)] -> Picture drawTwoColumnsScreen w title lps = pictures [darkenBackground w ,drawTitle w title ,drawTwoColumns w lps ] drawTwoColumns :: World -> [(String,String)] -> Picture drawTwoColumns w lps = pictures $ zipWith f [hh-100,hh-130..] lps where f y (s1,s2) = translate (50-hw) y $ sc $ rightPad ln '.' s1 ++ s2 sc = scale 0.15 0.15 . color white . text hh = halfHeight w hw = halfWidth w ln = maximum (map (length . fst) lps) + 3 drawOptions :: World -> String -- ^ Title -> [MenuOption] -- ^ Options -> Picture drawOptions w title ops = pictures $ [darkenBackground w ,drawTitle w title] ++ zipWith (\ s vpos -> placeString (-hw + 50) vpos 0.2 s) (map (menuOptionToString w) ops') [hh-100,hh-150 ..] where ops' = filter notInvisible ops notInvisible InvisibleToggle {} = False notInvisible _ = True placeString x y sc t = translate x y $ scale sc sc $ color white $ text t hh = halfHeight w hw = halfWidth w darkenBackground :: World -> Picture darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox drawTitle :: World -> String -> Picture drawTitle w = placeString (-hw + 30) (hh - 50) 0.4 where placeString x y sc t = translate x y $ scale sc sc $ color white $ text t hh = halfHeight w hw = halfWidth w menuOptionToString :: World -> MenuOption -> String menuOptionToString w mo = theKeys ++ _moString mo w where theKeys :: String theKeys = case mo of Toggle {_moKey = k} -> stc k : ":" Toggle2 {_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":" _ -> undefined stc = scodeToChar