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