relocating

This commit is contained in:
nek0 2017-07-29 21:45:40 +02:00
parent d2a6d4119b
commit eeb342eeba
5 changed files with 72 additions and 61 deletions

View file

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

View file

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

View file

@ -7,11 +7,6 @@ module Affection
-- , withWindow -- , withWindow
-- , withDefaultWindow -- , withDefaultWindow
, delaySec , delaySec
, get
, put
, getElapsedTime
, getDelta
, quit
, module A , module A
) where ) where
@ -42,6 +37,7 @@ import Affection.MouseInteractable as A
import Affection.Property as A import Affection.Property as A
import Affection.Actor as A import Affection.Actor as A
import Affection.Animation as A import Affection.Animation as A
import Affection.Misc as A
import qualified BABL as B import qualified BABL as B
@ -169,59 +165,3 @@ withAffection AffectionConfig{..} = do
cleanUp $ userState nState cleanUp $ userState nState
SDL.destroyWindow window SDL.destroyWindow window
SDL.quit 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 }

66
src/Affection/Misc.hs Normal file
View file

@ -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
}

View file

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