Commits

Vincent Fiack committed 54dc0a5

ported maze from graphics to sdl

Comments (0)

Files changed (5)

+syntax: glob
+
+#eclipse
+.paths
+.project
+.projectSettings
+.settings
+
+#ocamlbuild
+_build
+*.native
+*.byte
+
+#misc
+*~
+module Pathfinding = struct 
+  type cost = { steps: int; estimation: int; camefrom: int * int }
+  
+  type node =
+    | Unknown
+    | Closed
+    | Exploring of cost
+    | Explored of cost
+  
+  exception No_path_found
+  
+  module type ExplorationType = sig
+    val matrix : node array array
+    val heuristic : int * int -> int
+  end
+  
+  module MakeExploration = functor(E: ExplorationType) ->
+    struct
+      let matrix = E.matrix
+      let heuristic = E.heuristic
+      
+      let is_explorable maze node =
+        if not (Maze.is_passable maze node) then false
+        else match matrix.(fst node).(snd node) with
+          | Closed -> false
+          | Unknown -> true
+          | Exploring _ -> true
+          | Explored _ -> false
+      
+      let get_steps node = match matrix.(fst node).(snd node) with
+        | Exploring cost -> cost.steps
+        | Explored cost -> cost.steps
+        | Closed -> max_int
+        | Unknown -> invalid_arg "unknown node"
+      
+      let set_exploring node steps camefrom =
+        matrix.(fst node).(snd node) <- Exploring { steps = steps; estimation = steps + (heuristic node); camefrom = camefrom }
+      
+      let set_explored node = 
+        let explored = match matrix.(fst node).(snd node) with
+          | Exploring cost -> Explored cost
+          | _ -> invalid_arg ("not in exploring state: " ^ string_of_int (fst node) ^ ", " ^ string_of_int (snd node))
+        in 
+        matrix.(fst node).(snd node) <- explored
+
+		  let rec reconstruct_path node path =
+		    let camefrom = match matrix.(fst node).(snd node) with
+		      | Explored cost -> cost.camefrom
+		      | Exploring cost -> cost.camefrom
+		      | _ -> node
+		    in
+		    if camefrom = node then node :: path
+		    else reconstruct_path camefrom (node :: path)
+        
+    end
+  
+  module MakeOpenSet(E: ExplorationType) = Set.Make(struct
+      type t = int * int
+      let estimate node = match node with
+        | Exploring cost -> cost.estimation
+        | Explored cost -> cost.estimation
+        | Unknown -> max_int
+        | Closed -> max_int
+      
+      let compare a b =
+        let score_a = estimate E.matrix.(fst a).(snd a) in
+        let score_b = estimate E.matrix.(fst b).(snd b) in
+        let diff = score_a - score_b in
+        if diff = 0 then Pervasives.compare a b else diff
+    end)
+  
+  let find_path maze start goal =
+    let module Exploration = MakeExploration(struct 
+      let matrix = Array.make_matrix (Maze.width maze) (Maze.height maze) Unknown 
+      let heuristic = Maze.distance goal 
+      end)
+    in 
+    let module OpenSet = MakeOpenSet(Exploration) in
+    let openset = ref (OpenSet.singleton start) in
+    let select_best set = OpenSet.min_elt set in
+    Exploration.set_exploring start 0 start;
+    let rec loop () =
+      if OpenSet.is_empty !openset then raise No_path_found
+      else
+        let current = select_best !openset in
+        if current = goal then List.rev (Exploration.reconstruct_path goal [])
+        else begin
+          openset := OpenSet.remove current !openset;
+          Exploration.set_explored current;
+          
+          let neighbors = Maze.neighbor_nodes maze current in
+          let explore node =
+            if Exploration.is_explorable maze node then
+              let tentative_steps = (Exploration.get_steps current) + 1 in
+              if not (OpenSet.mem node !openset) then begin
+                Exploration.set_exploring node tentative_steps current;
+                openset := OpenSet.add node !openset;
+              end
+              else if tentative_steps < (Exploration.get_steps node) then begin 
+                (* remove & add are needed, as the score changes, the place in the tree changes too *)
+                openset := OpenSet.remove node !openset;
+                Exploration.set_exploring node tentative_steps current;
+                openset := OpenSet.add node !openset
+              end
+          in
+          List.iter explore neighbors;
+          loop ()
+        end
+    in
+    loop () 
+end
+(*
+let () =
+  let maze, goal, ants = Maze.Parser.from_file "maze/maze.txt" in
+  let start = List.hd ants in
+  let before = Unix.gettimeofday () in
+  let path = Pathfinding.find_path maze start goal in
+  
+  for i = 0 to 1_000 do
+    ignore (Pathfinding.find_path maze start goal)
+  done;
+  
+  let after = Unix.gettimeofday () in
+  Maze.walk maze (List.rev path);
+  Maze.draw maze;
+  Printf.printf "%d steps\n" (List.length path);
+  let time = (after -. before) *. 1000. in
+  Printf.printf "%f ms\n" time
+*)

