(* * clock.ml * -------- * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org> * Licence : BSD3 * * This file is a part of Lambda-Term. *) open Lwt_react open Lwt open LTerm_widget let get_time () = let localtime = Unix.localtime (Unix.time ()) in Printf.sprintf "%02u:%02u:%02u" localtime.Unix.tm_hour localtime.Unix.tm_min localtime.Unix.tm_sec lwt () = let waiter, wakener = wait () in let vbox = new vbox in let clock = new label (get_time ()) in let button = new button "exit" in vbox#add clock; vbox#add button; (* Update the time every second. *) ignore (Lwt_engine.on_timer 1.0 true (fun _ -> clock#set_text (get_time ()))); (* Quit when the exit button is clicked. *) button#on_click (wakeup wakener); (* Run in the standard terminal. *) lwt term = Lazy.force LTerm.stdout in run term vbox waiter