Merge pull request #33 from ocharles/raf-timestamp

Add Performance.now and add time stamp information to requestAnimationFrame bindings

Author: luite

JavaScript/Web/AnimationFrame.hs

@@ -34,22 +34,24 @@ newtype AnimationFrameHandle = AnimationFrameHandle JSRef
 {- |
      Wait for an animation frame callback to continue running the current
      thread. Use 'GHCJS.Concurrent.synchronously' if the thread should
-     not be preempted.
+     not be preempted. This will return the high-performance clock time
+     stamp once an animation frame is reached.
  -}
-waitForAnimationFrame :: IO ()
+waitForAnimationFrame :: IO Double
 waitForAnimationFrame = do
   h <- js_makeAnimationFrameHandle
   js_waitForAnimationFrame h `onException` js_cancelAnimationFrame h
 
 {- |
      Run the action in an animationframe callback. The action runs in a
-     synchronous thread.
+     synchronous thread, and is passed the high-performance clock time
+     stamp for that frame.
  -}
-inAnimationFrame :: OnBlocked -- ^ what to do when encountering a blocking call
-                 -> IO ()     -- ^ the action to run
+inAnimationFrame :: OnBlocked       -- ^ what to do when encountering a blocking call
+                 -> (Double -> IO ())  -- ^ the action to run
                  -> IO AnimationFrameHandle
 inAnimationFrame onBlocked x = do
-  cb <- syncCallback onBlocked x
+  cb <- syncCallback1 onBlocked (x . pFromJSRef)
   h  <- js_makeAnimationFrameHandleCallback (jsref cb)
   js_requestAnimationFrame h
   return h
@@ -68,6 +70,6 @@ foreign import javascript unsafe "h$animationFrameCancel"
   js_cancelAnimationFrame :: AnimationFrameHandle -> IO ()
 foreign import javascript interruptible
   "$1.handle = window.requestAnimationFrame($c);"
-  js_waitForAnimationFrame :: AnimationFrameHandle -> IO ()
+  js_waitForAnimationFrame :: AnimationFrameHandle -> IO Double
 foreign import javascript unsafe "h$animationFrameRequest"
   js_requestAnimationFrame :: AnimationFrameHandle -> IO ()

JavaScript/Web/Performance.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, InterruptibleFFI,
+             DeriveDataTypeable
+  #-}
+
+{- | The Performance interface represents timing-related performance information for the given page.
+  -}
+
+module JavaScript.Web.Performance
+    ( now
+    ) where
+
+import GHCJS.Foreign.Callback
+import GHCJS.Marshal.Pure
+import GHCJS.Types
+
+import Control.Exception (onException)
+import Data.Typeable
+
+newtype AnimationFrameHandle = AnimationFrameHandle (JSRef ())
+  deriving (Typeable)
+
+{- | The 'now' computation returns a high resolution time stamp, measured in
+     milliseconds, accurate to one thousandth of a millisecond.
+
+     The value represented by 0 varies according the context, but
+     in dedicated workers created from a Window context, the epoch is the value
+     of the @PerformanceTiming.navigationStart@ property.
+ -}
+now :: IO Double
+now = js_performanceNow
+{-# INLINE now #-}
+
+-- -----------------------------------------------------------------------------
+
+foreign import javascript unsafe "performance.now()"
+  js_performanceNow :: IO Double

ghcjs-base.cabal

@@ -44,7 +44,7 @@ library
                     GeneralizedNewtypeDeriving
                     ScopedTypeVariables
                     TypeOperators
-                    
+
   ghc-options:     -O
   exposed-modules: Data.JSString
                    Data.JSString.Int
@@ -107,6 +107,7 @@ library
                    JavaScript.Web.File
                    JavaScript.Web.MessageEvent
                    JavaScript.Web.MessageEvent.Internal
+                   JavaScript.Web.Performance
                    JavaScript.Web.Storage
                    JavaScript.Web.Storage.Internal
                    JavaScript.Web.StorageEvent
@@ -168,5 +169,3 @@ test-suite tests
     test-framework >= 0.4,
     test-framework-hunit >= 0.2,
     test-framework-quickcheck2 >= 0.2
-
-

jsbits/animationFrame.js

@@ -1,18 +1,18 @@
 function h$animationFrameCancel(h) {
     if(h.handle) window.cancelAnimationFrame(h.handle);
     if(h.callback) {
-	h$release(h.callback)
-	h.callback = null;
+        h$release(h.callback)
+        h.callback = null;
     }
 }
 
 function h$animationFrameRequest(h) {
-    h.handle = window.requestAnimationFrame(function() {
-	var cb = h.callback;
-	if(cb) {
-	    h$release(cb);
-	    h.callback = null;
-	    cb();
-	}
+    h.handle = window.requestAnimationFrame(function(ts) {
+        var cb = h.callback;
+        if(cb) {
+	        h$release(cb);
+	        h.callback = null;
+	        cb(ts);
+        }
     });
 }