-----------------------------------------------------------------------------
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Subscription.RAF
-- Copyright   :  (C) 2016-2026 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- A `Sub` for `requestAnimationFrame`. Meant to be used in Canvas based
-- animations / games to achieve 60fps.
--
-- @
-- main :: IO ()
-- main = startApp defaultEvents comp { subs = [ rAFSub Tick ] }
--
-- data Action = Tick Double
-- @
--
----------------------------------------------------------------------------
module Miso.Subscription.RAF where
----------------------------------------------------------------------------
import           Control.Monad (void)
import           Data.IORef
----------------------------------------------------------------------------
import           Miso.DSL
import           Miso.Effect (Sub)
import           Miso.Subscription.Util (createSub)
----------------------------------------------------------------------------
-- | A 'Sub' for 60FPS animations when using 'requestForAnimationFrame'.
--
-- The 'Double' returned is a [DOMHighResTimeStamp](https://developer.mozilla.org/en-US/docs/Web/API/DOMHighResTimeStamp) expressed in milliseconds.
--
rAFSub :: (Double -> action) -> Sub action
rAFSub :: forall action. (Double -> action) -> Sub action
rAFSub Double -> action
toAction Sink action
sink = IO JSVal -> (JSVal -> IO ()) -> Sub action
forall a b action. IO a -> (a -> IO b) -> Sub action
createSub IO JSVal
acquire JSVal -> IO ()
release Sink action
sink
  where
    acquire :: IO JSVal
acquire = do
      ref <- JSVal -> IO (IORef JSVal)
forall a. a -> IO (IORef a)
newIORef ([Char] -> JSVal
forall a. HasCallStack => [Char] -> a
error [Char]
"rAFSub: uninitialized, impossible")
      callback <-
        syncCallback1 $ \JSVal
jsval -> do
          Sink action
sink Sink action -> IO action -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Double -> action
toAction (Double -> action) -> IO Double -> IO action
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> IO Double
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked JSVal
jsval
          IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal -> IO Int
requestAnimationFrame (JSVal -> IO Int) -> IO JSVal -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef JSVal -> IO JSVal
forall a. IORef a -> IO a
readIORef IORef JSVal
ref)

      writeIORef ref callback
      void (requestAnimationFrame callback)
      pure callback

    release :: JSVal -> IO ()
release JSVal
callback = Function -> IO ()
freeFunction (JSVal -> Function
Function JSVal
callback)
----------------------------------------------------------------------------