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 ()