haskelloids/src/Menu.hs

70 lines
2.2 KiB
Haskell
Raw Permalink Normal View History

2017-02-20 19:51:33 +00:00
module Menu where
2017-12-16 18:06:36 +00:00
import Affection as A
2017-02-20 19:51:33 +00:00
import qualified SDL
2017-12-19 16:30:44 +00:00
import qualified Data.Set as S
2017-12-16 18:06:36 +00:00
2020-05-04 19:17:06 +00:00
import Control.Monad
import Control.Concurrent.MVar
2017-12-16 18:06:36 +00:00
2017-12-22 08:01:07 +00:00
import NanoVG
2017-12-16 18:06:36 +00:00
-- internal imports
2017-02-20 19:51:33 +00:00
import Types
2017-12-16 18:06:36 +00:00
import Commons
2017-02-20 19:51:33 +00:00
2020-05-04 19:17:06 +00:00
loadMenu :: Affection () -> UserData -> Affection ()
loadMenu stateChange ud = do
2017-12-16 18:06:36 +00:00
liftIO $ logIO A.Debug "Loading Menu"
2020-05-04 19:17:06 +00:00
hs <- newHaskelloids (haskImage ud)
2017-12-20 01:00:28 +00:00
kbdUUID <- partSubscribe (subKeyboard $ subsystems ud)
(\kbdev -> when (msgKbdKeyMotion kbdev == SDL.Pressed) $
case SDL.keysymKeycode (msgKbdKeysym kbdev) of
SDL.KeycodeEscape -> do
liftIO $ logIO A.Debug "seeya"
2020-05-04 19:17:06 +00:00
void $ liftIO $ swapMVar (doNextStep ud) False
2017-12-20 01:00:28 +00:00
SDL.KeycodeSpace -> do
liftIO $ logIO A.Debug "Leaving Menu to Game"
stateChange
_ -> return ()
2017-12-19 05:49:41 +00:00
)
2020-05-04 19:17:06 +00:00
void $ liftIO $ swapMVar (haskelloids ud) hs
void $ liftIO $ swapMVar (fade ud) (FadeIn 1)
void $ liftIO $ swapMVar (state ud) Menu
void $ liftIO $ swapMVar (stateUUIDs ud) (UUIDClean [] [kbdUUID])
2017-12-16 10:55:30 +00:00
2020-05-04 19:17:06 +00:00
updateMenu :: UserData -> Double -> Affection ()
updateMenu ud sec = do
nhs <- map (updateHaskelloid sec) <$> liftIO (readMVar (haskelloids ud))
void $ liftIO $ swapMVar (haskelloids ud) nhs
fadeState <- liftIO (readMVar $ fade ud)
case fadeState of
2017-12-21 13:43:13 +00:00
FadeIn ttl ->
2020-05-04 19:17:06 +00:00
void $ liftIO $ swapMVar (fade ud) (if (ttl - sec) > 0 then FadeIn (ttl - sec) else FadeOut 1)
2017-12-21 13:43:13 +00:00
FadeOut ttl ->
2020-05-04 19:17:06 +00:00
void $ liftIO $ swapMVar (fade ud) (if (ttl - sec) > 0 then FadeOut (ttl - sec) else FadeIn 1)
2017-12-19 05:49:41 +00:00
2020-05-04 19:17:06 +00:00
drawMenu :: UserData -> Affection ()
drawMenu ud = do
hasks <- liftIO $ readMVar (haskelloids ud)
mapM_ (drawHaskelloid (nano ud)) hasks
2017-12-19 16:30:44 +00:00
liftIO $ do
let ctx = nano ud
alpha fio = case fio of
2017-12-21 13:43:13 +00:00
FadeIn d -> floor (255 * (1 - d))
FadeOut d -> floor (255 * d)
2017-12-19 16:30:44 +00:00
save ctx
fontSize ctx 120
fontFace ctx "modulo"
textAlign ctx (S.fromList [AlignCenter,AlignTop])
fillColor ctx (rgba 255 255 255 255)
textBox ctx 0 200 800 "HASKELLOIDS"
2020-05-04 19:17:06 +00:00
fadeState <- readMVar (fade ud)
fillColor ctx (rgba 0 128 255 (alpha $ fadeState))
2017-12-19 16:30:44 +00:00
fontSize ctx 40
2017-12-19 16:35:06 +00:00
textBox ctx 0 350 800 "Press [Space] to Play\nPress [Esc] to exit"
2017-12-19 16:30:44 +00:00
restore ctx