From 953633b8ec1d24141f80285a8578ce60c49f54b5 Mon Sep 17 00:00:00 2001
From: "Glenn Y. Rolland" <glenux@glenux.net>
Date: Mon, 18 Feb 2008 14:34:01 +0100
Subject: [PATCH] main.ml: Timeout based wait_next_event.

---
 main.ml | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 78 insertions(+), 8 deletions(-)

diff --git a/main.ml b/main.ml
index ed68500..e3c3b9b 100644
--- a/main.ml
+++ b/main.ml
@@ -1,4 +1,10 @@
 (* vim: set ts=2 sw=2 et : *)
+open Event;;
+
+type notification_t =
+  | Graphics_status of Graphics.status
+  | Tick
+;;
 
 type game_event_t = 
   | MoveLeft
@@ -9,23 +15,85 @@ type game_event_t =
   | ActionTwo
   | Help
   | Quit
-  | None
+  | NoEvent
 ;;
 
-let dispatch_event status =
-  if status.Graphics.keypressed then
-    match status.Graphics.key with
+
+let dispatch_status optstatus =
+  let dispatch_keypress = 
+    function
     | 'q' -> Quit
-    | _ -> None
-  else
-    None
+    | _ -> NoEvent
+  in
+  match optstatus with
+  | None -> (* only draw *) 
+      NoEvent
+  | Some st -> (* react depending on sort *)
+      if st.Graphics.keypressed then dispatch_keypress st.Graphics.key
+      else NoEvent
+;;
+
+let e_receive chan = 
+  Event.sync ( Event.receive chan ) 
+;;
+
+let e_send chan data = 
+  Event.sync ( Event.send chan data ) 
+;;
+
+let ticker pfd_out req_channel notif_channel =
+  let buf = String.make 1 ' ' in
+  while true do
+    let delay = e_receive req_channel in
+    try 
+      ignore ( ThreadUnix.timed_read pfd_out buf 0 1 delay );
+      ignore ( e_send notif_channel Tick );
+    with
+    | Unix.Unix_error(Unix.ETIMEDOUT,_,_) ->
+        ignore ( e_send notif_channel Tick );
+  done
+;;
+
+let key_listener notif_channel =
+  while true do
+    let event = 
+        Graphics.wait_next_event [Graphics.Key_pressed] 
+    in
+    ignore (e_send notif_channel (Graphics_status event));
+  done
 ;;
 
 let game_loop () =
+  let ( pfd_out, pfd_in ) = Unix.pipe ()
+  and tick_request_channel = Event.new_channel ()
+  and tick_notification_channel = Event.new_channel ()
+  and key_notification_channel = Event.new_channel ()
+  in
+  let tick_listener = ticker pfd_out tick_request_channel 
+  in
+  let thr_tick =  Thread.create tick_listener tick_notification_channel
+  and thr_input = Thread.create key_listener key_notification_channel
+  in
+  let ack () = 
+    ignore ( Unix.write pfd_in "." 0 1 )
+  in
+  let time_wait_next_event time lst = 
+    e_send tick_request_channel time;
+    match Event.select [Event.receive tick_notification_channel;
+                        Event.receive key_notification_channel]
+    with
+    | Tick -> None
+    | Graphics_status status -> 
+        ack ();
+        ignore( e_receive tick_notification_channel );
+        Some status
+  in
   let continue = ref true
   in
   while !continue do
-    match dispatch_event ( Graphics.wait_next_event [Graphics.Poll] ) with
+    let opt_status = time_wait_next_event 0.05 [Graphics.Key_pressed]
+    in
+    match dispatch_status opt_status with
     | Quit -> 
         continue := false ;
         print_string "Exiting...\n";
@@ -37,6 +105,8 @@ let main () =
   let player1 = Player.create ()
   and map1 = Maze.create ()
   in
+  ignore player1 ;
+  ignore map1 ;
   Graphics.open_graph " 320x200+50+50";
   Graphics.set_window_title "Just Nuke It";
   game_loop ();