RE: threads & OCamlTK

From: Don Syme (dsyme@microsoft.com)
Date: Wed Mar 17 1999 - 16:02:45 MET


From: Don Syme <dsyme@microsoft.com>
To: "'William Chesters'" <williamc@dai.ed.ac.uk>, caml-list@inria.fr
Subject: RE: threads & OCamlTK
Date: Wed, 17 Mar 1999 07:02:45 -0800

Thanks to everyone who replied! I'll take a good look at ThreadTk shortly.

William Chesters writes:

> > And, on a vaguely related topic, is it possible to use threads with
> > programs that also use OCamlTK? I know Tk is not threadsafe, but if
> > only one thread is calling Tk functions, then perhaps it's still OK?

> No, `Tk.mainLoop' blocks the whole process.

Hmm... it seems not to, under Windows NT/bytecode. Maybe this is because
Tk.mainLoop gets linked against a non-blocking library of code under
Windows.

Here's an example program where I used polling to kill looping computations.

Cheers & thanks,
Don

---------------------------------------------------------------

let loopy = ref [];;

let mk_loopy_thread id =
  let control = ref false in
  let kill () = control := true in
  let rec loop n =
    Format.printf "loopy thread %d computes %d@." id n;
    if !control then Thread.exit() else loop (n+1) in
  let t = Thread.create loop 0 in
  kill;;

let tk_thread =
  Thread.create (fun () ->
    let top = openTk () in
  (* The widgets. They all have "top" as parent widget. *)
    let en1 = Entry.create top [TextWidth 6; Relief Sunken] in
    let lab1 = Label.create top [Text "plus"] in
    let en2 = Entry.create top [TextWidth 6 ; Relief Sunken] in
    let lab2 = Label.create top [Text "="] in
    let but1 = Button.create top [Text "loopy thread"] in
    let but2 = Button.create top [Text "kill loopy thread"] in
    let result_display = Label.create top [] in
  (* References holding values of entry widgets *)
    let n1 = ref 0
    and n2 = ref 0 in
  (* Refresh result *)
    let refresh () =
      Label.configure result_display [Text (string_of_int (!n1 + !n2))] in
  (* Electric *)
    let get_and_refresh (w,r) =
      fun _ _ ->
        try
          r := int_of_string (Entry.get w);
          let _ = refresh () in
          ()
        with
                Failure "int_of_string" ->
            Label.configure result_display [Text "error"]
    in
  (* Set the callbacks *)
    Entry.configure en1 [XScrollCommand (get_and_refresh (en1,n1)) ];
    Entry.configure en2 [XScrollCommand (get_and_refresh (en2,n2)) ];
    let loopy_command _ =
      loopy := (mk_loopy_thread (List.length !loopy))::(!loopy) in
    let kill_loopy_command _ =
      (List.hd !loopy) ();
      loopy := List.tl !loopy in
    Button.configure but1 [Command loopy_command ];
    Button.configure but2 [Command kill_loopy_command ];
  (* Map the widgets *)
    pack [en1;lab1;en2;lab2;result_display;but1;but2;] [];
  (* Make the window resizable *)
    Wm.minsize_set top 1 1;
  (* Start interaction (event-driven program) *)
    mainLoop ()) ();;

Thread.join tk_thread;;



This archive was generated by hypermail 2b29 : Sun Jan 02 2000 - 11:58:21 MET