1. Philip Xu
  2. 2048-ml

Commits

Philip Xu  committed d036905

Added game score and move count

Yes, with half-baked Writer Monad...

  • Participants
  • Parent commits 96c2090
  • Branches default

Comments (0)

Files changed (8)

File src/board.ml

View file
  • Ignore whitespace
  * License: BSD New, see LICENSE for details.
  *)
 
-type elt = int
-type t = elt array array
+type count = int
+type score = int
+type t = Grid.t * count * score
 
-let empty = 0
+let init x y = Grid.init x y, 0, 0
 
-(* Note: matrix created by make_matrix is transposed, that's why y, x here *)
-let init x y = Array.make_matrix y x empty
-let get x y board = board.(y).(x)
-let set x y e board = board.(y).(x) <- e; board
+let grid (g, _, _) = g
+let count (_, c, _) = c
+let score (_, _, s) = s
 
-let size board = Array.length board.(0), Array.length board
+let move_and_score move (grid, count, score) =
+  let sum = List.fold_left (+) 0 in
+  let grid', removed = move grid in
+  let score' = List.flatten removed |> sum in
+  let is_changed = score' <> 0 || grid' <> grid in
+  grid', (if is_changed then succ count else count), score + score'
 
-let to_list board =
-  board
-  |> Array.map Array.to_list
-  |> Array.to_list
+let move_left = move_and_score Grid.move_left
+let move_right = move_and_score Grid.move_right
+let move_up = move_and_score Grid.move_up
+let move_down = move_and_score Grid.move_down
 
-let contains e board =
-  board
-  |> to_list
-  |> List.flatten
-  |> List.mem e
-
-let has_empty_cell = contains empty
-
-let empty_cells_to_index =
-  Array.mapi (fun y ->
-    Array.mapi (fun x cell ->
-      if cell = empty then Some (x, y) else None))
-
-let filter_some =
-  let rec loop acc = function
-    | [] -> acc
-    | None :: tl -> loop acc tl
-    | Some e :: tl -> loop (e :: acc) tl
-  in loop []
-
-let empty_cells board =
-  board
-  |> empty_cells_to_index
-  |> to_list
-  |> List.flatten
-  |> filter_some
-
-let rec merge = function
-  | x :: y :: t when x = y -> x + y :: merge t
-  | h :: t -> h :: merge t
-  | [] -> []
-
-let remove_empty = List.filter ((<>) empty)
-
-let take n row = Array.sub row 0 n
-
-let merge_left row =
-  let orig_len = Array.length row in
-  let padding = Array.make orig_len empty in
-  let add_padding = fun row -> Array.append row padding in
-  row
-  |> Array.to_list
-  |> remove_empty
-  |> merge
-  |> Array.of_list
-  |> add_padding
-  |> take orig_len
-
-let merge_right row =
-  let reverse r = r |> Array.to_list |> List.rev |> Array.of_list in
-  row |> reverse |> merge_left |> reverse
-
-let transpose board =
-  let dim_x, dim_y = size board in
-  let board' = init dim_y dim_x in
-  for x = 0 to pred dim_x do
-    for y = 0 to pred dim_y do
-      set y x (get x y board) board' |> ignore
-    done;
-  done;
-  board'
-
-let move_left = Array.map merge_left
-
-let move_right = Array.map merge_right
-
-let move_up board =
-  board |> transpose |> move_left |> transpose
-
-let move_down board =
-  board |> transpose |> move_right |> transpose
-
-let move_available board =
-  has_empty_cell board ||
-  move_up board <> board ||
-  move_down board <> board ||
-  move_left board <> board ||
-  move_right board <> board
+let spawn (grid, count, score) =
+  let empty_cells = Grid.empty_cells grid in
+  let num_of_empty_cells = List.length empty_cells in
+  if num_of_empty_cells <> 0 then
+    let n = Random.int num_of_empty_cells in
+    let x, y = List.nth empty_cells n in
+    let num = if (Random.int 10 = 0) then 4 else 2 in
+    (Grid.set x y num grid, count, score)
+  else
+    (grid, count, score)

File src/board.mli

View file
  • Ignore whitespace
     Represents game board.
  *)
 
-type elt = int
-(** Element of cell. *)
-
 type t
-(** Type of game board. *)
+(** Abstract type of game board. *)
 
 val init : int -> int -> t
-(** [init x y] creates a new board with size [x] by [y]. *)
+(** [init x y] creates a new game board with grid of size [x] by [y]. *)
 
