affection/src/Affection/Util.hs

87 lines
2.7 KiB
Haskell
Raw Normal View History

2018-01-12 21:08:23 +00:00
module Affection.Util where
2017-07-29 19:45:40 +00:00
import Affection.Types
import Affection.Logging
2018-01-12 21:08:23 +00:00
import Affection.MessageBus.Message.WindowMessage
2017-07-29 19:45:40 +00:00
2018-01-12 21:08:23 +00:00
import SDL (($=))
2017-07-29 19:45:40 +00:00
import qualified SDL
2018-01-12 21:08:23 +00:00
import qualified Graphics.Rendering.OpenGL as GL
2017-07-29 19:45:40 +00:00
import System.Clock
2019-10-28 16:11:27 +00:00
import Data.String (fromString)
2020-05-04 09:00:49 +00:00
import Data.List (find)
2019-10-28 16:11:27 +00:00
2017-07-29 19:45:40 +00:00
import Control.Monad.State
2018-09-25 15:27:35 +00:00
-- | Prehandle SDL events
preHandleEvents :: [SDL.Event] -> Affection [SDL.EventPayload]
2017-07-29 19:45:40 +00:00
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
2018-09-25 14:10:36 +00:00
getElapsedTime = gets elapsedTime
2017-07-29 19:45:40 +00:00
2018-09-25 15:27:35 +00:00
-- | Get delta time (time elapsed from last frame)
getDelta :: Affection Double
2018-09-25 14:10:36 +00:00
getDelta = gets deltaTime
2017-07-29 19:45:40 +00:00
-- | Toggle the Screen mode between 'SDL.Windowed' and 'SDL.FullscreenDesktop'.
-- Pauses the Engine in the process.
2020-05-04 09:00:49 +00:00
toggleScreen :: Word -> Affection ()
toggleScreen windowIdent = do
2017-07-29 19:45:40 +00:00
ad <- get
2020-05-04 09:00:49 +00:00
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, mod) ->
if lid == ident
then (lid, win, newMode)
else e
)
(drawWindows ad)
}
Nothing -> do
liftIO $ logIO Warn ("No window found with ident " <> fromString (show windowIdent))
2018-01-12 21:08:23 +00:00
-- | 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 ()
2018-01-12 21:08:23 +00:00
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 ()