Allow for real time window resize
This commit is contained in:
+2
-3
@@ -60,8 +60,8 @@ doSideEffects preData w = do
|
|||||||
. translate (-0.5) (-0.8) . scale 0.0005 0.0005
|
. translate (-0.5) (-0.8) . scale 0.0005 0.0005
|
||||||
. text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
|
. text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
|
||||||
)
|
)
|
||||||
return $ preData & soundData . playingSounds .~ newPlayingSounds
|
foldr (=<<) (return (preData & soundData . playingSounds .~ newPlayingSounds
|
||||||
& frameTimer .~ endTicks
|
& frameTimer .~ endTicks)) (_doneSideEffects w)
|
||||||
|
|
||||||
doPreload' :: Dodge.LoadConfig.Configuration -> IO (PreloadData a)
|
doPreload' :: Dodge.LoadConfig.Configuration -> IO (PreloadData a)
|
||||||
doPreload' config = do
|
doPreload' config = do
|
||||||
@@ -79,7 +79,6 @@ doPreload' config = do
|
|||||||
, _frameTimer = 0
|
, _frameTimer = 0
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
checkForGlErrors :: IO ()
|
checkForGlErrors :: IO ()
|
||||||
checkForGlErrors = do
|
checkForGlErrors = do
|
||||||
errs <- errors
|
errs <- errors
|
||||||
|
|||||||
@@ -10,6 +10,7 @@ module Dodge.Data
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
import Dodge.Data.Menu
|
import Dodge.Data.Menu
|
||||||
|
import Preload.Data
|
||||||
|
|
||||||
import Picture.Data
|
import Picture.Data
|
||||||
import Geometry.Data
|
import Geometry.Data
|
||||||
@@ -85,6 +86,8 @@ data World = World
|
|||||||
, _debugMode :: Bool
|
, _debugMode :: Bool
|
||||||
, _config :: Configuration
|
, _config :: Configuration
|
||||||
, _configNeedsUpdate :: Bool
|
, _configNeedsUpdate :: Bool
|
||||||
|
, _sideEffects :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
|
||||||
|
, _doneSideEffects :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
|
||||||
}
|
}
|
||||||
|
|
||||||
data Corpse = Corpse
|
data Corpse = Corpse
|
||||||
|
|||||||
@@ -237,6 +237,8 @@ defaultWorld = World
|
|||||||
, _debugMode = True
|
, _debugMode = True
|
||||||
, _config = defaultConfig
|
, _config = defaultConfig
|
||||||
, _configNeedsUpdate = False
|
, _configNeedsUpdate = False
|
||||||
|
, _sideEffects = []
|
||||||
|
, _doneSideEffects = []
|
||||||
}
|
}
|
||||||
youLight =
|
youLight =
|
||||||
TLS { _tlsPos = (0,0)
|
TLS { _tlsPos = (0,0)
|
||||||
|
|||||||
+7
-2
@@ -21,6 +21,8 @@ import Dodge.CreatureAction
|
|||||||
import Dodge.SoundLogic
|
import Dodge.SoundLogic
|
||||||
import Dodge.Inventory
|
import Dodge.Inventory
|
||||||
import Geometry
|
import Geometry
|
||||||
|
import Preload.Update
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Char
|
import Data.Char
|
||||||
@@ -65,9 +67,12 @@ handleMouseWheelEvent mwev w = case _menuLayers w of
|
|||||||
_ -> Just w
|
_ -> Just w
|
||||||
|
|
||||||
handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
|
handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
|
||||||
handleResizeEvent sev = Just . set windowX (fromIntegral x)
|
handleResizeEvent sev = Just
|
||||||
|
. set windowX (fromIntegral x)
|
||||||
. set windowY (fromIntegral y)
|
. set windowY (fromIntegral y)
|
||||||
where V2 x y = windowSizeChangedEventSize sev
|
. over sideEffects ( resizeSpareFBO (fromIntegral x) (fromIntegral y) : )
|
||||||
|
where
|
||||||
|
V2 x y = windowSizeChangedEventSize sev
|
||||||
|
|
||||||
handlePressedMouseButton :: MouseButton -> World -> Maybe World
|
handlePressedMouseButton :: MouseButton -> World -> Maybe World
|
||||||
handlePressedMouseButton but w
|
handlePressedMouseButton but w
|
||||||
|
|||||||
+10
-2
@@ -22,12 +22,20 @@ import qualified Data.Set as S
|
|||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
|
||||||
|
update = update' . pushSideEffects
|
||||||
|
|
||||||
|
pushSideEffects :: World -> World
|
||||||
|
pushSideEffects w = w
|
||||||
|
& sideEffects .~ []
|
||||||
|
& doneSideEffects .~ _sideEffects w
|
||||||
|
|
||||||
{- | The update step.
|
{- | The update step.
|
||||||
If '_menuLayers' is not empty, or the saving screen, this is the identity.
|
If '_menuLayers' is not empty, or the saving screen, this is the identity.
|
||||||
In such menus, the only way to change the world is using event handling.
|
In such menus, the only way to change the world is using event handling.
|
||||||
-}
|
-}
|
||||||
update :: World -> World
|
update' :: World -> World
|
||||||
update w = case _menuLayers w of
|
update' w = case _menuLayers w of
|
||||||
(ConfigSaveScreen : ls) -> w & menuLayers .~ ls
|
(ConfigSaveScreen : ls) -> w & menuLayers .~ ls
|
||||||
(_ : _) -> w
|
(_ : _) -> w
|
||||||
[] -> let w1 = updateParticles' . updateProjectiles
|
[] -> let w1 = updateParticles' . updateProjectiles
|
||||||
|
|||||||
Reference in New Issue
Block a user