maze/generator.ml

+let shuffle lst = 
+  let swap array i j = 
+    let temp = array.(i) in array.(i) <- array.(j); array.(j) <- temp
+  in
+  let shuffle_array array = 
+    Array.iteri (fun i _ -> swap array i (Random.int (i+1))) array;
+    array
+  in
+  Array.to_list (shuffle_array (Array.of_list lst))
+
+let rec select_point maze x1 y1 x2 y2 needle = 
+  let x = x1 + Random.int (x2-x1)
+  and y = y1 + Random.int (y2-y1) in
+  if Maze.get maze (x, y) = needle then (x, y) 
+  else select_point maze x1 y1 x2 y2 needle
+
+let gen_recdiv width height divisions =
+  let maze = Array.make_matrix width height ' ' in
+  let minsize = 3 in
+  let add_wall x1 y1 x2 y2 = 
+    for x = x1 to x2 do
+      for y = y1 to y2 do
+        Maze.set maze (x, y) '#' 
+      done
+    done
+  in
+  let pierce_holes x1 y1 x2 y2 = 
+    if x1 = x2 || y1 = y2 then ()
+    else begin
+	    let xhole1 = x1 + Random.int (x2-x1) 
+		  and yhole1 = y1 + Random.int (y2-y1) in
+		  Maze.set maze (x1, yhole1) ' ';
+		  Maze.set maze (xhole1, y1) ' '
+    end
+  in
+  let rec divide x1 y1 x2 y2 divisions =
+    if divisions = 0 || (x2-x1) <= minsize || (y2-y1) <= minsize then
+      pierce_holes x1 y1 x2 y2
+    else begin
+      let xwall = 2 + x1 + Random.int (x2-x1-3) 
+      and ywall = 2 + y1 + Random.int (y2-y1-3) in
+      add_wall x1 ywall x2 ywall;
+      add_wall xwall y1 xwall y2;
+      let divisions = (pred divisions) in   
+      divide x1 y1 xwall ywall divisions;
+      divide xwall y1 x2 ywall divisions;
+      divide x1 ywall xwall y2 divisions;
+      divide xwall ywall x2 y2 divisions;
+    end
+  in 
+  divide 0 0 (width-1) (height-1) divisions;
+  let start = select_point maze 0 0 (width/2) (height/2) ' ' in
+  let goal = select_point maze (width/2) (height/2) (width-1) (height-1) ' ' in
+  Maze.set maze start '@';
+  Maze.set maze goal 'X';
+  maze, start, goal    
+
+(*Start at a particular cell and call it the "exit."                           *)
+(*Mark the current cell as visited, and get a list of its neighbors.           *)
+(*For each neighbor, starting with a randomly selected neighbor:               *)
+(*  If that neighbor hasn't been visited, remove the wall between this cell    *)
+(*  and that neighbor, and then recurse with that neighbor as the current cell.*)
+  
+let gen_backtracker width height =
+  let maze = Array.make_matrix width height '#' in
+  (* start with a random point, with even coords *)
+  let start = select_point maze 0 0 (width-1) (height-1) '#' in
+  let start = if (fst start) mod 2 <> 0 then (fst start)-1, snd start else start in
+  let start = if (snd start) mod 2 <> 0 then fst start, (snd start)-1 else start in
+  let remove_wall (x1, y1) (x2, y2) =
+    if x1 <> x2 then Maze.set maze ((max x1 x2)-1, y1) ' '
+    else if y1 <> y2 then Maze.set maze (x1, (max y1 y2)-1) ' '
+  in
+  let even_neighbors maze (x, y) =
+	  let nodes = [] in
+	  let nodes = if x > 1 then (x-2, y) :: nodes else nodes in
+	  let nodes = if x < width - 2 then (x+2, y) :: nodes else nodes in
+	  let nodes = if y > 1 then (x, y-2) :: nodes else nodes in
+	  let nodes = if y < height - 2 then (x, y+2) :: nodes else nodes in
+	  nodes
+  in
+  let visited = ref [] in
+  let rec recurse previous current =
+    if not (List.mem current !visited) then begin
+	    Maze.set maze current ' ';
+	    remove_wall previous current;
+      visited := current :: !visited;      
+	    let neighbors = shuffle (even_neighbors maze current) in
+      List.iter (fun next -> recurse current next) neighbors
+    end    
+  in
+  recurse start start;
+  let goal = select_point maze 0 0 (width-1) (height-1) ' ' in
+  Maze.set maze start '@';
+  Maze.set maze goal 'X';  
+  maze, start, goal
+
+let rec add_holes maze n = match+ n with
+  | 0 -> maze
+  | _ -> 
+    let x = Random.int ((Maze.width maze) -1)
+    and y = Random.int ((Maze.height maze) -1) in
+    if Maze.get maze (x, y) = '#' then Maze.set maze (x, y) ' ';
+    add_holes maze (pred n)
+    
+
+let generate width height = 
+  let maze, start, goal = gen_backtracker width height in
+  (add_holes maze (width+height)), start, goal
+  
+module Parser = struct
+  let split separator s =
+    let list = ref [] in
+    let start = ref 0 in
+    let () = try
+        while true do
+          let index = String.index_from s !start separator in
+          list := (String.sub s !start (index - !start)) :: !list;
+          start := index + 1
+        done
+      with Not_found -> list := (String.sub s !start ((String.length s) - !start)) :: !list
+    in
+    List.rev !list
+  
+  let from_string str =
+    let ants = ref [] and goal = ref (0, 0) in
+    let lines = split '\n' str in
+    let height, width = List.length lines, String.length (List.hd lines) in
+    let maze = Array.make_matrix width height ' ' in
+    for x = 0 to width -1 do
+      for y = 0 to height -1 do
+        maze.(x).(y) <- (List.nth lines y).[x];
+        if maze.(x).(y) = '@' then ants := (x, y) :: !ants
+        else if maze.(x).(y) = 'X' then goal := x, y
+      done
+    done;
+    maze, !goal, !ants
+  
+  let from_file filename =
+    let channel = open_in_bin filename in
+    let size = in_channel_length channel in
+    let buffer = Buffer.create size in
+    Buffer.add_channel buffer channel size;
+    from_string (Buffer.contents buffer)
+end
+
+let width maze = Array.length maze
+let height maze = Array.length maze.(0)
+let check maze (x, y) = x >= 0 && y >= 0 && x < (width maze) && y < (height maze)
+let get maze (x, y) = maze.(x).(y)
+let set maze (x, y) value = maze.(x).(y) <- value
+
+let walk maze path =
+  let walk_once coords = if get maze coords = ' ' then set maze coords '.' in
+  List.iter walk_once path
+
+let draw maze =
+  for y = 0 to (height maze) -1 do
+    for x = 0 to (width maze) -1 do
+      print_char (get maze (x, y))
+    done;
+    print_newline ()
+  done
+
+let is_passable maze coord = get maze coord <> '#'
+
+let distance (x1, y1) (x2, y2) =
+  let square x = x * x in
+  let sqrt_int x = int_of_float (sqrt (float_of_int x)) in
+  sqrt_int (square (x1 - x2) + square (y1 - y2))
+
+let neighbor_nodes maze (x, y) =
+  let nodes = [] in
+  let nodes = if x > 0 then (x -1, y) :: nodes else nodes in
+  let nodes = if x < (width maze) - 1 then (x +1, y) :: nodes else nodes in
+  let nodes = if y > 0 then (x, y -1) :: nodes else nodes in
+  let nodes = if y < (height maze) - 1 then (x, y +1) :: nodes else nodes in
+  nodes
+exception Break
+exception Escape
+
+let tilesize = 32
+
+let draw_tile screen x y color =
+  let color' = Sdlvideo.map_RGB screen color in
+  let rect = Sdlvideo.rect (x * tilesize) (y * tilesize) tilesize tilesize in
+  Sdlvideo.fill_rect ~rect: rect screen color';
+  Sdlvideo.update_rect ~rect: rect screen
+
+let load_maze screen maze =
+  let width = Maze.width maze and height = Maze.height maze in
+  let gray = (150, 150, 150) in
+  for x = 0 to width -1 do
+    for y = 0 to height - 1 do
+      let tile = Maze.get maze (x, y) in
+      let color = match tile with
+        | '@' -> Sdlvideo.red
+        | 'X' -> Sdlvideo.green
+        | '#' -> gray
+        | _ -> Sdlvideo.white
+      in
+      draw_tile screen x y color
+    done
+  done
+
+let draw_dot screen color maze (x, y) =
+  let shift = tilesize / 2 in
+  let half = shift / 2 in
+  if Maze.get maze (x, y) <> '#' then
+    let color' = Sdlvideo.map_RGB screen color in
+    let rect = Sdlvideo.rect (x * tilesize + half) (y * tilesize + half) shift shift in
+    Sdlvideo.fill_rect ~rect: rect screen color';
+    Sdlvideo.update_rect ~rect: rect screen
+
+let walk screen maze path =
+  List.iter (draw_dot screen Sdlvideo.blue maze) path
+
+let solve screen maze goal start =
+  let open Sdlevent in
+  let open Sdlkey in
+  let path = Astar.Pathfinding.find_path maze start goal in
+  walk screen maze path;
+  let rec loop () =
+    match wait_event () with
+    | KEYDOWN { keysym = KEY_ESCAPE } -> raise Escape
+    | KEYDOWN { keysym = KEY_SPACE } -> raise Break
+    | _ -> loop ()
+  in
+  try loop ()
+  with Break -> ()
+
+let rec interact screen maze goal start current =
+  let open Sdlevent in
+  let open Sdlkey in
+  draw_dot screen Sdlvideo.black maze current;
+  
+  let next = match wait_event () with
+    | KEYDOWN { keysym = KEY_ESCAPE } -> raise Escape
+    | KEYDOWN { keysym = KEY_SPACE } -> raise Break
+    | KEYDOWN { keysym = KEY_RIGHT } -> (fst current) +1, snd current
+    | KEYDOWN { keysym = KEY_LEFT } -> (fst current) -1, snd current
+    | KEYDOWN { keysym = KEY_UP } -> fst current, (snd current) -1
+    | KEYDOWN { keysym = KEY_DOWN } -> fst current, (snd current) +1
+    | _ -> current
+  in
+  if not (Maze.check maze next) || Maze.get maze next = '#' then begin
+    interact screen maze goal start current
+  end
+  else begin
+    let color = (0xff, 0xc6, 0x00) in
+    draw_dot screen color maze current;
+    if next = goal then raise Break
+    else interact screen maze goal start next
+  end
+
+let mainloop screen maze_width maze_height =
+  try
+    while true do
+      let maze, start, goal = Generator.generate maze_width maze_height in
+      load_maze screen maze;
+      try
+        interact screen maze goal start start
+      with Break -> solve screen maze goal start
+    done
+  with Escape -> ()
+
+let _ =
+  let width, height = 15, 11 in
+  Random.self_init ();
+  Sdl.init [`VIDEO];
+  at_exit Sdl.quit;
+  Sdlkey.enable_key_repeat ();
+  let screen = Sdlvideo.set_video_mode (width * tilesize) (height * tilesize) [] in
+  mainloop screen width height
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.