98 lines
3.0 KiB
Haskell
98 lines
3.0 KiB
Haskell
{- The menu picture. -}
|
|
module Dodge.Render.MenuScreen
|
|
( menuScreen
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Base.Window
|
|
import Picture
|
|
import Dodge.Menu
|
|
import Padding
|
|
|
|
menuScreen :: Universe -> ScreenLayer -> Picture
|
|
menuScreen w screen = case screen of
|
|
OptionScreen {_scTitle = titf, _scOptions = mos}
|
|
-> drawOptions w (titf w) mos "Use keys to navigate the menu"
|
|
(WaitScreen sf _) -> drawOptions w (sf w) [] ""
|
|
(InputScreen inputstr help) -> drawOptions w inputstr [] help
|
|
(DisplayScreen sd ) -> sd w
|
|
(ColumnsScreen titf pairs) -> drawTwoColumnsScreen (_config 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
|
|
-> String -- ^ Title
|
|
-> [MenuOption] -- ^ Options
|
|
-> String -- ^ Help Text
|
|
-> Picture
|
|
drawOptions u title ops footer = pictures $
|
|
[ darkenBackground cfig
|
|
, drawTitle cfig title
|
|
, drawFooterText cfig red footer
|
|
] ++
|
|
zipWith (\s vpos -> placeString (-hw + 50) vpos 0.2 s)
|
|
(map (menuOptionToString u) ops')
|
|
[hh-100,hh-150 ..]
|
|
where
|
|
ops' = filter notInvisible ops
|
|
notInvisible InvisibleToggle {} = False
|
|
notInvisible _ = True
|
|
hh = halfHeight cfig
|
|
hw = halfWidth cfig
|
|
cfig = _config u
|
|
|
|
darkenBackground :: Configuration -> Picture
|
|
darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox
|
|
|
|
drawTitle :: Configuration -> String -> Picture
|
|
drawTitle cfig = placeString (-hw + 30) (hh - 50) 0.4
|
|
where
|
|
hh = halfHeight cfig
|
|
hw = halfWidth cfig
|
|
|
|
placeString
|
|
:: Float -- | x distance from center
|
|
-> Float -- | y distance from center
|
|
-> Float -- | scale
|
|
-> String
|
|
-> Picture
|
|
placeString x y sc = color white . translate x y . scale sc sc . text
|
|
|
|
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 -> MenuOption -> String
|
|
menuOptionToString w mo = theKeys ++ _moString mo w
|
|
where
|
|
theKeys = case mo of
|
|
Toggle {_moKey = k} -> stc k : ":"
|
|
Toggle2 {_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
|
|
_ -> undefined
|
|
stc = scodeToChar
|