将requestAnimationFrame转换为事件t ()

Question

使用Reflex-DOM，我想创建一个在浏览器准备绘制下一帧时触发的Event t ()，即当requestAnimationFrame触发时触发。我是这样尝试的：

{-# LANGUAGE RecursiveDo, TypeFamilies #-}

import Reflex.Dom
import Reflex.Host.Class

import GHCJS.DOM (currentWindow)
import GHCJS.DOM.Window as Window
import GHCJS.DOM.Types (RequestAnimationFrameCallback(..))
import GHCJS.Foreign.Callback

import Control.Monad
import Control.Monad.IO.Class

refresh win = do
    (event, ref) <- newEventWithTriggerRef
    postGui <- askPostGui
    rec cb <- liftIO $ asyncCallback1 $ \_timestamp -> do
            scheduleNext
            putStrLn "about to fire the event"
            postGui $ void $ fireEventRef ref ()
            putStrLn "event fired"
        let scheduleNext = Window.requestAnimationFrame win $ Just $ RequestAnimationFrameCallback cb
        liftIO scheduleNext
    return event

我的测试应用如下：

main :: IO ()
main = mainWidget $ do
    Just win <- liftIO currentWindow
    tick <- refresh win
    display =<< count tick

但是，数量并没有增加。但是，在浏览器的JS控制台上，我确实看到重复打印about to fire the event和event fired。

Answer 1

我尝试过http://hackage.haskell.org/package/jsaddle-0.9.7.1/docs/Language-Javascript-JSaddle-Run.html#v:nextAnimationFrame，但的失败得很糟糕，出现了内存泄漏的无限循环。

下面的代码运行得很好：

base-4.13.0.0，jsaddle-0.9.7.1，jsaddle-dom-0.9.4.1，reflex-0.8.0.0，reflex-dom-0.6.1.0

{-# LANGUAGE MonoLocalBinds      #-}
{-# LANGUAGE PackageImports      #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Reflex.Missing.AniFrame where

import qualified "base" Control.Monad.IO.Class as Monad (liftIO)
import qualified "jsaddle" Language.Javascript.JSaddle as JS (JSCallAsFunction,fun,function)
import qualified "jsaddle-dom" GHCJS.DOM as DOM (currentWindowUnchecked)
import qualified "jsaddle-dom" GHCJS.DOM.Types as DOM (liftJSM,fromJSValUnchecked,Callback(..),RequestAnimationFrameCallback(..))
import qualified "jsaddle-dom" GHCJS.DOM.Window as DOM (requestAnimationFrame_)
import qualified "reflex" Reflex as Reflex
import qualified "reflex-dom" Reflex.Dom as RDOM

type MilliSeconds = Double -- since start of program when in webkit2gtk3

requestAnimationFrameEvents :: forall t m . (RDOM.MonadWidget t m) => m (Reflex.Event t MilliSeconds)
requestAnimationFrameEvents = do
        (te,f) <- Reflex.newTriggerEvent
        let f' :: JS.JSCallAsFunction
            f' = JS.fun $ \meth this (param:_) -> do
                (t::Double) <- DOM.liftJSM $ DOM.fromJSValUnchecked param
                Monad.liftIO $ f t
        ff' <- DOM.liftJSM $ DOM.RequestAnimationFrameCallback . DOM.Callback <$> JS.function f'
        win <- DOM.liftJSM DOM.currentWindowUnchecked
        let register = DOM.requestAnimationFrame_ win ff' >> RDOM.blank
        DOM.liftJSM register
        --accumMaybe :: (MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (f a)
        te' <- Reflex.accumMaybe (\past now -> if now/=past then Just now else Nothing) 0 te
        Reflex.performEvent_ $ (\_ -> DOM.liftJSM register) <$> te'
        return te'