This is a maze game, implemented in four phases:
U) can move around in the maze.#) of the maze.T) who seek the player and move a wall when the player does.The challenge is described in detail here.
I worked on this project to play around with OCaml, but it turned out to require a priority queue and a path-finding algorithm. Here are some resources I used:
| Random.self_init();; | |
| let map = [| | |
| "#########################################################################"; | |
| "# # # # # # #"; | |
| "# # ######### # ##### ######### ##### ##### ##### # #"; | |
| "# # # # # # # # # #"; | |
| "######### # ######### ######### ##### # # # ######### #"; | |
| "# # # # # # # # # # #"; | |
| "# # ############# # # ######### ##### # ######### # #"; | |
| "# # # # # # # # # #"; | |
| "# ############# ##### ##### # ##### ######### # ##### #"; | |
| "# # # # # # # # # #"; | |
| "# ##### ##### # ##### # ######### # # # #############"; | |
| "# # # # # # # # # # # #"; | |
| "############# # # # ######### # ##### # ##### ##### #"; | |
| "# # # # # # # # # #"; | |
| "# ##### # ######### ##### # ##### ##### ############# #"; | |
| "# # # # # # # # # #"; | |
| "# # ######### # ##### ######### # # ############# # #"; | |
| "# # # # # # # # # # #"; | |
| "# ######### # # # ##### ######### ######### # #########"; | |
| "# # # # # # # # # #"; | |
| "# # ##### ##### ##### ######### ##### # ######### # #"; | |
| "# # # # # # #"; | |
| "# X #####################################################################"; | |
| |];; | |
| module Vector = struct | |
| type t = Vector of (int * int) | |
| let compare (Vector(x1, y1)) (Vector(x2, y2)) = | |
| match Pervasives.compare x1 x2 with | |
| | 0 -> Pervasives.compare y1 y2 | |
| | c -> c | |
| let add (Vector(x1, y1)) (Vector(x2, y2)) = Vector(x1+x2, y1+y2) | |
| end | |
| module VectorMap = Map.Make(Vector);; | |
| module VectorSet = Set.Make(Vector) | |
| module VectorPair = struct | |
| type t = (Vector.t * Vector.t) | |
| let compare (v1, v2) (v3, v4) = | |
| if (v1, v2) = (v3, v4) || (v2, v1) = (v3, v4) then 0 | |
| else | |
| match Vector.compare v1 v3 with | |
| | 0 -> Vector.compare v2 v4 | |
| | c -> c | |
| end;; | |
| module VectorPairSet = Set.Make(VectorPair) | |
| type entity = { | |
| position: Vector.t; | |
| velocity: Vector.t; | |
| } | |
| type state = { | |
| character: entity; | |
| wall_moved: bool; | |
| trolls: entity list; | |
| map: string array; | |
| over: bool; | |
| };; | |
| (* Utility functions *) | |
| let empty_map width height = | |
| let rec aux h = | |
| if h = 0 then [] else (String.make width '#') :: aux (h-1) in | |
| Array.of_list (aux height);; | |
| let print_map map = | |
| Array.iter (function line -> Printf.printf "%s\n" line) map;; | |
| let replace_char s i c = | |
| let f i' c' = if i = i' then c else c' in | |
| String.mapi f s;; | |
| let replace_cell map (Vector.Vector(x, y)) c' = | |
| Array.mapi (fun i -> fun row -> | |
| if y = i then replace_char row x c' else row) map;; | |
| (* Pairing min heap *) | |
| type 'a pairing_heap = | |
| | Empty | |
| | PairingHeap of (int * 'a) * 'a pairing_heap list;; | |
| module PairingHeap = | |
| struct | |
| type priority = int | |
| type 'a heap = 'a pairing_heap | |
| let merge this that = | |
| match this with | |
| | PairingHeap((this_priority, this_value), this_children) -> | |
| (match that with | |
| | PairingHeap((that_priority, that_value), that_children) -> | |
| (if this_priority < that_priority then | |
| PairingHeap((this_priority, this_value), that :: this_children) | |
| else | |
| PairingHeap((that_priority, that_value), this :: that_children)) | |
| | Empty -> this) | |
| | Empty -> that | |
| let insert heap priority value = | |
| merge heap (PairingHeap((priority, value), []));; | |
| let rec merge_pairs = function | |
| | [] -> Empty | |
| | first :: [] -> first | |
| | first :: second :: rest -> | |
| merge (merge first second) (merge_pairs rest);; | |
| let min = function | |
| | PairingHeap((priority, value), children) -> Some value | |
| | Empty -> None | |
| let remove_min = function | |
| | PairingHeap((priority, value), children) -> merge_pairs children | |
| | Empty -> Empty;; | |
| end;; | |
| (* Best-first search implementation so the trolls can find the player *) | |
| let neighbors map (Vector.Vector(x, y)) = | |
| let width, height = String.length map.(0), Array.length map in | |
| let in_map (Vector.Vector(x, y)) = x > 0 && x < width && y > 0 && y < height in | |
| let is_wall (Vector.Vector(x, y)) = (map.(y)).[x] = '#' in | |
| let l = [Vector.Vector(x, y-1); Vector.Vector(x-1, y); Vector.Vector(x, y+1); Vector.Vector(x+1, y)] in | |
| List.filter (fun n -> (in_map n) && (not (is_wall n))) l;; | |
| let distance (Vector.Vector(x1, y1)) (Vector.Vector(x2, y2)) = | |
| int_of_float (sqrt (((float_of_int (x2 - x1)) ** 2.0) +. ((float_of_int (y2 - y1)) ** 2.0)));; | |
| let find_path map troll player = | |
| let q = PairingHeap.insert Empty 0 troll in | |
| let rec best_first q seen parents = | |
| if (VectorSet.mem player seen) then Some parents | |
| else | |
| match PairingHeap.min q with | |
| | Some(current) -> | |
| let ns = neighbors map current in | |
| let q' = List.fold_left (fun q -> fun n -> | |
| if (VectorSet.mem n seen) then q | |
| else PairingHeap.insert q (distance n player) n) | |
| (PairingHeap.remove_min q) | |
| ns in | |
| let parents' = List.fold_left (fun parents -> fun n -> | |
| if (VectorSet.mem n seen) then parents else VectorMap.add n current parents) | |
| parents | |
| ns in | |
| let seen' = List.fold_left (fun parents -> fun n -> VectorSet.add n parents) seen ns in | |
| best_first q' seen' parents' | |
| | None -> None in | |
| match best_first q (VectorSet.add troll VectorSet.empty) VectorMap.empty with | |
| | Some(parents) -> | |
| let rec trace current = | |
| match VectorMap.find current parents with | |
| | next when next = troll -> [current; troll] | |
| | next -> current :: (trace next) in | |
| Some (trace player) | |
| | None -> None;; | |
| (* Maze generation using recursive backtracking *) | |
| let shuffle ls = | |
| List.sort (fun x -> fun y -> Random.int(3) - 1) ls;; | |
| let path_neighbors width height c = | |
| let ds = [ | |
| Vector.Vector(0, 2); | |
| Vector.Vector(2, 0); | |
| Vector.Vector(0, -2); | |
| Vector.Vector(-2, 0); | |
| ] in | |
| let ns = List.map (Vector.add c) ds in | |
| List.filter (fun (Vector.Vector(nx, ny)) -> | |
| nx >= 0 && nx < width && ny >= 0 && ny < height) ns;; | |
| let between p1 (Vector.Vector(x2, y2)) = match p1 with (Vector.Vector(x1, y1)) -> | |
| let dist_to_middle = (Vector.Vector((x2-x1)/2, (y2-y1)/2)) in | |
| Vector.add p1 dist_to_middle;; | |
| let print_edge_set edges = | |
| Printf.printf "{\n"; | |
| VectorPairSet.iter (fun (Vector.Vector(x1, y1), Vector.Vector(x2, y2)) -> | |
| Printf.printf " (%d, %d)-(%d, %d),\n" x1 y1 x2 y2) edges; | |
| Printf.printf "}\n"; | |
| ;; | |
| let rec choose_paths dims start vertices edges parent c = match c with Vector.Vector(cx, cy) -> | |
| if VectorSet.mem c vertices then (vertices, edges) | |
| else | |
| let width, height = dims in | |
| let ns = shuffle (path_neighbors width height c) in | |
| let vertices' = VectorSet.add c vertices in | |
| let edges' = | |
| match parent with | |
| | Some(parent) -> VectorPairSet.add (parent, c) edges | |
| | None -> edges in | |
| let unseen = List.filter (fun n -> not (VectorSet.mem n vertices)) ns in | |
| let vertices'', edges'' = List.fold_left (fun (vacc, eacc) -> fun n -> | |
| let vacc', eacc' = choose_paths dims start vacc eacc (Some c) n in | |
| (VectorSet.union vacc vacc', VectorPairSet.union eacc eacc')) (vertices', edges') unseen in | |
| (vertices'', edges'') | |
| ;; | |
| let rec carve_paths map edges = | |
| if VectorPairSet.is_empty edges then map | |
| else | |
| let (p1, p2) = VectorPairSet.choose edges in | |
| let middle = between p1 p2 in | |
| let map' = List.fold_left (fun acc -> fun c -> replace_cell acc c ' ') map [p1; p2; middle] in | |
| carve_paths map' (VectorPairSet.remove (p1, p2) edges);; | |
| (* Game implementation *) | |
| let apply_state {map; wall_moved; trolls; character; over} = | |
| let cx, cy = match character.position with Vector.Vector(x, y) -> x, y in | |
| Array.mapi (function i -> function row -> | |
| if (i = cy) then | |
| replace_char row cx 'U' | |
| else | |
| let ts = List.filter (fun { position; velocity } -> | |
| match position with Vector.Vector(tx, ty) -> i = ty) trolls in | |
| match ts with | |
| | [] -> row | |
| | _ -> List.fold_left (fun acc -> fun { position; velocity } -> | |
| match position with Vector.Vector(tx, ty) -> | |
| replace_char acc tx 'T') row ts) map;; | |
| let touches_wall map = function Vector.Vector(x, y) -> | |
| x < 0 || y >= (Array.length map) || y < 0 || y >= (String.length map.(0)) || map.(y).[x] = '#';; | |
| let is_done { map; wall_moved; trolls; character; over } = | |
| let Vector.Vector(x, y) = character.position in | |
| over || map.(y).[x] = 'X';; | |
| let maybe_move_wall map here delta = | |
| let there = Vector.add here delta in | |
| if touches_wall map there then None | |
| else let Vector.Vector(x, y), Vector.Vector(x', y') = here, there in | |
| Some (Array.mapi (function i -> | |
| function row -> | |
| if i = y && i = y' then replace_char (replace_char row x ' ') x' '#' | |
| else if i = y then replace_char row x ' ' | |
| else if i = y' then replace_char row x' '#' | |
| else row) map);; | |
| let move_character velocity' {map; wall_moved; trolls; character; over} = | |
| let { position; velocity; } = character in | |
| let position' = Vector.add position velocity' in | |
| if touches_wall map position' then | |
| match (maybe_move_wall map position' velocity') with | |
| | Some map -> | |
| let character = { | |
| position = position'; | |
| velocity = velocity'; } in | |
| let over = is_done { map; wall_moved; trolls; character; over } in | |
| { map; wall_moved; trolls; character; over; } | |
| | None -> | |
| let over = is_done { map; wall_moved; trolls; character; over } in | |
| { map; wall_moved; trolls; character; over; } | |
| else | |
| let character = { position = position'; velocity = velocity; } in | |
| let over = is_done { map; wall_moved; trolls; character; over; } in | |
| { map; wall_moved; trolls; character; over; };; | |
| let character_up = move_character (Vector.Vector(0, -1));; | |
| let character_down = move_character (Vector.Vector(0, 1));; | |
| let character_left = move_character (Vector.Vector(-1, 0));; | |
| let character_right = move_character (Vector.Vector(1, 0));; | |
| let move_trolls { character; wall_moved; trolls; map; over } = | |
| let trolls' = List.map (fun { position; velocity } -> | |
| (*let position' = List.hd (find_path map position character.position) in*) | |
| let path = find_path map position character.position in | |
| let position' = | |
| match path with | |
| | Some(path) -> List.hd (List.tl (List.rev path)) | |
| | None -> position | |
| in | |
| { position = position'; velocity = velocity }) trolls in | |
| begin | |
| List.iter (fun { position; velocity } -> | |
| match position with Vector.Vector(x, y) -> | |
| Printf.printf "(%d, %d)\n" x y) | |
| trolls'; | |
| { | |
| character = character; | |
| wall_moved = wall_moved; | |
| trolls = trolls'; | |
| map = map; | |
| over = over | |
| } | |
| end;; | |
| let rec find_home map = | |
| let height = Array.length map in | |
| let width = String.length map.(0) in | |
| let h = Vector.Vector(Random.int(width), Random.int(height)) in | |
| if touches_wall map h then find_home map | |
| else h;; | |
| let spawn_entity map = | |
| { position = find_home map; velocity = Vector.Vector(0, 0) };; | |
| let rec spawn_trolls map n = | |
| if n = 0 then [] | |
| else (spawn_entity map) :: spawn_trolls map (n-1);; | |
| let spawn_character = spawn_entity;; | |
| let rec play state = | |
| print_map (apply_state state); | |
| if state.over then state | |
| else | |
| let { map; wall_moved; trolls; character; over } = state in | |
| let state' = match read_line () with | |
| | "w" -> character_up state | |
| | "a" -> character_left state | |
| | "s" -> character_down state | |
| | "d" -> character_right state | |
| | ":q" -> let over = true in { map; wall_moved; trolls; character; over } | |
| | _ -> state in | |
| let state'' = move_trolls state' in | |
| play state'';; | |
| let round_to_odd n = if n mod 2 = 0 then n - 1 else n;; | |
| let start_time = Sys.time () in | |
| let dims = (100, 50) in | |
| let dims = match dims with (width, height) -> | |
| (round_to_odd width, round_to_odd height) in | |
| let width, height = dims in | |
| let start = Vector.Vector(Random.int(width/2)*2, Random.int(height/2)*2) in | |
| let vertices, edges = choose_paths dims start VectorSet.empty VectorPairSet.empty None start in | |
| let map = replace_cell (carve_paths (empty_map width height) edges) start 'X' in | |
| let gentime = (Sys.time ()) -. start_time in | |
| let character = spawn_character map in | |
| let ntrolls = (int_of_float (sqrt ((float_of_int (width+height)) /. 2.0))) in | |
| let state = | |
| { | |
| map = map; | |
| wall_moved = false; | |
| trolls = spawn_trolls map ntrolls; | |
| character = character; | |
| over = false | |
| } in | |
| begin | |
| Printf.printf "Generated %dx%d maze in %f seconds.\n" width height gentime; | |
| Printf.printf "Spawned %d trolls.\n" ntrolls; | |
| play state | |
| end |