affection/src/Affection/Util.hs

module Affection.Util where

import Affection.Types
import Affection.Logging
import Affection.MessageBus.Message.WindowMessage

import SDL (($=))
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL

import System.Clock

import Data.String (fromString)
import Data.List (find)

import Control.Monad.State

-- | Prehandle SDL events
preHandleEvents :: [SDL.Event] -> Affection [SDL.EventPayload]
preHandleEvents evs =
  return $ map SDL.eventPayload evs

-- | block a thread for a specified amount of time
delaySec
  :: Int -- ^ Number of seconds
  -> IO ()
delaySec dur = SDL.delay (fromIntegral $ dur * 1000)

-- | Get time since start but always the same in the current tick.
getElapsedTime :: Affection Double
getElapsedTime = gets elapsedTime

-- | Get delta time (time elapsed from last frame)
getDelta :: Affection Double
getDelta = gets deltaTime

-- | Toggle the Screen mode between 'SDL.Windowed' and 'SDL.FullscreenDesktop'.
-- Pauses the Engine in the process.
toggleScreen :: Word -> Affection ()
toggleScreen windowIdent = do
  ad <- get
  (stop, alteredWindowList) <- foldM
    (\(stop, resWindows) (num, aw@(AffectionWindow window _ mode)) -> do
      if stop || num == windowIdent
      then do
        newMode <- case mode of
          SDL.FullscreenDesktop -> do
            liftIO $ SDL.setWindowMode window SDL.Windowed
            return SDL.Windowed
          SDL.Windowed -> do
            liftIO $ SDL.setWindowMode window SDL.FullscreenDesktop
            return SDL.FullscreenDesktop
          x -> do
            liftIO $ logIO Warn ("Unexpected window mode: " <> fromString (show x))
            return x
        return (True, resWindows ++ [aw { awMode = newMode }])
      else
        return (stop, resWindows ++ [aw])
      )
    (False, [])
    (zip [0..] (drawWindows ad))
  if stop
  then do
    now <- liftIO $ getTime Monotonic
    put ad
      { sysTime = now
      , drawWindows = alteredWindowList
      }
  else
    liftIO $ logIO Warn ("No window found with ident " <> fromString (show windowIdent))

-- | Fit the GL Viewport to Window size
fitViewport
  :: Double               -- ^ Image Ratio (width / height)
  -> WindowMessage        -- ^ Incoming Message. Listens only on
                          -- 'MsgWindowResize' and ignores all others.
  -> Affection ()
fitViewport ratio (MsgWindowResize _ _ (SDL.V2 w h)) = do
  liftIO $ logIO Verbose "Fitting Viewport to size"
  if (fromIntegral w / fromIntegral h) > ratio
  then do
    let nw = floor (fromIntegral h * ratio)
        dw = floor ((fromIntegral w - fromIntegral nw) / 2 :: Double)
    GL.viewport $= (GL.Position dw 0, GL.Size nw h)
  else do
    let nh = floor (fromIntegral w / ratio)
        dh = floor ((fromIntegral h - fromIntegral nh) / 2 :: Double)
    GL.viewport $= (GL.Position 0 dh, GL.Size w nh)
fitViewport _ _ = return ()