1. Vincent Fiack
  2. ocaml-minigames

Source

ocaml-minigames / mills / sdlmills.ml

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 background = ref None
  let black = ref None
  let white = 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")
  
  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 x, y = dot_coords.(index) in
    let r = Sdlvideo.rect (x - stone_size /2) (y - stone_size /2) stone_size stone_size in
    blit screen r imgref
  
  let draw_state screen state =
    draw_background screen;
    for i = 0 to 23 do
      let color = match Mill.get state i with
        | Some Mill.Black -> "black"
      | Some Mill.White -> "white"
      | None -> "none"
      in
      Printf.printf "draw %d: %s\n" i color; 
      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

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';
        if Mill.in_mill state' goal then begin
          Sdltimer.delay 800;
          Mill.capture state' (!p#capture state');
          Image.draw_state screen state'
        end;        
        Printf.printf "end of turn\n%!";
        Mill.end_of_turn state';
        
        s := state';
        p := next !p
      end;
    done;
    Printf.printf "end\n"
  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 _ =
  let screen = init_sdl () in
  Image.load ();
  mainloop screen Ai_random.player Ai_montecarlo.player