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

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 Ai_montecarlo.player Ai_alphabeta.player