Commits

Anonymous committed 746f53f

better pictures, user can quit the game

Comments (0)

Files changed (4)

data/mills/background.png

Old
Old image
New
New image

data/mills/selectable_dot.png

Old
Old image
New
New image

mills/ai_alphabeta.ml

 
 let player =
   let find_best state lastmove depth playouts =
-    Printf.eprintf "find best: \n%s%!" (to_string state);
-    let before = Unix.gettimeofday() in
     let root = build state lastmove depth in
     let positions = count_positions root in
     let nplayouts = playouts/positions in
-    let after = Unix.gettimeofday() in
-    Printf.eprintf "build time %f, %d positions, %d playouts/position\n%!" 
-      (after -. before) positions nplayouts;
     let children = match root with Node (_, _, c) -> c in
-    let before = Unix.gettimeofday() in
     let scores = List.map (score (estimate_hybrid nplayouts)) children in
-    let after = Unix.gettimeofday() in
-    Printf.eprintf "score time %f\n%!" (after -. before);
-
     let better = if (get_turn state) mod 2 = 0 then (<) else (>) in
     let init = if (get_turn state) mod 2 = 0 then max_int else min_int in    
     let rec select nodes scores selected score =

mills/sdlmills.ml

   let background_size = 530
   let stone_size = 36
   
-  let dot_coords = [| 87, 85; 263, 85; 442, 85; 148, 148; 264, 148; 381, 148;
-    206, 206;267, 206; 323, 206; 85, 262; 148, 262; 206, 262; 323, 263;
-    382, 264; 442, 264; 207, 322; 262, 322; 323, 321; 147, 381; 262, 380;
-    381, 379; 86, 440; 261, 440; 440, 440 |]
+  let dot_coords = [| 87,85; 265,85; 444,84; 149,148; 264,147; 382,148;
+    207,207; 264,206; 322,207; 86,264; 148,264; 206,264; 322,265; 382,264;
+    442,265; 207,322; 264,322; 322,322; 147,381; 263,380; 381,380; 85,440;
+    263,441; 441,440 |]
   
   let dot_rects =
     let rect (x, y) = Sdlvideo.rect (x - stone_size /2) (y - stone_size /2)
-        stone_size stone_size in
+        stone_size stone_size 
+    in
     Array.map rect dot_coords
   
   let screen = ref None
     | Some image ->
         Sdlvideo.blit_surface ~dst_rect: dst_rect ~src: image ~dst: dst ()
   
-  let update_rect rect = 
-     match !screen with
-      | None -> failwith "screen not initialized"
-      | Some surface -> Sdlvideo.update_rect surface ~rect
+  let update_rect rect =
+    match !screen with
+    | None -> failwith "screen not initialized"
+    | Some surface -> Sdlvideo.update_rect surface ~rect
   
   let draw_background () =
     match !screen with
-      | None -> failwith "screen not initialized"
-      | Some surface -> 
+    | None -> failwith "screen not initialized"
+    | Some surface ->
         blit surface (Sdlvideo.rect 0 0 background_size background_size) background
   
   let draw_stone imgref index =
     let r = dot_rects.(index) in
-     match !screen with
-      | None -> failwith "screen not initialized"
-      | Some surface -> blit surface r imgref
+    match !screen with
+    | None -> failwith "screen not initialized"
+    | Some surface -> blit surface r imgref
   
   let draw_marker index =
     draw_stone marker index;
   let draw_selection index =
     draw_stone selection index;
     update_rect dot_rects.(index)
-      
+  
   let draw_selectable_stone index =
     draw_stone selectable_stone index;
     update_rect dot_rects.(index)
-
+  
   let draw_selectable_dot index =
     draw_stone selectable_dot index;
-    update_rect dot_rects.(index)    
-            
+    update_rect dot_rects.(index)
+  
   let rec draw_selectables_stones = function
     | [] -> ()
-    | t::q -> draw_selectable_stone t; draw_selectables_stones q 
-
+    | t:: q -> draw_selectable_stone t; draw_selectables_stones q
+  
   let rec draw_selectables_dots = function
     | [] -> ()
-    | t::q -> draw_selectable_dot t; draw_selectables_dots q 
-
-      
+    | t:: q -> draw_selectable_dot t; draw_selectables_dots q
+  
   let draw_state state =
     draw_background ();
     for i = 0 to 23 do
       | None -> ()
     done;
     match !screen with
-      | None -> failwith "screen not initialized"
-      | Some surface -> Sdlvideo.update_rect surface
+    | None -> failwith "screen not initialized"
+    | Some surface -> Sdlvideo.update_rect surface
 end
 
 module Human = struct
+  open Sdlvideo
   open Sdlevent
-  open Sdlvideo
+  open Sdlkey
   
   let find_rect selection event =
     let check r =
   let rec select_dot dots =
     slurp_events ();
     match wait_event () with
-    | MOUSEBUTTONUP e ->
+      | QUIT -> raise Exit
+      | KEYDOWN { keysym = KEY_ESCAPE } -> raise Exit
+      | MOUSEBUTTONUP e ->
         begin
           try
             find_rect dots e
           with Not_found -> select_dot dots
         end
-    | _ -> select_dot dots
+      | _ -> select_dot dots
   
   let player = object
     method put state =
-      let selectables = (Mill.free_dots state) in 
+      let selectables = (Mill.free_dots state) in
       Image.draw_selectables_dots selectables;
       select_dot selectables
     method move state =
       let color = Mill.get_color (Mill.get_turn state) in
-      let selectables = (Mill.movables state color) in 
+      let selectables = (Mill.movables state color) in
       Image.draw_selectables_stones selectables;
       let from = select_dot selectables in
       Image.draw_state state;
       Image.draw_selection from;
-      let selectables = (Mill.free_neighbors state from) in 
+      let selectables = (Mill.free_neighbors state from) in
       Image.draw_selectables_dots selectables;
       let goal = select_dot selectables in
       from, goal
     method fly state =
       let color = Mill.get_color (Mill.get_turn state) in
-      let selectables = (Mill.colored_dots state color) in 
+      let selectables = (Mill.colored_dots state color) in
       Image.draw_selectables_stones selectables;
       let from = select_dot selectables in
       Image.draw_state state;
       Image.draw_selection from;
-      let selectables = (Mill.free_dots state) in 
+      let selectables = (Mill.free_dots state) in
       Image.draw_selectables_dots selectables;
       let goal = select_dot selectables in
       from, goal
     method capture state =
       let opponent = Mill.get_color (succ (Mill.get_turn state)) in
-      let selectables = (Mill.capturables state opponent) in 
+      let selectables = (Mill.capturables state opponent) in
       Image.draw_selectables_stones selectables;
       select_dot selectables
   end
   Random.self_init ();
   let screen = init_sdl () in
   Image.load screen;
-  mainloop Human.player Ai_alphabeta.player;
-  Sdltimer.delay 1500;
+  try
+    mainloop Human.player Ai_alphabeta.player;
+    Sdltimer.delay 1500;
+  with Exit -> ()