Turning requestAnimationFrame into an Event t ()

Question

Using Reflex-DOM, I'd like to make an Event t () that fires when the browser is ready to paint the next frame, i.e. when requestAnimationFrame fires. I tried it like this:

{-# 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

My test app is the following:

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

However, the count doesn't increase. On the browser's JS console, however, I do see both about to fire the event and event fired printed repeatedly.

hi, i'm new to react... found this question by accident... it seems to me, askPostGui might be connected to postGUIasync or postGUIsync from gtk2hs, which is a workaround i created+emailed to the maintainer of gtk2hs back in the days, when GTK2 could work only single-threaded. that is supposed to insert the IO action into an IORef [IO()] and trigger the GTK2 thread to execute that. the trigger was sending one byte into a file handle/pipe. if my assumptions are correct, postGui is not supposed to send things back, and it won't work anyway w/o **-threaded** runtime. then again, just guessing. — comonad, Feb 21 '21 at 01:36

score 1 · Answer 1 · answered Feb 21 '21 at 13:03

I've tried http://hackage.haskell.org/package/jsaddle-0.9.7.1/docs/Language-Javascript-JSaddle-Run.html#v:nextAnimationFrame, but failed miserably with a memory leaking infinite loop.

The following works quite nicely:

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'

Turning requestAnimationFrame into an Event t ()

1 Answers1