relocating

affection.cabal

@@ -44,6 +44,7 @@ library
                      , Affection.Property
                      , Affection.Actor
                      , Affection.Animation
+                     , Affection.Misc
   default-extensions:  OverloadedStrings
 
   -- Modules included in this library but not exported.

examples/example05.hs

@@ -38,6 +38,7 @@ main = do
         (CInt $ fromIntegral resolution)
       }
     , canvasSize     = Nothing
+    , initScreenMode = SDL.Windowed
     , preLoop        = loadList
     , eventLoop      = handle
     , updateLoop     = Main.update

src/Affection.hs

@@ -7,11 +7,6 @@ module Affection
     -- , withWindow
     -- , withDefaultWindow
     , delaySec
-    , get
-    , put
-    , getElapsedTime
-    , getDelta
-    , quit
     , module A
     ) where
 
@@ -42,6 +37,7 @@ import Affection.MouseInteractable as A
 import Affection.Property as A
 import Affection.Actor as A
 import Affection.Animation as A
+import Affection.Misc as A
 
 import qualified BABL as B
 
@@ -169,59 +165,3 @@ withAffection AffectionConfig{..} = do
   cleanUp $ userState nState
   SDL.destroyWindow window
   SDL.quit
-
-getSurfaces :: SDL.Window -> IO (SDL.Surface, SDL.Surface)
-getSurfaces window = do
-  oldSurf@(SDL.Surface ptr _) <- SDL.getWindowSurface window
-  rawSurfacePtr <- Raw.convertSurfaceFormat ptr (SDL.toNumber SDL.ABGR8888) 0
-  let surface = SDL.Surface rawSurfacePtr Nothing
-  return (oldSurf, surface)
-
--- Prehandle SDL events in case any window events occur
-preHandleEvents :: [SDL.Event] -> Affection us [SDL.EventPayload]
-preHandleEvents evs =
-  -- mapM handle evs
-  -- where
-  --   handle e =
-  --     case SDL.eventPayload e of
-  --       SDL.WindowMovedEvent _ -> do
-  --         liftIO $ traceIO "I was moved"
-  --         return e
-  --       _ ->
-  --         return e
-  return $ map SDL.eventPayload evs
-
--- | Return the userstate to the user
-getAffection :: Affection us us
-getAffection = do
-  ad <- get
-  return $ userState ad
-
--- | Put altered user state back
-putAffection
-  :: us              -- User state
-  -> Affection us ()
-putAffection us = do
-  ad <- get
-  put $ ad
-    { userState = us }
-
--- | 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 us Double
-getElapsedTime =
-  elapsedTime <$> get
-
-getDelta :: Affection us Double
-getDelta =
-  deltaTime <$> get
-
-quit :: Affection us ()
-quit = do
-  ad <- get
-  put $ ad { quitEvent = True }

src/Affection/Misc.hs

@@ -0,0 +1,66 @@
+module Affection.Misc
+where
+
+import Affection.Types
+
+import qualified SDL
+
+import System.Clock
+
+import Control.Monad.State
+
+-- Prehandle SDL events in case any window events occur
+preHandleEvents :: [SDL.Event] -> Affection us [SDL.EventPayload]
+preHandleEvents evs =
+  return $ map SDL.eventPayload evs
+
+-- | Return the userstate to the user
+getAffection :: Affection us us
+getAffection = do
+  ad <- get
+  return $ userState ad
+
+-- | Put altered user state back
+putAffection
+  :: us              -- User state
+  -> Affection us ()
+putAffection us = do
+  ad <- get
+  put $ ad
+    { userState = us }
+
+-- | 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 us Double
+getElapsedTime =
+  elapsedTime <$> get
+
+getDelta :: Affection us Double
+getDelta =
+  deltaTime <$> get
+
+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.Fullscreen
+      return SDL.Fullscreen
+    SDL.Fullscreen -> do
+      SDL.setWindowMode (drawWindow ad) SDL.Windowed
+      return SDL.Windowed
+  now <- liftIO $ getTime Monotonic
+  put ad
+    { sysTime = now
+    , screenMode = newMode
+    }

src/Affection/Types.hs

@@ -59,6 +59,8 @@ data AffectionConfig us = AffectionConfig
       -- ^ Window configuration
   , canvasSize     :: Maybe (Int, Int)
       -- ^ size of the texture canvas
+  , initScreenMode :: SDL.WindowMode
+      -- ^ Window mode to start in
   , preLoop        :: Affection us ()
       -- ^ Actions to be performed, before loop starts
   , eventLoop      :: SDL.EventPayload -> Affection us ()
@@ -87,6 +89,7 @@ data AffectionData us = AffectionData
   , windowRenderer  :: SDL.Renderer       -- ^ Internal renderer of window
   , drawTexture     :: SDL.Texture        -- ^ SDL Texture to draw to
   , drawFormat      :: B.BablFormatPtr    -- ^ Target format
+  , screenMode      :: SDL.WindowMode     -- ^ current screen mode
   , drawStack       :: [DrawRequest]      -- ^ Stack of 'DrawRequest's to be processed
   , drawDimensions  :: (Int, Int)         -- ^ Dimensions of target surface
   , drawStride      :: Int                -- ^ Stride of target buffer