94 lines
2.6 KiB
Haskell
94 lines
2.6 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
|
|
:: 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
|