Source

ocaml-minigames / mills / sdlmills.ml

Full commit
module Image = struct
  open Sdlvideo
  open Sdlloader
  
  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_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
  let black = ref None
  let white = ref None
  let marker = ref None
  let capture = ref None
  
  let load () =
    background := Some (load_image "data/mills/background.png");
    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")
  
  let blit dst dst_rect imgref = match !imgref with
    | None -> failwith "image not initialized"
    | Some image ->
        Sdlvideo.blit_surface ~dst_rect: dst_rect ~src: image ~dst: dst ()
  
  let draw_background screen =
    blit screen (Sdlvideo.rect 0 0 background_size background_size) background
  
  let draw_stone imgref screen index =
    let r = dot_rects.(index) in
    blit screen r imgref
  
  let draw_marker screen index =
    draw_stone marker screen 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)
  
  let draw_state screen state =
    draw_background screen;
    for i = 0 to 23 do
      match Mill.get state i with
      | Some Mill.Black -> draw_stone black screen i
      | Some Mill.White -> draw_stone white screen i
      | None -> ()
    done;
    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
    Mill.put state goal;
    goal
  end
  else if Mill.can_fly state then begin
    let from, goal = player#fly state in
    Mill.fly state from goal;
    goal
  end
  else begin
    let from, goal = player#move state in
    Mill.move state from goal;
    goal
  end

let mainloop screen p1 p2 =
  let next p = if p = p1 then p2 else p1 in
  let loop state =
    let p = ref p1 in
    let s = ref state in
    while not (Mill.game_ended !s) do
      let state' = Mill.copy !s in
      begin
        let goal = do_turn screen state' !p in
        Image.draw_state screen state';
        Image.draw_marker screen goal;
        if Mill.in_mill state' goal then begin
          Sdltimer.delay 800;
          let capture = (!p#capture state') in
          Mill.capture state' capture;
          Image.draw_state screen state';
          Image.draw_marker screen goal;
          Image.draw_capture screen capture;
        end;
        Mill.end_of_turn state';
        
        s := state';
        p := next !p
      end;
    done;
  in
  let state = Mill.make () in
  Image.draw_state screen state;
  loop state

let init_sdl () =
  Sdl.init [`VIDEO; `AUDIO];
  at_exit Sdl.quit;
  Sdlmixer.open_audio ();
  at_exit Sdlmixer.close_audio;
  
  Sdlkey.enable_key_repeat ();
  Sdlwm.set_caption "mills minigame" "";
  Sdlvideo.set_video_mode Image.background_size Image.background_size []

let _ =
  Random.self_init ();
  let screen = init_sdl () in
  Image.load ();
  mainloop screen Human.player Ai_alphabeta.player;
  Sdltimer.delay 1500;