-----------------------------------------------------------------------------
{-# 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
--
-- = Overview
--
-- "Miso.Subscription.RAF" provides 'rAFSub', a subscription that hooks
-- into the browser's
-- <https://developer.mozilla.org/en-US/docs/Web/API/Window/requestAnimationFrame requestAnimationFrame>
-- loop. On each frame the browser calls back with a
-- <https://developer.mozilla.org/en-US/docs/Web/API/DOMHighResTimeStamp DOMHighResTimeStamp>
-- (milliseconds since page load, sub-millisecond precision), which is
-- forwarded to the component as an action.
--
-- This is the recommended driver for canvas-based animations and games
-- because the browser throttles the callback to the display refresh rate
-- (typically 60 fps) and pauses it automatically when the tab is hidden.
--
-- = Quick start
--
-- @
-- import "Miso"
-- import "Miso.Subscription.RAF"
-- import "Miso.Canvas"
--
-- data Action = Tick Double   -- DOMHighResTimeStamp in ms
--
-- myComponent = ('Miso.component' model update view)
--   { 'Miso.Types.subs'   = [ 'rAFSub' Tick ]
--   , 'Miso.Types.events' = 'Miso.Event.Types.defaultEvents'
--   }
--
-- update :: Action -> 'Miso.Effect.Effect' p props Model Action
-- update (Tick t) = do
--   'Miso.State.modify' (\\m -> m { time = t })
-- @
--
-- = Lifecycle
--
-- Internally 'rAFSub' uses 'Miso.Subscription.Util.createSub':
--
-- * __Acquire__ — schedules the first @requestAnimationFrame@ callback,
--   which re-schedules itself on every invocation.
-- * __Release__ — calls 'Miso.DSL.freeFunction' to cancel the callback
--   and release the JS reference when the component unmounts.
--
-- = See also
--
-- * "Miso.Canvas" — canvas drawing API driven by 'rAFSub' ticks
-- * "Miso.Subscription.Util" — 'Miso.Subscription.Util.createSub'
-- * "Miso.Subscription" — re-export hub
----------------------------------------------------------------------------
module Miso.Subscription.RAF
  ( rAFSub
  , rAFSubElapsed
  ) 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 'requestAnimationFrame'.
--
-- The 'Double' returned is a [DOMHighResTimeStamp](https://developer.mozilla.org/en-US/docs/Web/API/DOMHighResTimeStamp) expressed in milliseconds.
--
rAFSub
  :: (Double -> action)
  -- ^ Callback fired each frame with a 'DOMHighResTimeStamp' in milliseconds
  -> 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
      IORef JSVal
ref <- JSVal -> IO (IORef JSVal)
forall a. a -> IO (IORef a)
newIORef ([Char] -> JSVal
forall a. HasCallStack => [Char] -> a
error [Char]
"rAFSub: uninitialized, impossible")
      JSVal
callback <-
        (JSVal -> IO ()) -> IO JSVal
syncCallback1 ((JSVal -> IO ()) -> IO JSVal) -> (JSVal -> IO ()) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ \JSVal
jsval -> do
          Sink action
sink Sink action -> (Double -> action) -> Double -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> action
toAction (Double -> IO ()) -> IO Double -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m 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)

      IORef JSVal -> JSVal -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef JSVal
ref JSVal
callback
      IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal -> IO Int
requestAnimationFrame JSVal
callback)
      JSVal -> IO JSVal
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
callback

    release :: JSVal -> IO ()
release JSVal
callback = Function -> IO ()
freeFunction (JSVal -> Function
Function JSVal
callback)
----------------------------------------------------------------------------
-- | Like 'rAFSub' but fires @action@ at most once per @interval@ milliseconds.
--
-- Elapsed time is accumulated in 'IORef's inside the subscription so the
-- model is not touched between ticks — Miso only re-renders when a tick
-- actually fires, rather than on every animation frame.
--
-- @
-- app = defaultApp model update view
--   { subs = [ rAFSubElapsed 175 Tick ] }
-- @
--
rAFSubElapsed
  :: Double
  -- ^ Minimum interval between ticks in milliseconds (e.g. @175@ for ~6 fps)
  -> action
  -- ^ Action to dispatch each time the interval elapses
  -> Sub action
rAFSubElapsed :: forall action. Double -> action -> Sub action
rAFSubElapsed Double
interval action
action Sink action
sink = IO (IORef JSVal) -> (IORef JSVal -> IO ()) -> Sub action
forall a b action. IO a -> (a -> IO b) -> Sub action
createSub IO (IORef JSVal)
acquire IORef JSVal -> IO ()
release Sink action
sink
  where
    acquire :: IO (IORef JSVal)
acquire = do
      IORef JSVal
cbRef <- JSVal -> IO (IORef JSVal)
forall a. a -> IO (IORef a)
newIORef ([Char] -> JSVal
forall a. HasCallStack => [Char] -> a
error [Char]
"rAFSubElapsed: uninitialized, impossible")
      let go :: Double -> Double -> IO ()
go Double
lastT Double
elap = do
            JSVal
cb <- (JSVal -> IO ()) -> IO JSVal
syncCallback1 ((JSVal -> IO ()) -> IO JSVal) -> (JSVal -> IO ()) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ \JSVal
jsval -> do
              Double
t <- JSVal -> IO Double
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked JSVal
jsval
              let dt :: Double
dt      = if Double
lastT Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then Double
0 else Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
interval (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lastT)
                  newElap :: Double
newElap = Double
elap Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dt
              if Double
newElap Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
interval
                then Sink action
sink action
action IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Double -> Double -> IO ()
go Double
t (Double
newElap Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
interval)
                else Double -> Double -> IO ()
go Double
t Double
newElap
            IORef JSVal -> JSVal -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef JSVal
cbRef JSVal
cb
            IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal -> IO Int
requestAnimationFrame JSVal
cb)
      Double -> Double -> IO ()
go Double
0 Double
0
      IORef JSVal -> IO (IORef JSVal)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IORef JSVal
cbRef
    release :: IORef JSVal -> IO ()
release IORef JSVal
cbRef = Function -> IO ()
freeFunction (Function -> IO ()) -> (JSVal -> Function) -> JSVal -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> Function
Function (JSVal -> IO ()) -> IO JSVal -> IO ()
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
cbRef
----------------------------------------------------------------------------