module Menu where import Affection as A import qualified SDL import qualified Data.Set as S import Control.Monad import Control.Concurrent.MVar import NanoVG -- internal imports import Types import Commons loadMenu :: Affection () -> UserData -> Affection () loadMenu stateChange ud = do liftIO $ logIO A.Debug "Loading Menu" hs <- newHaskelloids (haskImage ud) 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" void $ liftIO $ swapMVar (doNextStep ud) False SDL.KeycodeSpace -> do liftIO $ logIO A.Debug "Leaving Menu to Game" stateChange _ -> return () ) 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]) 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 FadeIn ttl -> void $ liftIO $ swapMVar (fade ud) (if (ttl - sec) > 0 then FadeIn (ttl - sec) else FadeOut 1) FadeOut ttl -> void $ liftIO $ swapMVar (fade ud) (if (ttl - sec) > 0 then FadeOut (ttl - sec) else FadeIn 1) drawMenu :: UserData -> Affection () drawMenu ud = do hasks <- liftIO $ readMVar (haskelloids ud) mapM_ (drawHaskelloid (nano ud)) hasks liftIO $ do let ctx = nano ud alpha fio = case fio of FadeIn d -> floor (255 * (1 - d)) FadeOut d -> floor (255 * d) 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" fadeState <- readMVar (fade ud) fillColor ctx (rgba 0 128 255 (alpha $ fadeState)) fontSize ctx 40 textBox ctx 0 350 800 "Press [Space] to Play\nPress [Esc] to exit" restore ctx