nek0
58fd609095
git-subtree-dir: extern/affection git-subtree-mainline:9e89962af0
git-subtree-split:fc6bfa1ca5
86 lines
2.7 KiB
Haskell
86 lines
2.7 KiB
Haskell
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
|
|
let mwindow = find (\(ident, _, _) -> ident == windowIdent) (drawWindows ad)
|
|
case mwindow of
|
|
Just (ident, window, mode) -> do
|
|
newMode <- case mode of
|
|
SDL.FullscreenDesktop -> do
|
|
SDL.setWindowMode window SDL.Windowed
|
|
return SDL.Windowed
|
|
SDL.Windowed -> do
|
|
SDL.setWindowMode window SDL.FullscreenDesktop
|
|
return SDL.FullscreenDesktop
|
|
x -> do
|
|
liftIO $ logIO Warn ("Unexpected window mode: " <> fromString (show x))
|
|
return x
|
|
now <- liftIO $ getTime Monotonic
|
|
put ad
|
|
{ sysTime = now
|
|
, drawWindows = map
|
|
(\e@(lid, win, _) ->
|
|
if lid == ident
|
|
then (lid, win, newMode)
|
|
else e
|
|
)
|
|
(drawWindows ad)
|
|
}
|
|
Nothing -> do
|
|
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 ()
|