-val get : int -> int -> t -> elt
-(** [get x y b] returns the element at [x], [y] on [b]. *)
+val grid : t -> Grid.t
+(** [grid b] returns the grid associated with game board [b]. *)
 
-val set : int -> int -> elt -> t -> t
-(** [set x y e b] returns a copy of [b] with [e] set to [x], [y]. *)
+val count : t -> int
+(** [count b] returns move count played so far on game board [b]. *)
 
-val size : t -> int * int
-(** [size b] returns dimension of [b] as tuple [(x, y)]. *)
-
-val to_list : t -> elt list list
-(** [to_list b] creates a list of lists of [elt] from [b]. *)
-
-val contains : elt -> t -> bool
-(** [contains e b] returns true if [b] contains [e]. *)
-
-val has_empty_cell : t -> bool
-(** [has_empty_cell e] returns true if [b] has any empty cell. *)
-
-val empty_cells : t -> (int * int) list
-(** [empty_cells b] returns a list of indices of all empty cells on [b]. *)
+val score : t -> int
+(** [score b] returns the scoreof game board [b] so far . *)
 
 val move_left : t -> t
-(** [move_left b] returns a new board as [b] being moved left. *)
+(** [move_left b] moves [b] left and returns a new board as result. *)
 
 val move_right : t -> t
-(** [move_right b] returns a new board as [b] being moved right. *)
+(** [move_left b] moves [b] left and returns a new board as result. *)
 
 val move_up : t -> t
-(** [move_up b] returns a new board as [b] being moved up. *)
+(** [move_left b] moves [b] left and returns a new board as result. *)
 
 val move_down : t -> t
-(** [move_down b] returns a new board as [b] being moved down. *)
+(** [move_left b] moves [b] left and returns a new board as result. *)
 
-val move_available : t -> bool
-(** [move_available b] returns true if any cell on [b] is possible to move *)
+val spawn : t -> t
+(** [spawn b] returns a new board with an element randomly added on [b]. *)

File src/game.ml

View file
  • Ignore whitespace
   let ( >>= ) = Monad.bind
 end
 
-let get_state (state, _) = state
-let get_board (_, board) = board
+let state (s, _) = s
+let board (_, b) = b
+let count (_, b) = Board.count b
+let score (_, b) = Board.score b
 
 let winning_number = 2048
 
 let lose board = (Lose, board)
 let win board = (Win, board)
 
-let spawn board =
-  let empty_cells = Board.empty_cells board in
-  let num_of_empty_cells = List.length empty_cells in
-  if num_of_empty_cells = 0 then
-    playing board
-  else
-    let n = Random.int num_of_empty_cells in
-    let x, y = List.nth empty_cells n in
-    let num = if (Random.int 10 = 0) then 4 else 2 in
-    playing (Board.set x y num board)
-
 let check board =
-  if Board.contains winning_number board then
+  let grid = Board.grid board in
+  if Grid.contains winning_number grid then
     win board
-  else if Board.move_available board then
+  else if Grid.move_available grid then
     playing board
   else
     lose board
 
+let spawn board = playing (Board.spawn board)
+
 let play movement board =
   let board' = movement board in
   let not_changed = board = board' in

File src/game.mli

View file
  • Ignore whitespace
 val init : int -> int -> t
 (** [init x y] creates a new game with game board of size [x] by [y]. *)
 
-val get_state : t -> state
-(** [get_state g] returns game state of game [g]. *)
+val state : t -> state
+(** [state g] returns game state of game [g]. *)
 
-val get_board : t -> Board.t
-(** [get_board g] returns game board of game [g]. *)
+val board : t -> Board.t
+(** [board g] returns game board of game [g]. *)
 
-val lose : Board.t -> t
-(** [lose b] makes a lose game with game board [b]. *)
+val count : t -> int
+(** [count g] returns move count of game [g] so far. *)
 
-val win : Board.t -> t
-(** [win b] makes a lose game with game board [b]. *)
-
-val spawn : Board.t -> t
-(** [spawn b] returns a game with an element added randomly
-    in empty cell on game board [b].
- *)
-
-val check : Board.t -> t
-(** [check b] checks and update game state with game board [b]. *)
+val score : t -> int
+(** [score g] returns score of game [g] so far. *)
 
 val move : move -> t -> t
 (** [move m g] plays movement [m] on game [g]. *)

File src/grid.ml

View file
  • Ignore whitespace
