on develop help sign in
Run DOM updates in an animation frame.
1a29cfaWill Fancher
reflex-dom-core/reflex-dom-core.cabal+3
@@ -74,10 +74,12 @@ library
74 zenc == 0.1.*
74 zenc == 0.1.*
75
75
76 if impl(ghcjs)
76 if impl(ghcjs)
77+ hs-source-dirs: src-ghcjs
77 build-depends:
78 build-depends:
78 ghcjs-base,
79 ghcjs-base,
79 hashable == 1.2.*
80 hashable == 1.2.*
80 else
81 else
82+ hs-source-dirs: src-ghc
81 if !os(windows)
83 if !os(windows)
82 build-depends: unix == 2.7.*
84 build-depends: unix == 2.7.*
83
85
@@ -103,6 +105,7 @@ library
103 Reflex.Dom.Widget.Resize
105 Reflex.Dom.Widget.Resize
104 Reflex.Dom.Xhr
106 Reflex.Dom.Xhr
105 other-modules:
107 other-modules:
108+ Foreign.JavaScript.Internal.Utils
106 Reflex.Dom.WebSocket.Foreign
109 Reflex.Dom.WebSocket.Foreign
107 Reflex.Dom.Xhr.Foreign
110 Reflex.Dom.Xhr.Foreign
108 Reflex.Dom.Xhr.ResponseType
111 Reflex.Dom.Xhr.ResponseType
reflex-dom-core/src-ghc/Foreign/JavaScript/Internal/Utils.hsnew file+13
@@ -0,0 +1,13 @@
1+module Foreign.JavaScript.Internal.Utils
2+ ( synchronously
3+ , freeRequestAnimationFrameCallback
4+ ) where
5+
6+import GHCJS.DOM.Types (JSM, RequestAnimationFrameCallback (..), Callback (..))
7+import Language.Javascript.JSaddle.Object (freeFunction)
8+
9+synchronously :: JSM a -> JSM a
10+synchronously = id
11+
12+freeRequestAnimationFrameCallback :: RequestAnimationFrameCallback -> JSM ()
13+freeRequestAnimationFrameCallback (RequestAnimationFrameCallback (Callback cb)) = freeFunction cb
reflex-dom-core/src-ghcjs/Foreign/JavaScript/Internal/Utils.hsnew file+11
@@ -0,0 +1,11 @@
1+module Foreign.JavaScript.Internal.Utils
2+ ( synchronously
3+ , freeRequestAnimationFrameCallback
4+ ) where
5+
6+import GHCJS.Concurrent
7+import GHCJS.DOM.Types (JSM, RequestAnimationFrameCallback (..))
8+import GHCJS.Foreign.Callback (releaseCallback)
9+
10+freeRequestAnimationFrameCallback :: RequestAnimationFrameCallback -> JSM ()
11+freeRequestAnimationFrameCallback (RequestAnimationFrameCallback cb) = releaseCallback cb
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+24−3
@@ -88,7 +88,7 @@ import Reflex.PostBuild.Class
88import Reflex.TriggerEvent.Base hiding (askEvents)
88import Reflex.TriggerEvent.Base hiding (askEvents)
89import Reflex.TriggerEvent.Class
89import Reflex.TriggerEvent.Class
90
90
91−import Control.Concurrent.Chan
91+import Control.Concurrent
92import Control.Lens hiding (element, ix)
92import Control.Lens hiding (element, ix)
93import Control.Monad.Exception
93import Control.Monad.Exception
94import Control.Monad.Primitive
94import Control.Monad.Primitive
@@ -112,6 +112,8 @@ import Data.Monoid
112import qualified Data.Some as Some
112import qualified Data.Some as Some
113import Data.Text (Text)
113import Data.Text (Text)
114import qualified Data.Text as T
114import qualified Data.Text as T
115+import qualified GHCJS.DOM as DOM
116+import GHCJS.DOM.RequestAnimationFrameCallback
115import GHCJS.DOM.Document (Document, createDocumentFragmentUnchecked, createElementUnchecked, createElementNSUnchecked, createTextNodeUnchecked)
117import GHCJS.DOM.Document (Document, createDocumentFragmentUnchecked, createElementUnchecked, createElementNSUnchecked, createTextNodeUnchecked)
116import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS)
118import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS)
117import qualified GHCJS.DOM.Element as Element
119import qualified GHCJS.DOM.Element as Element
@@ -139,6 +141,7 @@ import Language.Javascript.JSaddle (call, eval)
139
141
140import Reflex.Requester.Base
142import Reflex.Requester.Base
141import Reflex.Requester.Class
143import Reflex.Requester.Class
144+import Foreign.JavaScript.Internal.Utils
142
145
143data ImmediateDomBuilderEnv t m
146data ImmediateDomBuilderEnv t m
144 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document
147 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document
@@ -172,14 +175,32 @@ instance (PerformEvent t m, PrimMonad m) => DomRenderHook t (ImmediateDomBuilder
172
175
173{-# INLINABLE runImmediateDomBuilderT #-}
176{-# INLINABLE runImmediateDomBuilderT #-}
174runImmediateDomBuilderT
177runImmediateDomBuilderT
178+ :: ( Reflex t
179+ , MonadFix m
180+ , PerformEvent t m
181+ , MonadReflexCreateTrigger t m
182+ , MonadJSM m
175− :: (Reflex t, MonadFix m, PerformEvent t m, MonadJSM m, MonadJSM (Performable m))
183+ , MonadJSM (Performable m)
184+ , MonadRef m
185+ , Ref m ~ IORef
186+ )
176 => ImmediateDomBuilderT t m a
187 => ImmediateDomBuilderT t m a
177 -> ImmediateDomBuilderEnv t m
188 -> ImmediateDomBuilderEnv t m
178 -> m a
189 -> m a
179runImmediateDomBuilderT (ImmediateDomBuilderT a) env = flip runTriggerEventT (_immediateDomBuilderEnv_events env) $ do
190runImmediateDomBuilderT (ImmediateDomBuilderT a) env = flip runTriggerEventT (_immediateDomBuilderEnv_events env) $ do
191+ win <- DOM.currentWindowUnchecked
180 rec (x, req) <- runRequesterT (runReaderT a env) rsp
192 rec (x, req) <- runRequesterT (runReaderT a env) rsp
193+ rsp <- performEventAsync $ ffor req $ \rm f -> liftJSM $ runInAnimationFrame win f $
181− rsp <- performEvent $ ffor req $ \rm -> liftJSM $ DMap.traverseWithKey (\_ r -> Identity <$> r) rm
194+ DMap.traverseWithKey (\_ r -> Identity <$> r) rm
182 return x
195 return x
196+ where
197+ runInAnimationFrame win f x = do
198+ rec cb <- newRequestAnimationFrameCallbackSync $ \_ -> do
199+ v <- synchronously x
200+ _ <- liftIO $ f v
201+ freeRequestAnimationFrameCallback cb
202+ _ <- Window.requestAnimationFrame win $ Just cb
203+ return ()
183
204
184{-# INLINABLE askDocument #-}
205{-# INLINABLE askDocument #-}
185askDocument :: Monad m => ImmediateDomBuilderT t m Document
206askDocument :: Monad m => ImmediateDomBuilderT t m Document