From 69b66557a8bfef7cc4d96fde120d0360f5a94d8b Mon Sep 17 00:00:00 2001
From: Alex Auvolat <alex.auvolat@ens.fr>
Date: Thu, 13 Nov 2014 18:20:40 +0100
Subject: Improve performance by removing useless GUI updates.

---
 judge/core.ml | 17 ++++++++++++-----
 judge/main.ml | 19 +++++++++++++------
 2 files changed, 25 insertions(+), 11 deletions(-)

(limited to 'judge')

diff --git a/judge/core.ml b/judge/core.ml
index ec73639..8716c86 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -52,7 +52,7 @@ module type CORE = sig
   val init : unit -> unit
   val finish : unit -> unit
 
-  val handle_events : unit -> unit   (* is anything happening ? *)
+  val handle_events : unit -> bool   (* is anything happening ? *)
 
   val add_rounds : unit -> unit      (* adds one game of everyone against everyone *)
 
@@ -228,6 +228,7 @@ module Core (G: GAME) : CORE = struct
     end
 
   let handle_events () =
+    let usefull = ref false in
     (* 1. IF NOT ENOUGH MATCHES ARE RUNING, LAUNCH ONE *)
     let matches_in_progress =
           !r_games
@@ -264,7 +265,8 @@ module Core (G: GAME) : CORE = struct
       let p2 = open_c (Hashtbl.find players p2) in
       let g = G.new_game in
       let g = { p1; p2; hist = [g]; s = G.s g } in
-      r_games := g::(!r_games)
+      r_games := g::(!r_games);
+    usefull := true
     in
     let can_launch, cannot_launch = List.partition
       (fun (p1, p2) ->
@@ -363,7 +365,8 @@ module Core (G: GAME) : CORE = struct
           send_m p (YourTurn t);
           p.s <- Thinking (t, Unix.gettimeofday());
         | _ -> ()
-      end
+      end;
+    usefull := true
     in List.iter do_fd in_fd;
     (* Check if somebody has timed out *)
     let check_timeout g =
@@ -377,7 +380,8 @@ module Core (G: GAME) : CORE = struct
           w.p.score <- w.p.score + !pt_win;
           l.p.score <- l.p.score + !pt_lose;
           w.s <- Saving;
-          if l.s <> Dead then l.s <- Saving
+          if l.s <> Dead then l.s <- Saving;
+      usefull := true
         end
       | _ -> ()
     in List.iter check_timeout !r_games;
@@ -405,7 +409,10 @@ module Core (G: GAME) : CORE = struct
           p.s <- Dead;
           p.p.running <- None;
           List.iter close p.cfd;
+      usefull := true
       end
-    with _ -> () end
+    with _ -> () end;
+  (* return value *)
+  !usefull
   
 end
diff --git a/judge/main.ml b/judge/main.ml
index 47d29ba..38de615 100644
--- a/judge/main.ml
+++ b/judge/main.ml
@@ -11,7 +11,7 @@ module UI (C : CORE) : sig
 
   val init : unit -> unit
   val close : unit -> unit
-  val handle_events : unit -> unit
+  val handle_events : unit -> bool
   val display : unit -> unit
 
 end = struct
@@ -41,7 +41,9 @@ end = struct
     | Question of string * (unit -> unit) * view
 
   let rec handle_events () =
+    let usefull = ref false in
     while key_pressed () do
+      usefull := true;
       match !curr_view, read_key() with
       | ScoreBoard, '\t' -> curr_view := MatchList false
       | MatchList _, '\t' -> curr_view := ScoreBoard
@@ -88,7 +90,8 @@ end = struct
             raise Exit_judge),
           v)
       | _ -> ()
-    done
+    done;
+    !usefull
 
   and display () =
     clear_graph ();
@@ -222,12 +225,16 @@ end = struct
   module UI = UI(C)
 
   let run () =
-    C.init();
     UI.init();
+    C.init();
+    let last_r = ref 0.0 in
     begin try while true do
-      C.handle_events ();
-      UI.handle_events ();
-      UI.display ()
+      let a = C.handle_events () in
+      let b = UI.handle_events () in
+      if a || b || Unix.gettimeofday() -. !last_r > 0.1 then begin
+        UI.display ();
+        last_r := Unix.gettimeofday()
+      end
     done with
       Exit_judge ->
         C.finish ();
-- 
cgit v1.2.3