+(*
+ * Copyright (c) 2014, Philip Xu <pyx@xrefactor.com>
+ * All rights reserved.
+ * License: BSD New, see LICENSE for details.
+ *)
+
+type elt = int
+type t = elt array array
+
+let empty = 0
+
+(* Note: matrix created by make_matrix is transposed, that's why y, x here *)
+let init x y = Array.make_matrix y x empty
+let get x y grid = grid.(y).(x)
+let set x y e grid = grid.(y).(x) <- e; grid
+
+let size grid = Array.length grid.(0), Array.length grid
+
+let to_list grid = grid |> Array.map Array.to_list |> Array.to_list
+
+let contains e grid = grid |> to_list |> List.flatten |> List.mem e
+
+let has_empty_cell = contains empty
+
+let empty_cells_to_index =
+  Array.mapi (fun y ->
+    Array.mapi (fun x cell ->
+      if cell = empty then Some (x, y) else None))
+
+let filter_some =
+  let rec loop acc = function
+    | [] -> acc
+    | None :: tl -> loop acc tl
+    | Some e :: tl -> loop (e :: acc) tl
+  in loop []
+
+let empty_cells grid =
+  grid |> empty_cells_to_index |> to_list |> List.flatten |> filter_some
+
+let merge =
+  let rec loop acc removed = function
+    | x :: y :: t when x = y -> loop (x + y :: acc) (x :: y :: removed) t
+    | h :: t -> loop (h :: acc) removed t
+    | [] -> List.rev acc, List.rev removed
+  in loop [] []
+
+let merge_left row =
+  let orig_len = Array.length row in
+  let padding = Array.make orig_len empty in
+  let remove_empty = List.filter ((<>) empty) in
+  let add_padding = fun row -> Array.append row padding in
+  let take n row = Array.sub row 0 n in
+  let row', removed = Array.to_list row |> remove_empty |> merge in
+  Array.of_list row' |> add_padding |> take orig_len, removed
+
+let merge_right row =
+  let reverse r = r |> Array.to_list |> List.rev |> Array.of_list in
+  let row', removed = reverse row |> merge_left in
+  reverse row', removed
+
+let transpose grid =
+  let dim_x, dim_y = size grid in
+  let grid' = init dim_y dim_x in
+  for x = 0 to pred dim_x do
+    for y = 0 to pred dim_y do
+      set y x (get x y grid) grid' |> ignore
+    done;
+  done;
+  grid'
+
+let move_with merge grid =
+  let rows, removed = Array.map merge grid |> Array.to_list |> List.split in
+  Array.of_list rows, removed
+
+let move_left = move_with merge_left
+
+let move_right = move_with merge_right
+
+let move_up grid =
+  let grid', removed = grid |> transpose |> move_left in
+  transpose grid', removed
+
+let move_down grid =
+  let grid', removed = grid |> transpose |> move_right in
+  transpose grid', removed
+
+let move_available grid =
+  has_empty_cell grid ||
+  fst (move_left grid) <> grid ||
+  fst (move_right grid) <> grid ||
+  fst (move_up grid) <> grid ||
+  fst (move_down grid) <> grid

File src/grid.mli

View file
  • Ignore whitespace
+(*
+ * Copyright (c) 2014, Philip Xu <pyx@xrefactor.com>
+ * All rights reserved.
+ * License: BSD New, see LICENSE for details.
+ *)
+
+(** Module Grid.
+
+    Represents grid of game board.
+ *)
+
+type elt = int
+(** Element of cell. *)
+
+type t
+(** Abstract type of grid. *)
+
+val init : int -> int -> t
+(** [init x y] creates a new grid with size [x] by [y]. *)
+
+val get : int -> int -> t -> elt
+(** [get x y g] returns the element at [x], [y] on grid [g]. *)
+
+val set : int -> int -> elt -> t -> t
+(** [set x y e g] returns a copy of grid [g] with [e] set to [x], [y]. *)
+
+val size : t -> int * int
+(** [size g] returns dimension of grid [g] as tuple [(x, y)]. *)
+
+val to_list : t -> elt list list
+(** [to_list g] creates a list of lists of [elt] from [g]. *)
+
+val contains : elt -> t -> bool
+(** [contains e g] returns true if grid [g] contains element [e]. *)
+
+val has_empty_cell : t -> bool
+(** [has_empty_cell e] returns true if grid [g] has any empty cell. *)
+
+val empty_cells : t -> (int * int) list
+(** [empty_cells g] returns a list of indices of all empty cells on [g]. *)
+
+val move_left : t -> t * elt list list
+(** [move_left g] returns tuple (grid, remved) as [g] being moved left. *)
+
+val move_right : t -> t * elt list list
+(** [move_right g] returns tuple (grid, removed) as [g] being moved right. *)
+
+val move_up : t -> t * elt list list
+(** [move_up g] returns tuple (grid, removed) as [g] being moved up. *)
+
+val move_down : t -> t * elt list list
+(** [move_down g] returns tuple (grid, removed) as [g] being moved down. *)
+
+val move_available : t -> bool
+(** [move_available g] returns true if any cell on [g] is possible to move *)

File src/gui.ml

View file
  • Ignore whitespace
  *)
 
 open Graphics
