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 Control.Monad.State
preHandleEvents :: [SDL.Event] -> Affection us [SDL.EventPayload]
preHandleEvents evs =
return $ map SDL.eventPayload evs
getAffection :: Affection us us
getAffection = gets userState
putAffection
:: us
-> Affection us ()
putAffection us = do
ad <- get
put $ ad
{ userState = us }
delaySec
:: Int
-> IO ()
delaySec dur = SDL.delay (fromIntegral $ dur * 1000)
getElapsedTime :: Affection us Double
getElapsedTime = gets elapsedTime
getDelta :: Affection us Double
getDelta = gets deltaTime
quit :: Affection us ()
quit = do
ad <- get
put $ ad { quitEvent = True }
toggleScreen :: Affection us ()
toggleScreen = do
ad <- get
newMode <- case screenMode ad of
SDL.Windowed -> do
SDL.setWindowMode (drawWindow ad) SDL.FullscreenDesktop
return SDL.FullscreenDesktop
SDL.FullscreenDesktop -> do
SDL.setWindowMode (drawWindow ad) SDL.Windowed
return SDL.Windowed
x -> do
liftIO $ logIO Warn ("Unexpected Screen mode: " ++ show x)
return x
now <- liftIO $ getTime Monotonic
put ad
{ sysTime = now
, screenMode = newMode
}
fitViewport
:: Double
-> WindowMessage
-> Affection us ()
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 ()