将 requestAnimationFrame 转为 Event t()答案

【问题标题】：Turning requestAnimationFrame into an Event t ()将 requestAnimationFrame 转为 Event t()
【发布时间】：2016-04-16 14:19:20
【问题描述】：

使用 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 重复打印。

【问题讨论】：

嗨，我是新来的反应...偶然发现了这个问题...在我看来，askPostGui 可能从 gtk2hs 连接到 postGUIasync 或 postGUIsync，这是我创建的一种解决方法+回到过去，当 GTK2 只能单线程工作时，通过电子邮件发送给 gtk2hs 的维护者。应该将 IO 操作插入 IORef [IO()] 并触发 GTK2 线程执行该操作。触发器将一个字节发送到文件句柄/管道中。如果我的假设是正确的，那么 postGui 不应该发回东西，而且它不会在没有 -threading 运行时的情况下工作。再说一次，只是猜测。

标签： haskell dom requestanimationframe ghcjs reflex

【解决方案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, 反射-0.8.0.0，反射-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'

【讨论】：