2048 in reasonml

_game_2048.re

type direction =
  | Up
  | Down
  | Left
  | Right;

type action =
  | NewGame
  | Move(direction)
  | Add(int, int, option(int))
  | AddRandom
  | GameOver;

type state = {
  board_size: int,
  score: int,
  last_delta_score: int,
  step: int,
  turn: bool,
  board: array(array(option(int))),
  ended: bool,
};

let component = ReasonReact.reducerComponent("Game_2048");

module Matrix = {
  /* let map_ = (raw_map, f, m) => {
    raw_map((m) => raw_map(f, m), m)
  };
  let map = (f, m) => map_(Array.map, f, m); */
  let map = (f, m) => {
    let raw_map = Array.map;
    raw_map((m) => raw_map(f, m), m)
  };
  let where = (f, m) => {
    let raw_fold = BatArray.fold_lefti;
    raw_fold((r, x, l) => raw_fold((r, y, i) => switch (f(i)) {
      | true => [(x,y), ...r]
      | false => r
    }, r, l), [], m)
  };
};

module ScoreBoard = {
  let component = ReasonReact.statelessComponent("Game_2048_ScoreBoard");
  let make = (~score, ~last_delta_score, _children) => {
    ...component,
    render: (_self) => {
      let delta = if (last_delta_score<0) { {j|$last_delta_score|j} } else { {j|+$last_delta_score|j} };
      <div> (ReasonReact.stringToElement({j|score: $score ($delta)|j})) </div>
    }
  };
};

module GameBoard = {
  module Cell = {
    let component = ReasonReact.statelessComponent("Game_2048_GameBoard_Cell");
    let make = (~x, ~y, ~p, _children) => {
      ...component,
      render: (_self) => {
        let (class_, text, background) = switch p {
          | Some(t) => {
            ({j|gameboard_cell gameboard_cell_$t|j}, {j|$t|j}, switch t {
              | t when t <= 7 => { let i = Pervasives.float(t)/.8.0; {j|rgba(255,255,0, $i)|j}}
              | t when t <= 15 => { let i = Pervasives.float(t)/.16.0; {j|rgba(0,0,255, $i)|j}}
              | _ => "#202020"
            })
          }
          | None => ({j|gameboard_cell gameboard_cell_empty|j}, "", "#C0C0C0")
        };
        let style = ReactDOMRe.Style.make(~width="100px", ~height="100px", ~background={j|$background|j},
                        ~textAlign="center", ~fontSize="30px", ~fontFamily="sans-serif", ());
        <td style=(style) className=(class_) id=({j|board_cell_$(x)_$(y)|j})>
          (ReasonReact.stringToElement(text))
        </td>
      }
    }
  };

  let component = ReasonReact.statelessComponent("Game_2048_GameBoard");
  let make = (~board_size, ~board, _children) => {
    ...component,
    render: (_self) => {
      let _board_size = board_size;
      let board_elements = board |> Array.mapi((x, ln) =>
        <tr key=({j|board_ln_$x|j})>
          (ln
            |> Array.mapi((y, i) => <Cell x y p=(i) key=({j|board_cell_$(x)_$(y)|j}) />)
            |> ReasonReact.arrayToElement)
        </tr>);
      <table> <tbody> (board_elements |> ReasonReact.arrayToElement) </tbody> </table>
    }
  };
};

module InputArea = {
  let component = ReasonReact.statelessComponent("Game_2048_InputArea");
  let make = (~onMove, _children) => {
    let handleInput = (event, _self) => {
      let charCode = ReactDOMRe.domElementToObj(ReactEventRe.Form.target(event))##value;
      String.iter((c) => switch c {
        | 'h' => onMove(Left) |> ignore
        | 'j' => onMove(Up) |> ignore
        | 'k' => onMove(Down) |> ignore
        | 'l' => onMove(Right) |> ignore
        | _ => ()
      }, charCode);
      Js.log(charCode);
      ReactDOMRe.domElementToObj(ReactEventRe.Form.target(event))##value #= "";
    };
    {
      ...component,
      render: (self) => {
        <div>
          <button onClick=((_) => onMove(Left))> (ReasonReact.stringToElement({js|⬅️|js})) </button>
          <button onClick=((_) => onMove(Up))> (ReasonReact.stringToElement({js|⬆️|js})) </button>
          <button onClick=((_) => onMove(Down))> (ReasonReact.stringToElement({js|⬇️|js})) </button>
          <button onClick=((_) => onMove(Right))> (ReasonReact.stringToElement({js|➡️|js})) </button>
          <textarea onInput=(self.handle(handleInput)) />
        </div>
      }
    }
  }
};

let newGame(size) = { board_size: size, score: 0, last_delta_score: 0, step:0, turn:false, board: Array.make_matrix(size, size, None), ended: false };

let moveBoard = (board, size, direction) => {
  let filter_adj_((sc0, h), (sc, tail)) = (sc + sc0, [h, ...tail]);
  let rec filter_adj(ln) = switch(ln) {
    | [Some(a), Some(b), ...tail] when a==b => filter_adj_((a, Some(a+1)), filter_adj(tail)) /*[Some(a+b), ...filter_adj(tail)]*/
    | [a, ...tail] => filter_adj_((0, a), filter_adj(tail)) /*[a, ...filter_adj(tail)]*/
    | [] => (0, [])
  };
  let to_array(n, ln) = {
    let arr = Array.make(n, None);
    List.iteri((i,x) => arr[i]=x, ln);
    arr
  };
  let process = (board, size, readarr, savearr) => {
    let newBoard = Array.make_matrix(size, size, None);
    let score = ref(0);
    for (x in 0 to size-1) {
      let (sc, ln) = readarr(board, x) |> Array.to_list |> List.filter ((!=)(None)) |> filter_adj;
      ln |> to_array(size) |> savearr(newBoard, x);
      score := score^ + sc;
    };
    (score^, newBoard)
  };
  let (score, board) = switch direction {
    | Left => process(board, size,
                      (b, x) => b[x],
                      (b, x, t) => b[x] = t)
    | Right => process(board, size,
                       (b, x) => BatArray.rev(b[x]),
                       (b, x, t) => b[x] = BatArray.rev(t))
    | Up => process(board, size,
                    (b, x) => Array.map((ln) => ln[x], b),
                    (b, x, t) => BatArray.iter2((ln, tt) => ln[x] = tt, b, t))
    | Down => process(board, size,
                      (b, x) => Array.map((ln) => ln[x], b) |> BatArray.rev,
                      (b, x, t) => BatArray.iter2((ln, tt) => ln[x] = tt, b, BatArray.rev(t)))
  };
  (board, score)
};

let make = (_children) => {
  ...component,
  initialState: () => newGame(4),
  reducer: (action, state) => {
    let move = (board, size, direction) => {
      let (newBoard, _) as result = moveBoard(board, size, direction);
      if (newBoard == board) {
        None
      } else {
        Some(result)
      }
    };
    let add = (board, x, y, t) => {
      if (board[x][y] == t) {
        None
      } else {
        let board = [...board];
        board[x] = [...board[x]];
        board[x][y] = t;
        Some(board)
      }
    };
    switch action {
      | NewGame => ReasonReact.UpdateWithSideEffects(newGame(4), (self) => self.reduce((_)=>AddRandom, ()))
      | Move(direction) => {
          switch (move(state.board, state.board_size, direction)) {
            | Some((board, score)) => ReasonReact.UpdateWithSideEffects({...state,
                step: state.step+1,
                board: board,
                score: state.score+score,
                last_delta_score: score,
                turn: false},
                (self) => {
                    Js.log("Side effect => AddRandom");self.reduce((_)=>AddRandom, ())})
            | None => ReasonReact.SideEffects((_) => { /*let d = Printf.sprintf("%a", direction);*/ Js.log({j|info: can not move $direction|j}) })
          }
        }
      | Add(x, y, t) => {
          switch (add(state.board, x, y, t)) {
            | Some(board) => {
                let space = Array.of_list(Matrix.where((==)(None), state.board)) |> Array.length;
                if (space > 0) {
                  ReasonReact.UpdateWithSideEffects(
                    {...state,
                      step: state.step+1,
                      board: board,
                      turn: true},
                    (_) => Js.log({j|Add($x,$y): $t|j}));
                } else {
                  ReasonReact.UpdateWithSideEffects(
                    {...state,
                      step: state.step+1,
                      board: board,
                      turn: true},
                    (self) => {
                      Js.log({j|Add($x,$y): $t|j});
                      self.reduce((_)=>GameOver, ());
                    });
                }
              }
            | None => NoUpdate
          }
        }
      | AddRandom => {
          let i = Array.of_list(Matrix.where((==)(None), state.board));
          /* Js.log(Array.length(i)); */
          switch (Array.length(i)) {
            | t when t > 0 => {
                let j = Random.int(t);
                let (x, y) = i[j];
                ReasonReact.SideEffects((self) => self.reduce((_)=>Add(x, y, Some(1)), ()))
              }
            | _ => ReasonReact.SideEffects((self) => self.reduce((_)=>GameOver, ()))
          }
        }
      | GameOver => ReasonReact.Update({...state, ended: true})
    }
  },
  render: ({state: {step, score, last_delta_score, board_size, board}} as self) => {
    let message = {j|step: $step!|j};
    <div>
      <div onClick=(self.reduce((_) => AddRandom))>
        (ReasonReact.stringToElement(message))
      </div>
      <ScoreBoard score last_delta_score />
      <GameBoard board_size board />
      <InputArea onMove=((direction) => self.reduce((_) => Move(direction), ())) />
    </div>
  }
};

bsconfig.json

/* This is the BuckleScript configuration file. Note that this is a comment;
  BuckleScript comes with a JSON parser that supports comments and trailing
  comma. If this screws with your editor highlighting, please tell us by filing
  an issue! */
{
  "name": "react-template",
  "reason": {"react-jsx" : 2},
  "bs-dependencies": ["reason-react","bs-batteries"],
  "package-specs": [{
    "module": "commonjs",
    "in-source": true
  }],
  "refmt": 3,
  "sources": ["src"],
  "namespace": true,
  "suffix": ".bs.js"
}

package.json

{
  "name": "react-template",
  "private": true,
  "version": "0.1.0",
  "description": "",
  "main": "index.js",
  "scripts": {
    "build": "bsb -make-world",
    "start": "bsb -make-world -w",
    "clean": "bsb -clean-world",
    "test": "echo \"Error: no test specified\" && exit 1",
    "webpack": "webpack -w"
  },
  "keywords": [],
  "author": "",
  "license": "ISC",
  "dependencies": {
    "bs-batteries": "^0.0.14",
    "react": ">=16.0.0",
    "react-dom": ">=16.0.0",
    "reason-react": ">=0.2.1"
  },
  "devDependencies": {
    "bs-platform": "^2.0.0",
    "webpack": "^3.8.1"
  }
}