module Rtime:Timelines forsig..end
React.
Rtime manages time stamp events, delayed events and delayed signals along timelines. The client chooses the concrete timeline by providing an absolute notion of time. Running the timeline at the appropriate pace is left to the client.
See examples of use.
Release %%VERSION%% - %%AUTHORS%%
    Creating and running timelines
typetime =float
typeduration =float
type t 
val create : ?earlier:(t -> unit) -> (unit -> time) -> tcreate earlier now is a timeline whose absolute current time is
    defined by calling the function now. earlier is called with
    the timeline as an argument whenever a new deadline is scheduled
    before all the others on the line; this can be used to unblock a
    sleeping thread. 
    Warning earlier must not perform React update cycles (because
    it may very likely be called during an update cycle).
val now : t -> timenow l is the current time on the timeline.val wakeup : t -> duration optionwakeup l is the duration until the next deadline on the timeline
    (if any).  If duration is negative, the timeline is late.val progress : ?exec:bool -> t -> unitprogress exec l immediatly removes the next deadline from the
    timeline and if exec is true (default) executes it.
    Warning. Deadline executions usually perform React 
    update cycles.
On a time stamp event occurence we distinguish :
    The schedule and the occurence time may not coincide.
val stamp : ?stop:'a React.event ->
       (time -> time -> 'b) -> t -> time -> 'b React.eventstamp stop occ l t is an event such that :
    t on l.occ t t' with t' the occurence time.stop occurs 
       (existing deadlines are removed) or if t is earlier than now l 
    when stamp gets executed.val stamps : ?stop:'a React.event ->
       ?start:time ->
       (time -> time -> 'b * time) -> t -> 'b React.eventstamps stop start occ l is an event such that :
    start (defaults to now l).t, occ start t returns the stamp for the 
       current occurence and the time of the next schedule. If the latter 
       is earlier or equal to t no new occurence is scheduled.stop occurs 
       (existing deadlines are removed) or if start is earlier than 
       now l when stamps gets exectued.val delay_e : ?stop:'a React.event ->
       t -> duration -> 'b React.event -> 'b React.eventdelay_e stop l d e is an event such that : 
    e delayed by d units of time on l.stop occurs (existing deadlines
       are removed).val delay_s : ?eq:('b -> 'b -> bool) ->
       ?stop:'a React.event ->
       t -> duration -> 'b -> 'b React.signal -> 'b React.signaldelay_s eq stop l d i s is :
    S.hold ?eq i (S.delay stop l d (S.changes s))
    Time stamps on a periodic schedule
    The following function returns an event with occurences stamped by their
    occurence time and scheduled on l at
    start, start + p, start + 2p, ... 
    start + (max - 1)p. Occurences known to be late at schedule time 
    are dropped. If max is None the number of occurences is unbounded.
let periodic ?max ?stop ?start l p = match max with
| None ->
    let occ start t = t, (start +. ceil ((t -. start) /. p) *. p) in
    Rtime.stamps ?stop ?start occ l
| Some max ->
    if max <= 0 then React.E.never else
    let occ max start t =
      let i = ceil ((t -. start) /. p) in
      if i >= max then t, t (* stop *) else t, (start +. i *. p)
    in
    Rtime.stamps ?stop ?start (occ (float max)) l
    Normalized linear time interval
    The following function returns a signal that will vary linearly
    from 0.0 to 1.0 during the time interval from start to
    start + d on l. The signal will update at most freq times per
    l units. Updates known to be late at schedule time are dropped
    and the last update value is guaranteed to be 1.
let ninterval ?stop ?start freq l d =
  let max = floor (freq *. d) in
  let p = 1. /. freq in
  let np = 1. /. max in
  let first = p +. match start with None -> Rtime.now l | Some s -> s in
  let occ first t =
    let i = ceil ((t -. first) /. p) in
    if i >= max then 1., t (* stop *) else (i *. np), (first +. i *. p)
  in
  React.S.hold 0. (Rtime.stamps ?stop ~start:first occ l)
    
    The following examples show different techniques to run a UNIX timeline.
    Single threaded program with Unix.select
    The call run l executes all expired deadlines on the
    timeline l and returns the next deadline or a negative value if
    there's no deadline.
let rec run l = match Rtime.wakeup l with
| None -> -1. (* unbounded wait *)
| Some d when d > 0. -> d
| Some _ -> Rtime.progress l; run l
    The main function creates a timeline using Unix.gettimeofday
    for the absolute time, initializes input and ouput descriptors
    and enters an infinite loop that runs the timeline and waits 
    with Unix.select on descriptor events or timeline deadlines.
let main () = 
  let unix_timeline = Rtime.create Unix.gettimeofday in
  let r, w, e = ... (* init. descriptors *) in
  while true do 
    let delay = run unix_timeline in 
    let r', w', e' = Unix.select !r !w !e delay in 
    ... (* handle descriptor events *)
  done
    
    The call run l executes all expired deadlines
    on the timeline l and installs a timer to send the Sys.sigalrm
    signal on the next deadline or does nothing if there's no deadline.
let rec run l = match Rtime.wakeup l with 
  | None -> ()
  | Some d when d > 0. ->
    let s = { Unix.it_interval = 0.; it_value = d } in
    ignore (Unix.setitimer Unix.ITIMER_REAL s)
  | Some _ -> Rtime.progress l; run l
    The idea is to install a handler for Sys.sigalrm that notifies
    the main program that a deadline expired. It is very important
    that the handler does not try to progress the timeline itself by calling
    Rtime.progress, because doing so may violate the mutual exclusion of
    React's update cycles if the handler is invoked during such a
    cycle.
    In our example below, we assume the main loop waits indefinitely
    for messages in a queue with a blocking call to wait_message.
    Whenever the timer expires the unblock handler sends a message
    to the queue with send_timer_message. If the main loop is
    currently blocked on wait_message this will unblock it and run
    the timeline. The timeline uses Unix.gettimeofday for the
    absolute time and calls unblock if a deadline is inserted before
    the others to readjust the timer delay.
let main () = 
  let unblock _ = send_timer_message () in
  let unix_timeline = Rtime.create ~earlier:unblock Unix.gettimeofday in
  Sys.set_signal Sys.sigalrm (Sys.Signal_handle unblock);
  run unix_timeline;
  while true do 
    let m = wait_message () in
    if m = timer_message then run unix_timeline else 
    ... (* handle other message *)
  done
    In this example, we run the timeline in a dedicated thread.
    First, React's update cycles must be executed in a critical
    section. The thread dedicated to the timeline will trigger update
    cycles upon deadline execution. Hence we need to execute them in
    mutual exclusion from update cycles triggered by other
    threads. The mutex function applies a function to its argument
    in a critical section. The other threads will have to use this
    function to perform update cycles; to acheive this automatically
    they can use e_create and s_create to create their primitives.
let mutex = 
  let m = Mutex.create () in 
  fun f v ->
      try Mutex.lock m; let r = f v in Mutex.unlock m; r with
      | e -> (Mutex.unlock m; raise e)
let e_create () = 
  let e, send = React.E.create () in 
  e, mutex send
let s_create v = 
  let s, set = React.S.create v in 
  s, mutex set
    Next, we need a mechanism to sleep the thread for a specific 
    amount of time (sleep) and a mean to unblock the thread
    from another thread in case an earlier event occurrence gets created 
    (earlier). Unix's interval timers and condition variables are used to 
    achieve this.
let sleep, earlier = 
  let m = Mutex.create () in
  let proceed = Condition.create () in
  let sleeping = ref false in
  let set_timer d = 
    let s = { Unix.it_interval = 0.; it_value = d } in
    ignore (Unix.setitimer Unix.ITIMER_REAL s)
  in
  let sleep d = (* if d = 0. unbounded sleep *)
    if d < 0. then invalid_arg "negative delay";
    Mutex.lock m; 
    sleeping := true;
    set_timer d;
    while !sleeping do Condition.wait proceed m done;
    Mutex.unlock m
  in
  let earlier _ = 
    Mutex.lock m;
    sleeping := false;
    set_timer 0.; 
    Condition.signal proceed;
    Mutex.unlock m;
  in
  let timer _ = sleeping := false; Condition.signal proceed;
  in
  Sys.set_signal Sys.sigalrm (Sys.Signal_handle timer);
  sleep, earlier
    The call run l is an infinite loop that executes expired 
    deadlines on the timeline l (note the use of the mutex
    function to progress the timeline), sleeps the thread until 
    the next deadline or forever if there's no deadline.
let run l = 
  while true do 
    try match Rtime.wakeup l with
    | None -> sleep 0. (* unbounded sleep *)
    | Some d when d > 0. -> sleep d
    | Some _ -> mutex Rtime.progress l
    with e -> ... (* print or ignore exception to avoid termination *)
  done;
  assert (false)
    The main function creates a timeline using Unix.gettimeofday for the
    absolute time and earlier to wake up the thread on earlier deadlines 
    and runs it in a dedicated thread. 
let main () = 
  let unix_timeline = Rtime.create ~earlier Unix.gettimeofday in
  let timeline_thread = Thread.create run unix_timeline in
  ...