-open Game
 
 let side = 80
 let margin = side
 let line_width = side / 10
 
 let window_size game =
-  let x, y = Board.size (get_board game) in
+  let x, y = game |> Game.board |> Board.grid |> Grid.size in
   let margins = margin + margin in
   x * side + margins, y * side + margins
 
 let frame_color = 0xbbada0
 let info_color = 0x201403
+let stat_color = 0x8b0000
 
 let get_colors = function
   | 2    -> 0x776e65, 0xeee4da
   if cell <> 0 then draw_centered_text x y side side text
 
 let draw_board board =
-  let dim_x, dim_y = Board.size board in
-  for x = 0 to pred dim_x do
-    for y = 0 to pred dim_y do
-      let cord_x, cord_y = x * side + margin, y * side + margin in
-      let cell = Board.get x (pred dim_y - y) board in
-      draw_cell cord_x cord_y cell
-    done;
-  done
+  let grid = Board.grid board in
+  let _, dim_y = Grid.size grid in
+  let cord_x x = x * side + margin in
+  let cord_y y = (pred dim_y - y) * side + margin in
+  grid
+  |> Grid.to_list
+  |> List.iteri (fun y ->
+      List.iteri (fun x cell ->
+        draw_cell (cord_x x) (cord_y y) cell))
 
 let draw_info game =
   let width, height = window_size game in
-  let info = "2048 in OCaml " ^ version ^ ", r to reset, q or <ESC> to quit" in
+  let ver = Game.version in
+  let info = "2048 in OCaml " ^ ver ^ ", r to reset, q or <ESC> to quit" in
+  let score = Game.score game |> string_of_int in
+  let count = Game.count game |> string_of_int in
+  let stat = "Score: " ^ score ^ " / Move: " ^ count in
+  set_color stat_color;
+  draw_centered_text 0 (height - margin) width (margin / 2) stat;
   set_color info_color;
-  draw_centered_text 0 (height - margin) width margin info;
+  draw_centered_text 0 (height - margin / 2) width (margin / 2) info;
   let sign = "Copyright (c) 2014 pyx." in
   let offset, _ = text_size sign in
   moveto (width - offset - 2) 2;
   draw_string sign;
   let draw_text = draw_centered_text 0 0 width margin in
-  match get_state game with
+  let open Game in
+  match state game with
   | Win -> draw_text "You win!"
   | Lose -> draw_text "You lose."
   | Playing -> draw_text "h j k l to move left, down, up, right respectively"
   resize_window width height
 
 let render game =
-  let board = get_board game in
+  let board = Game.board game in
   auto_synchronize false;
   clear_graph ();
   draw_board board;

File src/tui.ml

View file
  • Ignore whitespace
  * License: BSD New, see LICENSE for details.
  *)
 
-open Game
-
 let init _ =
   print_endline "Copyright (c) 2014, Philip Xu <pyx@xrefactor.com>";
   print_endline "All rights reserved. With BSD New License.";
-  print_endline @@ "2048 in OCaml, Version " ^ version
+  print_endline @@ "2048 in OCaml, Version " ^ Game.version
 
 let repeat n a =
   let rec loop n acc =
   | 0 -> print_string "|    "
   | n -> Printf.printf "|%4d" n
 
-let draw_board_text board =
-  let board' = Board.to_list board in
-  let row_len = fst (Board.size board) in
-  let hr = make_banner row_len in
+let draw_stat board =
+  let score = Board.score board in
+  let count = Board.count board in
+  Printf.printf "Score: %d / Move: %d\n" score count
+
+let draw_board board =
+  let grid = Board.grid board in
+  let x, _ = Grid.size grid in
+  let hr = make_banner x in
   let draw_row row =
     print_endline hr;
     List.iter draw_cell row;
     print_endline "|"
   in
-  List.iter draw_row board';
+  draw_stat board;
+  List.iter draw_row (Grid.to_list grid);
   print_endline hr
 
 let render game =
   print_endline "r to reset, q or <ESC> to quit";
-  draw_board_text (get_board game);
-  match get_state game with
+  draw_board (Game.board game);
+  let open Game in
+  match state game with
   | Win -> print_endline "You win!"
   | Lose -> print_endline "You lose."
   | Playing ->