ocaml-minigames / maze / sdlmaze.ml

exception Break
exception Escape

module Sfx = struct
  open Sdlmixer
  
  let step = ref None
  let error = ref None
  let failure = ref None
  let success = ref None
  
  let load () =
    step := Some (loadWAV "data/maze/sfx/step.wav");
    error := Some (loadWAV "data/maze/sfx/error.wav");
    failure := Some (loadWAV "data/maze/sfx/failure.wav");
    success := Some (loadWAV "data/maze/sfx/success.wav")
  
  let play sfxref = match !sfxref with
    | None -> failwith "sound not initialized"
    | Some sound -> Sdlmixer.play_channel ~channel:0 sound
end

module Image = struct
  open Sdlvideo
  open Sdlloader
  
  let tilesize = 32
  let colors = [|"blue";"green";"orange";"pink";"purple";"red";"yellow" |]
  
  let castle = ref None
  let knight = ref None
  let dragon = ref None
  let flag = ref None
  let star_bullet = ref None
  let dragon_bullet = ref None
  let player_bullet = ref None
  
  let select_color () =
    let index = Random.int (Array.length colors) in
    colors.(index)
  
  let load color =
    castle := Some (load_image "data/maze/castle.png");
    knight := Some (load_image "data/maze/knight.png");
    dragon := Some (load_image "data/maze/dragon.png");
    flag := Some (load_image ("data/maze/flag/flag_" ^ color ^ ".png"));
    star_bullet := Some (load_image "data/maze/bullet/bullet_star.png");
    dragon_bullet := Some (load_image ("data/maze/bullet/bullet_dragon.png"));
    player_bullet := Some (load_image
        ("data/maze/bullet/bullet_" ^ color ^ ".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 x y color =
    let open Sdlvideo in
    let fullrect = rect (x * tilesize) (y * tilesize) tilesize tilesize in
    let insiderect = rect (fullrect.r_x +1) (fullrect.r_y +1)
        (fullrect.r_w -1) (fullrect.r_h -1) in
    let gray = map_RGB screen (150, 150, 150) in
    fill_rect ~rect: fullrect screen gray;
    fill_rect ~rect: insiderect screen color;
    update_rect ~rect: fullrect screen
  
  let draw_img screen x y imgref =
    let open Sdlvideo in
    let fullrect = rect (x * tilesize) (y * tilesize) tilesize tilesize in
    let white = map_RGB screen Sdlvideo.white in
    draw_background screen x y white;
    blit screen fullrect imgref;
    update_rect ~rect: fullrect screen
  
  let draw_tile screen x y tile =
    let open Sdlvideo in
    let gray = map_RGB screen (150, 150, 150)
    and white = map_RGB screen Sdlvideo.white in
    match tile with
    | Maze.Start -> draw_img screen x y flag
    | Maze.Goal -> draw_img screen x y castle
    | Maze.Wall -> draw_background screen x y gray
    | Maze.Open -> draw_background screen x y white
  
  let draw_bullet screen maze bullet (x, y) =
    let tile = Maze.get maze (x, y) in
    if tile = Maze.Open then
      draw_img screen x y bullet
    else
      draw_tile screen x y tile
  
  let draw_knight screen maze (x, y) =
    let tile = Maze.get maze (x, y) in
    if tile = Maze.Open || tile = Maze.Start then
      draw_img screen x y knight
  
  let draw_dragon screen maze (x, y) =
    let tile = Maze.get maze (x, y) in
    if tile = Maze.Open || tile = Maze.Start then
      draw_img screen x y dragon
  
  let draw_maze screen maze =
    let width = Maze.width maze and height = Maze.height maze in
    for x = 0 to width -1 do
      for y = 0 to height - 1 do
        let tile = Maze.get maze (x, y) in
        draw_tile screen x y tile
      done
    done
end

module Game = struct
  type state = {
    maze: Maze.maze;
    start: int * int;
    goal: int * int;
    dragon_delay: int;
    player_position: int * int;
    dragon_position: int * int;
    steps: int;
  }
  
  let init_state maze start goal dragon_delay = {
    maze = maze; start = start; goal = goal; dragon_delay = dragon_delay;
    player_position = start; dragon_position = start; steps = 0
  }
  
  let move_dragon state =
    let path = Astar.Pathfinding.find_path
        state.maze state.dragon_position state.player_position in
    match path with
    | current:: next:: more -> { state with dragon_position = next }
    | _ -> state
  
  let solve screen state =
    let open Sdlevent in
    let open Sdlkey in
    let path = Astar.Pathfinding.find_path state.maze state.start state.goal in
    let walk path =
      List.iter (Image.draw_bullet screen state.maze Image.star_bullet) path in
    walk path;
    let rec loop () =
      match wait_event () with
      | QUIT -> raise Escape
      | KEYDOWN { keysym = KEY_ESCAPE } -> raise Escape
      | KEYDOWN { keysym = KEY_SPACE } -> raise Break
      | _ -> loop ()
    in
    try loop ()
    with Break -> ()
  
  let rec interact screen state =
    let open Sdlevent in
    let open Sdlkey in
    
    let position = state.player_position in
    Image.draw_knight screen state.maze position;
    
    let next =
      match wait_event () with
      | QUIT -> raise Escape
      | KEYDOWN { keysym = KEY_ESCAPE } -> raise Escape
      | KEYDOWN { keysym = KEY_SPACE } -> raise Break
      | KEYDOWN { keysym = KEY_RIGHT } -> (fst position) +1, snd position
      | KEYDOWN { keysym = KEY_LEFT } -> (fst position) -1, snd position
      | KEYDOWN { keysym = KEY_UP } -> fst position, (snd position) -1
      | KEYDOWN { keysym = KEY_DOWN } -> fst position, (snd position) +1
      | _ -> position
    in
    if next = position then interact screen state
    else if not (Maze.is_passable state.maze next) then begin
      Sfx.play Sfx.error;
      interact screen state
    end
    else begin
      Image.draw_bullet screen state.maze Image.player_bullet position;
      if next = state.dragon_position then (Sfx.play Sfx.failure; raise Break)
      else if next = state.goal then (Sfx.play Sfx.success; raise Break)
      else begin
        Sfx.play Sfx.step;
        let state =
          { state with player_position = next; steps = succ state.steps } in
        if state.steps > state.dragon_delay then begin
          Image.draw_bullet screen state.maze
            Image.dragon_bullet state.dragon_position;
          let state' = move_dragon state in
          Image.draw_dragon screen state.maze state'.dragon_position;
          if state'.dragon_position = state'.player_position then
            (Sfx.play Sfx.failure; raise Break)
          else interact screen state'
        end
        else interact screen state
      end
    end
end

(* main *)

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

let rec generate_maze generator width height =
  let check_maze maze start goal =
    let open Astar.Pathfinding in
    let min_steps = 5 in
    try
      let path = find_path maze start goal in
      (List.length path) > min_steps
    with No_path_found -> false
  in
  let maze, start, goal = Generator.generate generator width height in
  if check_maze maze start goal then maze, start, goal
  else generate_maze generator width height

let mainloop screen generator maze_width maze_height dragon_delay =
  try
    while true do
      let maze, start, goal = generate_maze generator maze_width maze_height in
      Image.load (Image.select_color ());
      Image.draw_maze screen maze;
      let state = Game.init_state maze start goal dragon_delay in
      try
        Game.interact screen state
      with Break -> Game.solve screen state
    done
  with Escape -> ()

let _ =
  let width = ref 15 in
  let height = ref 11 in
  let dragon_delay = ref 5 in
  let generator = ref Generator.RANDOM in
  let set_generator = function
    | "BACKTRACKER" -> generator := Generator.BACKTRACKER
    | "RECDIV" -> generator := Generator.RECDIV
    | _ -> generator := Generator.RANDOM
  in
  let args =
    let open Arg in
    ("-size", Tuple [Set_int width; Set_int height],
      "set width and height") ::
    ("-generator", Symbol (["RANDOM";"BACKTRACKER";"RECDIV"], set_generator),
      "sets a custom generator") ::
    ("-dragon-delay", Set_int dragon_delay,
      "steps before the dragon appears") ::
    []
  in
  Arg.parse args ignore "usage";
  Random.self_init ();
  let screen = init_sdl !width !height in
  Sfx.load ();
  mainloop screen !generator !width !height !dragon_delay
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.