From mboxrd@z Thu Jan  1 00:00:00 1970
Received: (from majordomo@localhost) by pauillac.inria.fr (8.7.6/8.7.3) id EAA16055; Mon, 18 Oct 2004 04:10:12 +0200 (MET DST)
X-Authentication-Warning: pauillac.inria.fr: majordomo set sender to owner-caml-list@pauillac.inria.fr using -f
Received: from nez-perce.inria.fr (nez-perce.inria.fr [192.93.2.78]) by pauillac.inria.fr (8.7.6/8.7.3) with ESMTP id EAA16206 for <caml-list@pauillac.inria.fr>; Mon, 18 Oct 2004 04:10:10 +0200 (MET DST)
Received: from kurims.kurims.kyoto-u.ac.jp (kurims.kurims.kyoto-u.ac.jp [130.54.16.1])
	by nez-perce.inria.fr (8.13.0/8.13.0) with ESMTP id i9I2A7QI003944
	for <caml-list@inria.fr>; Mon, 18 Oct 2004 04:10:09 +0200
Received: from localhost (suiren.kurims.kyoto-u.ac.jp [130.54.16.25])
	by kurims.kurims.kyoto-u.ac.jp (8.9.3p2-20030924/3.7W) with ESMTP id LAA03683;
	Mon, 18 Oct 2004 11:09:56 +0900 (JST)
Date: Mon, 18 Oct 2004 11:09:47 +0900 (JST)
Message-Id: <20041018.110947.18284520.garrigue@kurims.kyoto-u.ac.jp>
To: eliot@generation.net
Cc: caml-list@inria.fr
Subject: Re: [Caml-list] Interaction loop with labltk
From: Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>
In-Reply-To: <4173086A.7010803@generation.net>
References: <4173086A.7010803@generation.net>
X-Mailer: Mew version 4.0.64 on Emacs 21.3 / Mule 5.0 (SAKAKI)
Mime-Version: 1.0
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
X-Miltered: at nez-perce with ID 417325FF.000 by Joe's j-chkmail (http://j-chkmail.ensmp.fr)!
X-Loop: caml-list@inria.fr
X-Spam: no; 0.00; caml-list:01 labltk:01 jacques:01 labltk:01 widget:01 lablgtk:01 ocamlc:01 -thread:01 threads:01 threads:01 2004:99 abstr:01 val:01 widget:01 abstr:01 
Sender: owner-caml-list@pauillac.inria.fr
Precedence: bulk

From: Eliot Handelman <eliot@generation.net>

> Is there some way to keep the interaction loop alive while a LablTk 
> widget is running on win32?  I think
> I've seen this topic somewhere but haven't been able to track it down 
> again.

I cannot find my previous post on the subject.

To summarize it, the problem under win32 is that all graphical calls
must occur in the same thread. In practice this means that if you want
to have your interaction loop run in parallel with the labltk main loop,
you must start labltk in a different thread, and have all labltk calls
occur in that thread.
Support for this is included in lablgtk2, but not in labltk.
The same thing can be done in labltk, and I included the needed code
at the end of this mail.

Here is an example of use:
$ ocamlc -thread -I +labltk -c tkthread.ml
$ ocaml -I +labltk -I +threads unix.cma threads.cma labltk.cma tkthread.cmo
        Objective Caml version 3.09+dev4 (2004-10-13)

# open Tkthread;;
# start();;
- : Thread.t = <abstr>
# let b = sync (Button.create ~text:"Hello world!") top;;
val b : Widget.button Widget.widget = <abstr>
# async Tk.pack [b];;
- : unit = ()

Have fun.

Jacques Garrigue

(* tkthread.ml *)
let jobs : (unit -> unit) Queue.t = Queue.create ()
let m = Mutex.create ()
let with_jobs f =
  Mutex.lock m; let y = f jobs in Mutex.unlock m; y

let loop_id = ref None
let reset () = loop_id := None
let cannot_sync () =
  match !loop_id with None -> true
  | Some id -> Thread.id (Thread.self ()) = id

let gui_safe () =
  not (Sys.os_type = "Win32") || !loop_id = Some(Thread.id (Thread.self ()))

let has_jobs () = not (with_jobs Queue.is_empty)
let n_jobs () = with_jobs Queue.length
let do_next_job () = with_jobs Queue.take ()
let async j x = with_jobs (Queue.add (fun () -> j x))
let sync f x =
  if cannot_sync () then f x else
  let m = Mutex.create () in
  let res = ref None in
  Mutex.lock m;
  let c = Condition.create () in
  let j x =
    let y = f x in Mutex.lock m; res := Some y; Mutex.unlock m;
    Condition.signal c
  in
  async j x;
  Condition.wait c m;
  match !res with Some y -> y | None -> assert false

let rec job_timer () =
  Timer.set ~ms:10 ~callback:
    (fun () -> for i = 1 to n_jobs () do do_next_job () done; job_timer())

let thread_main () =
  try
    ignore (Protocol.openTk());
    job_timer();
    loop_id := Some (Thread.id (Thread.self ()));
    Protocol.mainLoop();
    loop_id := None;
  with exn ->
    loop_id := None;
    raise exn

let start () =
  Thread.create thread_main ()

let top = Widget.default_toplevel

-------------------
To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners