Commits

Philip Xu  committed ed0ef59

Added module Game

  • Participants
  • Parent commits 19cbf52

Comments (0)

Files changed (2)

+(*
+ * Copyright (c) 2014, Philip Xu <pyx@xrefactor.com>
+ * All rights reserved.
+ * License: BSD New, see LICENSE for details.
+ *)
+
+type move = Up | Down | Left | Right
+
+type action = Move of move | Reset | Quit | Invalid
+
+type state = Playing | Win | Lose
+
+type t = state * Board.t
+
+module Monad = struct
+  let return board = (Playing, board)
+  let bind game action =
+    match game with
+    | (Playing, board) -> action board
+    | game -> game
+end
+
+module Infix = struct
+  let ( >>= ) = Monad.bind
+end
+
+let get_state (state, _) = state
+let get_board (_, board) = board
+
+let winning_number = 2048
+
+let playing = Monad.return
+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 move_available board =
+  let open Board in
+  has_empty_cell board ||
+  move_up board <> board ||
+  move_down board <> board ||
+  move_left board <> board ||
+  move_right board <> board
+
+let check board =
+  if Board.contains winning_number board then
+    win board
+  else if move_available board then
+    playing board
+  else
+    lose board
+
+let play movement board =
+  let board' = movement board in
+  let not_changed = board = board' in
+  if not_changed then
+    playing board
+  else let open Infix in
+    playing board' >>= spawn >>= check
+
+let move m game =
+  let open Infix in
+  let action = match m with
+  | Up -> Board.move_up
+  | Down -> Board.move_down
+  | Left -> Board.move_left
+  | Right -> Board.move_right
+  in game >>= play action
+
+let init x y =
+  Random.self_init ();
+  let board = Board.init x y in
+  let open Infix in
+  playing board >>= spawn >>= spawn

File src/game.mli

+(*
+ * Copyright (c) 2014, Philip Xu <pyx@xrefactor.com>
+ * All rights reserved.
+ * License: BSD New, see LICENSE for details.
+ *)
+
+(** Module Game.
+
+    Game logic of 2048.
+ *)
+
+type move = Up | Down | Left | Right
+(** Type of game movement. *)
+
+type action = Move of move | Reset | Quit | Invalid
+(** Type of game action. *)
+
+type state = Playing | Win | Lose
+(** Type of game state. *)
+
+type t
+(** Abstract type of game. *)
+
+(** Monadic interface of game. *)
+module Monad : sig
+  val return : Board.t -> t
+  (** [return b] creates a game with game board [b]. *)
+
+  val bind : t -> (Board.t -> t) -> t
+  (** [bind g f] plays action [f] on game [g], returns resulting game. *)
+end
+
+(** Monadic bind operator of game. *)
+module Infix : sig
+  val ( >>= ) : t -> (Board.t -> t) -> t
+  (** [g >>= f] plays action [f] on game [g], returns resulting game. *)
+end
+
+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 get_board : t -> Board.t
+(** [get_board g] returns game board of game [g]. *)
+
+val lose : Board.t -> t
+(** [lose b] makes a lose game with game board [b]. *)
+
+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 move : move -> t -> t
+(** [move m g] plays movement [m] on game [g]. *)