From mboxrd@z Thu Jan  1 00:00:00 1970
Received: (from weis@localhost) by pauillac.inria.fr (8.7.6/8.7.3) id WAA11983 for caml-redistribution; Wed, 17 Mar 1999 22:03:52 +0100 (MET)
Received: from concorde.inria.fr (concorde.inria.fr [192.93.2.39]) by pauillac.inria.fr (8.7.6/8.7.3) with ESMTP id QAA14579 for <caml-list@pauillac.inria.fr>; Wed, 17 Mar 1999 16:03:09 +0100 (MET)
Received: from mail1.microsoft.com (mail1.microsoft.com [131.107.3.125])
	by concorde.inria.fr (8.8.7/8.8.7) with ESMTP id QAA12255
	for <caml-list@inria.fr>; Wed, 17 Mar 1999 16:03:07 +0100 (MET)
Received: by mail1.microsoft.com with Internet Mail Service (5.5.2524.0)
	id <HCH83LB2>; Wed, 17 Mar 1999 07:02:51 -0800
Message-ID: <39ADCF833E74D111A2D700805F1951EF0F00BA7A@RED-MSG-06>
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
X-Mailer: Internet Mail Service (5.5.2524.0)
Sender: weis


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;;