0 | ||| Utilities not (yet) available from idris2-dom
  1 | module Web.MVC.Animate
  2 |
  3 | import Data.IORef
  4 | import JS
  5 | import Web.MVC.Cmd
  6 |
  7 | --------------------------------------------------------------------------------
  8 | --          Time
  9 | --------------------------------------------------------------------------------
 10 |
 11 | %foreign "javascript:lambda:(w) => BigInt(new Date().getTime())"
 12 | prim__time : PrimIO Integer
 13 |
 14 | ||| Get the current time in milliseconds since 1970/01/01.
 15 | export
 16 | currentTime : HasIO io => io Integer
 17 | currentTime = primIO prim__time
 18 |
 19 | ||| Determine the time taken to setup a command and wrap it in an
 20 | ||| event that will be fired synchronously.
 21 | export
 22 | timed : (Integer -> e) -> Cmd e -> Cmd e
 23 | timed toEv (C f) = C $ \h => do
 24 |   t1 <- currentTime
 25 |   f h
 26 |   t2 <- currentTime
 27 |   h (toEv $ t2 - t1)
 28 |
 29 | --------------------------------------------------------------------------------
 30 | --          Timers
 31 | --------------------------------------------------------------------------------
 32 |
 33 | ||| ID used to identify and cancel a running timer.
 34 | public export
 35 | data IntervalID : Type where [external]
 36 |
 37 | %foreign "browser:lambda:(n,h,w)=>setInterval(() => h(w),n)"
 38 | prim__setInterval : Bits32 -> IO () -> PrimIO IntervalID
 39 |
 40 | %foreign "browser:lambda:(i,w)=>clearInterval(i)"
 41 | prim__clearInterval : IntervalID -> PrimIO ()
 42 |
 43 | ||| Fires the given event every `n` milliseconds.
 44 | |||
 45 | ||| Note: Use `animate` for smoothly running animations.
 46 | export
 47 | every : e -> (n : Bits32) -> Cmd e
 48 | every ev millis =
 49 |   C $ \h => ignore $ primIO (prim__setInterval millis (runJS $ h ev))
 50 |
 51 | ||| Fires the given event every `n` milliseconds.
 52 | |||
 53 | ||| In addition, this synchronously fires an event with a wrapped
 54 | ||| handle for stopping the timer.
 55 | export
 56 | everyWithCleanup : (IO () -> e) -> e -> Bits32 -> Cmd e
 57 | everyWithCleanup cleanUpToEv ev millis =
 58 |   C $ \h => Prelude.do
 59 |     id <- primIO (prim__setInterval millis (runJS $ h ev))
 60 |     h (cleanUpToEv $ primIO (prim__clearInterval id))
 61 |
 62 | --------------------------------------------------------------------------------
 63 | --          Animations
 64 | --------------------------------------------------------------------------------
 65 |
 66 | %foreign """
 67 |          browser:lambda:(stop,h,w)=>{
 68 |             let previousTimeStamp;
 69 |
 70 |             function step(timestamp) {
 71 |               if (previousTimeStamp === undefined)
 72 |                 previousTimeStamp = timestamp;
 73 |               const dtime = timestamp - previousTimeStamp;
 74 |               previousTimeStamp = timestamp;
 75 |               if (stop(w) === 0) {
 76 |                 h(dtime)(w)
 77 |                 window.requestAnimationFrame(step);
 78 |               }
 79 |             }
 80 |
 81 |             window.requestAnimationFrame(step);
 82 |          }
 83 |          """
 84 | prim__animate : IO Bits32 -> (Bits32 -> IO ()) -> PrimIO ()
 85 |
 86 | ||| Alias for a time delta in milliseconds
 87 | public export
 88 | DTime : Type
 89 | DTime = Bits32
 90 |
 91 | ||| Repeatedly fires the given event holding the time delta in
 92 | ||| milliseconds since the last animation step.
 93 | export
 94 | animate : (DTime -> e) -> Cmd e
 95 | animate toEv = C $ \h => Prelude.do
 96 |   primIO $ prim__animate (pure 0) (runJS . h . toEv)
 97 |
 98 | ||| Repeatedly fires the given event holding the time delta in
 99 | ||| milliseconds since the last animation step.
100 | |||
101 | ||| In addition, synchronously fires an event with a wrapped
102 | ||| handle for stopping the animation.
103 | export
104 | animateWithCleanup : (IO () -> e) -> (DTime -> e) -> Cmd e
105 | animateWithCleanup cleanupToEv toEv = C $ \h => Prelude.do
106 |   ref <- newIORef (the Bits32 0)
107 |   primIO $ prim__animate (readIORef ref) (runJS . h . toEv)
108 |   h $ cleanupToEv (writeIORef ref 1)
109 |