haskelloids/src/Menu.hs

module Menu where

import Affection as A
import qualified SDL

import Debug.Trace

import Data.Maybe

import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)

import qualified Data.Map as M

import NanoVG

-- internal imports

import Types
import Commons

handleMenuEvent :: (Affection UserData ()) -> [SDL.EventPayload] -> Affection UserData ()
handleMenuEvent loader es =
  mapM_ (\e ->
    case e of
      SDL.KeyboardEvent dat ->
        case SDL.keysymKeycode $ SDL.keyboardEventKeysym dat of
          SDL.KeycodeSpace ->
            when (SDL.keyboardEventKeyMotion dat == SDL.Pressed) $ do
              ud <- getAffection
              loader
          _ -> return ()
      SDL.WindowClosedEvent _ -> do
        ad <- get
        put ad
          { quitEvent = True
          }
      _ -> return ()
    ) es

loadMenu :: Affection UserData ()
loadMenu = do
  liftIO $ logIO A.Debug "Loading Menu"
  ud <- getAffection
  mhaskImage <- liftIO $
    createImage (nano ud) (FileName "assets/haskelloid.svg") 0
  when (isNothing mhaskImage) $
    liftIO $ logIO Error "Failed to load asset haskelloid"
  hs <- newHaskelloids (fromJust mhaskImage)
  putAffection ud
    { haskelloids = hs
    , fade = FadeIn 1
    , state = Menu
    -- , shots = (shots ud)
    --   { partSysParts = ParticleStorage Nothing [] }
    }

updateMenu :: Double -> Affection UserData ()
updateMenu sec = do
  ud <- getAffection
  let nhs = map (updateHaskelloid sec) (haskelloids ud)
  case fade ud of
    FadeIn ttl -> do
      putAffection ud
        { fade = if (ttl - sec) > 0 then FadeIn (ttl - sec) else FadeOut 1
        , haskelloids = nhs
        }
    FadeOut ttl -> do
      putAffection ud
        { fade = if (ttl - sec) > 0 then FadeOut (ttl - sec) else FadeIn 1
        , haskelloids = nhs
        }