Commits

Anonymous committed acdde79

playable by mouse-enabled human

  • Participants
  • Parent commits d129ebd

Comments (0)

Files changed (1)

File mills/sdlmills.ml

     382, 264; 442, 264; 207, 322; 262, 322; 323, 321; 147, 381; 262, 380;
     381, 379; 86, 440; 261, 440; 440, 440 |]
   
-  let dot_rects = 
-    let rect (x, y) = Sdlvideo.rect (x - stone_size /2) (y - stone_size /2) 
-      stone_size stone_size in     
+  let dot_rects =
+    let rect (x, y) = Sdlvideo.rect (x - stone_size /2) (y - stone_size /2)
+        stone_size stone_size in
     Array.map rect dot_coords
   
   let background = ref None
     white := Some (load_image "data/mills/white.png");
     black := Some (load_image "data/mills/black.png");
     marker := Some (load_image "data/mills/marker.png");
-    capture := Some (load_image "data/mills/capture.png")    
+    capture := Some (load_image "data/mills/capture.png")
   
   let blit dst dst_rect imgref = match !imgref with
     | None -> failwith "image not initialized"
   
   let draw_stone imgref screen index =
     let r = dot_rects.(index) in
-    blit screen r imgref  
+    blit screen r imgref
   
   let draw_marker screen index =
     draw_stone marker screen index;
-    Sdlvideo.update_rect screen ~rect:dot_rects.(index)
-
+    Sdlvideo.update_rect screen ~rect: dot_rects.(index)
+  
   let draw_capture screen index =
     draw_stone capture screen index;
-    Sdlvideo.update_rect screen ~rect:dot_rects.(index)
-
-    
+    Sdlvideo.update_rect screen ~rect: dot_rects.(index)
+  
   let draw_state screen state =
     draw_background screen;
     for i = 0 to 23 do
     Sdlvideo.update_rect screen
 end
 
+module Human = struct
+  open Sdlevent
+  open Sdlvideo
+  
+  let find_rect selection event =
+    let check r =
+      r.r_x < event.mbe_x && r.r_x + r.r_w > event.mbe_x
+      && r.r_y < event.mbe_y && r.r_y + r.r_h > event.mbe_y
+    in
+    let rec loop = function
+      | [] -> raise Not_found
+      | t:: q ->
+          if check Image.dot_rects.(t) then t
+          else loop q
+    in
+    loop selection
+  
+  let rec select_dot dots =
+    match wait_event () with
+    | MOUSEBUTTONUP e ->
+        begin
+          try
+            find_rect dots e
+          with Not_found -> select_dot dots
+        end
+    | _ -> select_dot dots
+  
+  let player = object
+    method put state =
+      select_dot (Mill.free_dots state)
+    method move state =
+      let color = Mill.get_color (Mill.get_turn state) in
+      let from = select_dot (Mill.movables state color) in
+      let goal = select_dot (Mill.free_neighbors state from) in
+      from, goal
+    method fly state =
+      let color = Mill.get_color (Mill.get_turn state) in
+      let from = select_dot (Mill.colored_dots state color) in
+      let goal = select_dot (Mill.free_dots state) in
+      from, goal
+    method capture state =
+      let opponent = Mill.get_color (succ (Mill.get_turn state)) in
+      select_dot (Mill.capturables state opponent)
+  end
+end
+
 let do_turn screen state player =
   if Mill.can_put state then begin
     let goal = player#put state in
           Image.draw_state screen state';
           Image.draw_marker screen goal;
           Image.draw_capture screen capture;
-        end;        
+        end;
         Mill.end_of_turn state';
         
         s := state';
   Random.self_init ();
   let screen = init_sdl () in
   Image.load ();
-  mainloop screen Ai_alphabeta.player Ai_random.player;
-   Sdltimer.delay 1500;
+  mainloop screen Human.player Ai_alphabeta.player;
+  Sdltimer.delay 1500;