[paparazzi-commits] [4249] improve handling of concurrent accesses to maps tiles

[Pascal Brisset]

Revision: 4249
          http://svn.sv.gnu.org/viewvc/?view=rev&root=paparazzi&revision=4249
Author:   hecto
Date:     2009-10-15 06:22:49 +0000 (Thu, 15 Oct 2009)
Log Message:
-----------
 improve handling of concurrent accesses to maps tiles

Modified Paths:
--------------
    paparazzi3/trunk/sw/ground_segment/cockpit/gcs.ml

Modified: paparazzi3/trunk/sw/ground_segment/cockpit/gcs.ml
===================================================================
--- paparazzi3/trunk/sw/ground_segment/cockpit/gcs.ml   2009-10-13 00:28:31 UTC 
(rev 4248)
+++ paparazzi3/trunk/sw/ground_segment/cockpit/gcs.ml   2009-10-15 06:22:49 UTC 
(rev 4249)
@@ -138,11 +138,46 @@
       save_map geomap dest nw se
 
 
+(** This module could be inserted into Ocaml_toosl; but it requires 
threads.cma *)
+module TodoList = struct
+  (** A list of functions to call *)
+  let queue = (Queue.create () : (unit -> unit) Queue.t)
+
+  (** The id of a running thread executing the queue *)
+  let doer = ref None
+
+  (** A mutex to handle concurrent accesses *)
+  let mutex = Mutex.create ()
+
+  let rec exec_todo_list = fun todo_list ->
+    Mutex.lock mutex;
+    if Queue.is_empty todo_list then begin
+      (** Nothing mode to do: exiting the thread *)
+      doer := None;
+      Mutex.unlock mutex
+    end else
+      (** Pick a function from the list, call it and continue *)
+      let f = Queue.take queue in
+      Mutex.unlock mutex;
+      f ();
+      exec_todo_list todo_list
+       
+  let add = fun f ->
+    Mutex.lock mutex;
+    (** Add the function to the queue *)
+    Queue.add f queue;
+    if !doer = None then
+      (** Nobody is currently running the queue: start a thread *)
+      doer := Some (Thread.create exec_todo_list queue);
+    Mutex.unlock mutex
+end
+  
+
 (************ Google, OSM Maps handling 
*****************************************)
 module GM = struct
   (** Fill the visible background with Google, OSM tiles *)
   let fill_tiles = fun geomap -> 
-    ignore (Thread.create MapGoogle.fill_window geomap)
+    TodoList.add (fun () -> MapGoogle.fill_window geomap)
 
   let auto = ref false
   let update = fun geomap ->
@@ -189,12 +224,11 @@
     if Sys.file_exists f then
       display f
     else
-      ignore (Thread.create
-               (fun f ->
-                 let c = sprintf "%s %d %d %d %s" !get_bdortho lx ly r f in
-                 ignore (Sys.command c);
-                 display f)
-               f)
+      TodoList.add
+       (fun () ->
+         let c = sprintf "%s %d %d %d %s" !get_bdortho lx ly r f in
+         ignore (Sys.command c);
+         display f)
   end
 
 
@@ -237,15 +271,14 @@
     and yc = GdkEvent.Button.y ev in
     let (xw,yw) = geomap#window_to_world xc yc in
     
-    let thread = fun f x -> ignore (Thread.create f x) in
     let wgs84 = geomap#of_world (xw,yw) in
     let display_ign = fun () ->        
-      thread (MapIGN.display_tile geomap) wgs84
+      TodoList.add (fun () -> MapIGN.display_tile geomap wgs84)
     and display_gm = fun () ->
-      thread (fun () ->
-       try ignore (MapGoogle.display_tile geomap wgs84) with
-         Gm.Not_available -> ())
-       () in
+      TodoList.add
+       (fun () ->
+         try ignore (MapGoogle.display_tile geomap wgs84) with
+           Gm.Not_available -> ()) in
     
     let m = if !ign then [`I ("Load IGN tile", display_ign)] else [] in
     let m =