0 | ||| Utilities not (yet) available from idris2-dom
  1 | module Rhone.JS.Util
  2 |
  3 | import Data.IORef
  4 | import Data.MSF
  5 | import JS
  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 | --------------------------------------------------------------------------------
 20 | --          Timers
 21 | --------------------------------------------------------------------------------
 22 |
 23 | ||| ID used to identify and cancel a running timer.
 24 | public export
 25 | data IntervalID : Type where [external]
 26 |
 27 | %foreign "browser:lambda:(n,h,w)=>setInterval(() => h(w),n)"
 28 | prim__setInterval : Bits32 -> IO () -> PrimIO IntervalID
 29 |
 30 | %foreign "browser:lambda:(i,w)=>clearInterval(i)"
 31 | prim__clearInterval : IntervalID -> PrimIO ()
 32 |
 33 | ||| Sets a timer to repeatedly carry out the given IO action
 34 | ||| after the given number of milliseconds.
 35 | |||
 36 | ||| Returns an ID, which can be used with `clearInterval` to
 37 | ||| cancel the timer.
 38 | export
 39 | setInterval : HasIO io => Bits32 -> JSIO () -> io (IntervalID)
 40 | setInterval millis run = primIO $ prim__setInterval millis (runJS run)
 41 |
 42 | ||| Cancel a running timer with the given ID.
 43 | export
 44 | clearInterval : HasIO io => IntervalID -> io ()
 45 | clearInterval id = primIO $ prim__clearInterval id
 46 |
 47 | --------------------------------------------------------------------------------
 48 | --          Animations
 49 | --------------------------------------------------------------------------------
 50 |
 51 | %foreign """
 52 |          browser:lambda:(h,w)=>{
 53 |             let previousTimeStamp;
 54 |             let stop = 0;
 55 |
 56 |             function step(timestamp) {
 57 |               if (previousTimeStamp === undefined)
 58 |                 previousTimeStamp = timestamp;
 59 |               const dtime = timestamp - previousTimeStamp;
 60 |               previousTimeStamp = timestamp;
 61 |               stop = h(dtime)(w);
 62 |               if (stop === 0) {
 63 |                 window.requestAnimationFrame(step);
 64 |               }
 65 |             }
 66 |
 67 |             window.requestAnimationFrame(step);
 68 |          }
 69 |          """
 70 | prim__animate : (Bits32 -> IO Bits32) -> PrimIO ()
 71 |
 72 | ||| Alias for a time delta in milliseconds
 73 | public export
 74 | DTime : Type
 75 | DTime = Bits32
 76 |
 77 | ||| Use `window.requestAnimationFrame` to repeatedly
 78 | ||| animate the given function.
 79 | |||
 80 | ||| The function takes the time delta (in milliseconds) since
 81 | ||| the previous animation step as input.
 82 | |||
 83 | ||| Returns a cleanup action, which can be run to
 84 | ||| stop the running animation.
 85 | export
 86 | animate : HasIO io => (DTime -> JSIO ()) -> io (IO ())
 87 | animate run = do
 88 |   ref <- newIORef (the Bits32 0)
 89 |   primIO $ prim__animate (\dt => runJS (run dt) >> readIORef ref)
 90 |   pure (writeIORef ref 1)
 91 |
 92 |
 93 | export
 94 | showFPS : Bits32 -> String
 95 | showFPS n = #"FPS: \#{show n}"#
 96 |
 97 | ||| Averages the frames per second (FPS) of an animation
 98 | ||| firing an event with the value every `n` steps.
 99 | export
100 | fps : (n : Nat) -> MSF m DTime (Event Bits32)
101 | fps n = mealy acc (n,0)
102 |
103 |   where
104 |     acc : DTime -> (Nat,DTime) -> HList [(Nat,DTime),Event Bits32]
105 |     acc dt (0,tot)   = [(n,0),Ev $ (1000 * cast (S n)) `div` (tot + dt)]
106 |     acc dt (S k,tot) = [(k, tot + dt), NoEv]
107 |