124 lines
4.1 KiB
Haskell
124 lines
4.1 KiB
Haskell
{-
|
|
The menu picture.
|
|
-}
|
|
module Dodge.Render.MenuScreen
|
|
( menuScreen
|
|
)
|
|
where
|
|
import Dodge.Data.Menu
|
|
import Dodge.Data
|
|
--import Dodge.Config.Update
|
|
import Dodge.Config.Data
|
|
--import Dodge.Base (halfWidth,halfHeight)
|
|
import Picture
|
|
import Geometry
|
|
import Dodge.Menu
|
|
--import Geometry.Data
|
|
|
|
menuScreen
|
|
:: World
|
|
-> Configuration
|
|
-> Float -- Half width of screen
|
|
-> Float -- Half height of screen
|
|
-> [MenuLayer]
|
|
-> Picture
|
|
menuScreen w cfig hw hh mLays = case mLays of
|
|
(LevelMenu x:_) -> optionsFromList w hw hh ("LEVEL"++show x) levelMenuOptions
|
|
(PauseMenu : _) -> optionsFromList w hw hh "PAUSED" pauseMenuOptions
|
|
(GameOverMenu : _) -> optionsFromList w hw hh "GAME OVER" pauseMenuOptions
|
|
(OptionMenu : _) -> optionsFromList w hw hh "OPTIONS" optionsOptions
|
|
(SoundOptionMenu : _) -> optionsFromList w hw hh "OPTIONS:VOLUME" soundMenuOptions
|
|
(GraphicsOptionMenu : _) -> optionsFromList w hw hh "OPTIONS:GRAPHICS" graphicsMenuOptions
|
|
(ControlList : _) -> pictures
|
|
[color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
|
,tst (-100) 100 0.4 "CONTROLS"
|
|
,controlsList
|
|
]
|
|
(WaitMessage s _ : _) -> optionsList hw hh s []
|
|
(Terminal s : _) -> optionsList hw hh "SCANCODE INPUT" ['>':s ++ "_"]
|
|
(TerminalMessage t xs : _) -> displayStringList hw hh $ map snd $ filter (( > t) . fst) xs
|
|
_ -> blank
|
|
where
|
|
tst x y sc t = translate x y $ scale sc sc $ color white $ text t
|
|
|
|
displayStringList :: Float -> Float -> [String] -> Picture
|
|
displayStringList hw hh ss = pictures
|
|
( polygon (rectNSEW hh (-hh) hw (-hw))
|
|
: zipWith f ys ss
|
|
)
|
|
where
|
|
ys = [0,22..]
|
|
f y s = translate (10-hw) y . scale 0.15 0.15 $ text s
|
|
|
|
optionsFromList
|
|
:: World
|
|
-> Float -- ^ Half screen width
|
|
-> Float -- ^ Half screen height
|
|
-> String -- ^ Title
|
|
-> [MenuOption] -- ^ Options
|
|
-> Picture
|
|
optionsFromList w hw hh tit ops = pictures $
|
|
[darkenBackground
|
|
,theTitle]
|
|
++
|
|
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
|
|
darkenBackground = color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
|
theTitle = placeString (-hw + 30) (hh - 50) 0.4 tit
|
|
menuOptionToString :: World -> MenuOption -> String
|
|
menuOptionToString w mo@(Toggle{})
|
|
= (scodeToChar $ _moKey mo) : ':' : _moString mo w
|
|
menuOptionToString w mo@(Toggle2{})
|
|
= (scodeToChar $ _moKey1 mo) : '/' : (scodeToChar $ _moKey2 mo) : ':' : _moString mo w
|
|
menuOptionToString _ _ = "undefined option string"
|
|
|
|
|
|
optionsList
|
|
:: Float -- ^ Half screen width
|
|
-> Float -- ^ Half screen height
|
|
-> String -- ^ Title
|
|
-> [String] -- ^ Options
|
|
-> Picture
|
|
optionsList hw hh tit ops = pictures $
|
|
[color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
|
,placeString (-hw + 30) (hh - 50) 0.4 tit]
|
|
++
|
|
zipWith (\ s vpos -> placeString (-hw + 50) vpos 0.2 s) ops [hh-100,hh-150 ..]
|
|
where
|
|
placeString x y sc t = translate x y $ scale sc sc $ color white $ text t
|
|
|
|
controlsList :: Picture
|
|
controlsList = pictures $ concat $ zipWith butAndEff
|
|
[("wasd", "movement")
|
|
,("[rmb]", "aim")
|
|
,("[rmb+lmb]", "shoot or use item")
|
|
,("[wheelscroll]" , "select item" )
|
|
,("[space]" , "pickup item" )
|
|
,("m" , "display map" )
|
|
,("f" , "drop item" )
|
|
,("c[esc]" , "pause" )
|
|
,("qe" , "rotate camera")
|
|
]
|
|
[60,30..]
|
|
where
|
|
butAndEff (btext,etext) y =
|
|
[translate (-250) y $ scale 0.15 0.15 $ color white $ text btext
|
|
,translate 0 y $ scale 0.15 0.15 $ color white $ text etext
|
|
]
|
|
|
|
screenBox
|
|
:: Float -- ^ Half screen width
|
|
-> Float -- ^ Half screen height
|
|
-> [Point2]
|
|
screenBox halfW halfH = map toV2
|
|
[ (halfW, halfH)
|
|
, (-halfW, halfH)
|
|
, (-halfW,-halfH)
|
|
, ( halfW,-halfH)
|
|
]
|
|
|