Game server

Makefile

@@ -1,6 +1,8 @@
 .PHONY: all deps compile test clean
 
 REBAR=rebar
+DEPS_PLT=$(CURDIR)/.deps_plt
+DEPS=kernel stdlib erts mnesia eunit
 
 all: deps compile
 
@@ -8,9 +10,17 @@ docs:
 	@$(REBAR) doc
 deps:
 	@$(REBAR) get-deps
+	@$(REBAR) update-deps
 compile: deps
 	@$(REBAR) compile
+
+$(DEPS_PLT):
+	dialyzer --output_plt $(DEPS_PLT) --build_plt \
+		--apps $(DEPS) -r deps
+dialyzer: $(DEPS_PLT)
+	dialyzer --fullpath --plt $(DEPS_PLT) -Wrace_conditions -r ./ebin
 test:
 	@$(REBAR) skip_deps=true eunit
 clean:
 	@$(REBAR) clean
+	@$(REBAR) delete-deps

include/lazy.hrl

@@ -0,0 +1,7 @@
+
+-define(LAZY(Expr), fun() ->
+                            Expr
+                    end).
+
+-define(FORCE(Expr), apply(Expr, [])).
+

include/riichi.hrl

@@ -1,9 +1,12 @@
--define(SIMPLES, [#tile{suit=S, value=V} || S <- [pin, man, sou], V <- lists:seq(2,8)]).
+-define(DRAGONS, [green, red, white]).
--define(TERMINALS, [#tile{suit=S, value=V} || S <- [pin, man, sou], V <- [1,9]]).
+-define(WINDS, [east, south, west, north]).
--define(DRAGONS, [#tile{suit=dragon, value=V} || V <- [green, red, white]]).
+
--define(WINDS, [#tile{suit=wind, value=V} || V <- [east, south, west, north]]).
+-define(T_SIMPLES, [#tile{suit=S, value=V} || S <- [pin, man, sou], V <- lists:seq(2,8)]).
--define(HONOURS, ?DRAGONS ++ ?WINDS).
+-define(T_TERMINALS, [#tile{suit=S, value=V} || S <- [pin, man, sou], V <- [1,9]]).
--define(TILES, ?SIMPLES ++ ?TERMINALS ++ ?HONOURS).
+-define(T_DRAGONS, [#tile{suit=dragon, value=V} || V <- ?DRAGONS]).
+-define(T_WINDS, [#tile{suit=wind, value=V} || V <- ?WINDS]).
+-define(T_HONOURS, ?T_DRAGONS ++ ?T_WINDS).
+-define(TILES, ?T_SIMPLES ++ ?T_TERMINALS ++ ?T_HONOURS).
 
 %% @type wind() = east | south | west | north
 -type wind()   :: east | south | west | north.
@@ -11,12 +14,15 @@
 %% @type dragon() = green | red | white
 -type dragon() :: green | red | white.
 
+%% @type suit() = wind | dragon | pin | man | sou
+-type suit() :: wind | dragon | pin | man | sou.
+
 %% @type tile() = {tile, Suit, Value, From}
-%%     Suit  = pin | man | sou | wind | dragon
+%%     Suit  = suit()
 %%     Value = integer() | wind() | dragon()
 %%     From  = draw | wind()
 -record(tile, {
-          suit       :: pin | man | sou | wind | dragon,
+          suit       :: suit(),
           value      :: integer() | wind() | dragon(),
           from=draw  :: draw | wind()
 }).
@@ -48,6 +54,7 @@
 %%     Drawn = none | {tsumo | ron, tile()}
 -record(player, {
           name         :: string(),
+          pid          :: none | pid(),
           seat         :: wind(),
           hand=#hand{} :: hand(),
           discards=[]  :: [tile()],
@@ -57,7 +64,7 @@
 
 %% @type phase() = Phase
 %%     Phase = draw | discard
--type phase() :: draw | discard.
+-type phase() :: start | draw | discard.
 
 %% @type game() = {game, Rounds, Timeout, Round, Turn, Phase, Wall, Rinshan, Dora, Uradora, Players}
 %%     Rounds = integer()
@@ -75,11 +82,11 @@
           timeout=infinity :: integer() | infinity,
           round=east       :: wind(),
           turn=east        :: wind(),
-          phase=draw       :: phase(),
+          phase=start      :: phase(),
-          wall             :: [tile()],
+          wall=[]          :: [tile()],
-          rinshan          :: [tile()],
+          rinshan=[]       :: [tile()],
-          dora             :: [tile()],
+          dora=[]          :: [tile()],
-          uradora          :: [tile()],
+          uradora=[]       :: [tile()],
-          players          :: [player()]
+          players=[]       :: [player()]
 }).
 -type game() :: #game{}.

src/game.erl

@@ -0,0 +1,83 @@
+%% @author Correl Roush <correl@gmail.com>
+%%
+%% @doc Riichi Mahjong library.
+%%
+%% @headerfile "../include/riichi.hrl"
+
+-module(game).
+
+-include("riichi.hrl").
+
+-export([new/0,
+         new/1,
+         add_player/2,
+         current_player/1,
+         position/1,
+         discards/1,
+         draw/1,
+         get_player/2,
+         update_player/3
+]).
+
+%% @doc Creates a new mahjong game, with all 136 tiles shuffled and organized.
+-spec new() -> game().
+new() ->
+    Tiles = riichi:shuffle(riichi:tiles()),
+    #game{rinshan=lists:sublist(Tiles, 1, 4),
+          dora=lists:sublist(Tiles, 5, 5),
+          uradora=lists:sublist(Tiles, 10,5),
+          wall=lists:sublist(Tiles, 15, 124)}.
+
+new(Players) ->
+    lists:foldl(fun add_player/2, new(), Players).
+
+add_player(_Player, Game = #game{players=Players})
+  when length(Players) >= 4 ->
+    throw("Game full");
+add_player(Name, Game = #game{players = Players})
+  when is_list(Name) ->
+    add_player(#player{name=Name}, Game);
+add_player(Player = #player{}, Game = #game{players=Players}) ->
+    Seats = ?WINDS,
+    Seat = lists:nth(length(Players) + 1, Seats),
+    {Tiles, Wall} = lists:split(12, Game#game.wall),
+    Hand = #hand{tiles=Tiles},
+    Game#game{wall = Wall,
+              players=Players ++ [Player#player{seat = Seat, hand = Hand}]}.
+
+current_player(#game{players = Players, turn = Turn}) ->
+    lists:nth(position(Turn) + 1, Players).
+
+position(Wind) ->
+    case lists:member(Wind, ?WINDS) of
+        true ->
+            length(lists:takewhile(fun(W) ->
+                                           W =/= Wind
+                                   end,
+                                   ?WINDS));
+        _ ->
+            error(invalid_wind)
+    end.
+
+discards(#game{turn = Turn} = Game) ->
+    Player = current_player(Game),
+    [{discard, Tile, update_player(Game, Turn, Updated)}
+     || {discard, Tile, Updated} <- player:discards(Player)].
+
+draw(#game{turn = Turn} = Game) ->
+    [Tile|Wall] = Game#game.wall,
+    Player = player:draw(current_player(Game), Tile),
+    Updated = update_player(Game, Turn, Player),
+    Updated#game{wall=Wall}.
+
+get_player(#game{players = Players} = Game, Seat) ->
+    Pos = position(Seat) + 1,
+    lists:nth(Pos, Players).
+
+update_player(#game{players = Players} = Game, Seat, Player) ->
+    Pos = position(Seat),
+    Updated = lists:sublist(Players, Pos)
+        ++ [Player]
+        ++ lists:nthtail(Pos + 1, Players),
+    Game#game{players = Updated}.
+   

src/game_tree.erl

@@ -0,0 +1,69 @@
+-module(game_tree).
+
+-include("riichi.hrl").
+-include("lazy.hrl").
+
+-export([build/1,
+         do/2]).
+
+-compile([export_all]).
+
+-record(game_tree, {game, actions}).
+-record(game_action, {player, action, arguments}).
+
+-type game_tree() :: #game_tree{}.
+-type game_action() :: #game_action{}
+                     | exhaustive_draw.
+
+-define(cond_actions(Expr, Actions), case Expr of
+                                         true ->
+                                             Actions;
+                                         _ ->
+                                             []
+                                     end).
+
+-spec(build(game()) -> game_tree()).
+build(Game) ->
+    {game_tree, Game, actions(Game)}.
+
+-spec(actions(game()) -> game_action()).
+actions(#game{phase = start, wall = []}) ->
+    %% No tile remain in the live wall at the start of a player's turn
+    %% Terminate the game
+
+    %% TODO: Score exhaustive draw
+    exhaustive_draw;
+actions(#game{phase = start, turn = Turn} = Game) ->
+    %% Begin a player's turn by having them draw a tile from the live wall
+
+    Updated = game:draw(Game),
+    [{#game_action{player=Turn, action=draw}, ?LAZY(build(Updated#game{phase=draw}))}];
+actions(#game{phase = draw, turn = Turn} = Game) ->
+    %% This is the player's main turn phase
+
+    Player = game:current_player(Game),
+
+    lists:flatten([
+                   ?cond_actions(riichi_hand:is_complete(Player#player.hand),
+                                 [{#game_action{player=Turn, action=tsumo}, Game}]),
+                   [{#game_action{player=Turn, action=discard, arguments=Tile}, ?LAZY(build(Updated#game{phase=discard}))}
+                    || {discard, Tile, Updated} <- game:discards(Game)]
+                  ]);
+actions(#game{phase = discard, turn = Turn} = Game) ->
+    %% TODO: Can any of the players steal the discarded tile?
+    Updated = Game#game{phase = start, turn = riichi:next(wind, Turn)},
+    [{#game_action{player=Seat, action=pass}, ?LAZY(build(Updated))}
+     || Seat <- [east, south, west, north]];
+actions(#game{} = Game) ->
+    error_logger:error_report([{?MODULE, invalid_game_state},
+                               {game, Game}]),
+    {error, invalid_game_state}.
+
+-spec(do(game_tree(), game_action()) -> game_tree()).
+do(Tree, Action) ->
+    case proplists:get_value(Action, Tree#game_tree.actions) of
+        undefined ->
+            error(invalid_game_action);
+        Thunk ->
+            ?FORCE(Thunk)
+    end.

src/hand.erl

@@ -0,0 +1,12 @@
+-module(hand).
+
+-include("riichi.hrl").
+
+-export([discards/1,
+         draw/2]).
+
+discards(#hand{tiles=Tiles} = Hand) ->
+    [{discard, Tile, Hand#hand{tiles = Tiles -- [Tile]}} || Tile <- Tiles].
+
+draw(#hand{tiles = Tiles} = Hand, Tile) ->
+    Hand#hand{tiles = Tiles ++ [Tile]}.

src/lazy.erl

@@ -0,0 +1,17 @@
+-module(lazy).
+
+-export([find/2]).
+
+-include("lazy.hrl").
+
+
+find(Predicate, [H|T]) when is_function(H) ->
+    Value = ?FORCE(H),
+    case Predicate(Value) of
+        true ->
+            {ok, Value};
+        _ ->
+            find(Predicate, T)
+    end;
+find(_Predicate, []) ->
+    undefined.

src/player.erl

@@ -0,0 +1,26 @@
+-module(player).
+
+-include("riichi.hrl").
+
+-export([new/0,
+         new/1,
+         new/2,
+         discards/1,
+         draw/2]).
+
+new() ->
+    new("Computer").
+
+new(Name) ->
+    new(Name, player_dummy).
+
+new(Name, Type) ->
+    {ok, PID} = Type:start_link(Name),
+    #player{name = Name, pid = PID}.
+
+discards(#player{discards = Discards} = Player) ->
+    [{discard, Tile, Player#player{hand = Hand, discards = [Tile|Discards]}}
+     || {discard, Tile, Hand} <- hand:discards(Player#player.hand)].
+
+draw(#player{hand = Hand} = Player, Tile) ->
+    Player#player{hand = hand:draw(Hand, Tile)}.

src/player_dummy.erl

@@ -5,7 +5,7 @@
 -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2,
          code_change/3]).
 
--record(state, {name}).
+-record(state, {name, game, seat}).
 
 start_link(Name) ->
     gen_server:start_link(?MODULE, [Name], []).
@@ -13,6 +13,13 @@ start_link(Name) ->
 init([Name]) ->
     {ok, #state{name=Name}}.
 
+handle_call({choose, Actions}, _From, State) ->
+    [Action|_] = sort_actions(Actions),
+    {reply, Action, State};
+
+handle_call(get_name, _From, State) ->
+    {reply, State#state.name, State};
+
 handle_call(_Msg, _From, State) ->
     {noreply, State}.
 
@@ -23,6 +30,15 @@ handle_cast({message, _From, Body}, State) ->
                               {body, Body}}),
     {noreply, State};
 
+handle_cast({action, Seat, Action}, State) ->
+    error_logger:info_report([game_event,
+                              {seat, Seat},
+                              {action, Action}]),
+    {noreply, State};
+
+handle_cast({new_state, Game}, State) ->
+    {noreply, State#state{game=Game}};
+
 handle_cast(_Msg, State) ->
     {noreply, State}.
 
@@ -34,3 +50,18 @@ terminate(_Reason, _State) ->
 
 code_change(_OldVsn, State, _Extra) ->
     {ok, State}.
+
+sort_actions(Actions) ->
+    Order = fun({game_action, A, _, _}, {game_action, B, _, _}) ->
+                    Weighted = [ron, tsumo, kan, pon, chi],
+                    Weights = lists:zip(Weighted, lists:reverse(lists:seq(1, length(Weighted)))),
+                    VA = proplists:get_value(A, Weights, 0),
+                    VB = proplists:get_value(B, Weights, 0),
+                    case VA == VB of
+                        true ->
+                            A >= B;
+                        _ ->
+                            VA >= VB
+                    end
+            end,
+    lists:sort(Order, Actions).

src/riichi.erl

@@ -9,9 +9,11 @@
 -include("../include/riichi.hrl").
 
 -export([
+         start/0,
          is_valid_tile/1,
          is_open/1,
          dora/1,
+         next/2,
          nearest/2,
          score/3,
          score_hand/1,
@@ -21,6 +23,9 @@
          tiles/0
 ]).
 
+start() ->
+    application:start(riichi).
+
 -spec is_valid_tile(tile()) -> boolean().
 is_valid_tile(#tile{suit=dragon, value=Value}) ->
     lists:member(Value, [white, green, red]);
@@ -45,28 +50,33 @@ is_open(#hand{tiles=Tiles, melds=Melds}) ->
         orelse lists:any(fun is_open/1, Melds).
 
 -spec dora(tile()) -> tile().
-dora(#tile{suit=dragon, value=Value}=Indicator) ->
+dora(#tile{suit = Suit, value = Value} = Indicator) ->
-    case Value of
-        white -> Indicator#tile{value=green};
-        green -> Indicator#tile{value=red};
-        red   -> Indicator#tile{value=white}
-    end;
-dora(#tile{suit=wind, value=Value}=Indicator) ->
-    case Value of
-        east  -> Indicator#tile{value=south};
-        south -> Indicator#tile{value=west};
-        west  -> Indicator#tile{value=north};
-        north -> Indicator#tile{value=east}
-    end;
-dora(#tile{value=Value}=Indicator) ->
     case is_valid_tile(Indicator) of
-        false ->
+        true ->
-            throw({error, invalid_tile});
+            Next = next(Suit, Value),
-        _     ->
+            Indicator#tile{value = Next};
-            if
+        _ ->
-                Value == 9 -> Indicator#tile{value=1};
+            throw({error, invalid_tile})
-                true       -> Indicator#tile{value=Value + 1}
+    end.
-            end
+
+-spec next(suit(), term()) -> term().
+next(dragon, Value) ->
+    case Value of
+        white -> green;
+        green -> red;
+        red -> white
+    end;
+next(wind, Value) ->
+    case Value of
+        east -> south;
+        south -> west;
+        west -> north;
+        north -> east
+    end;
+next(_Suit, Value) when is_integer(Value) ->
+    case Value < 9 of
+        true -> Value + 1;
+        _ -> 1
     end.
 
 -spec nearest(integer(), integer()) -> integer().

src/riichi_game.erl

@@ -1,20 +0,0 @@
-%% @author Correl Roush <correl@gmail.com>
-%%
-%% @doc Riichi Mahjong library.
-%%
-%% @headerfile "../include/riichi.hrl"
-
--module(riichi_game).
-
--include("../include/riichi.hrl").
-
--export([new/0]).
-
-%% @doc Creates a new mahjong game, with all 136 tiles shuffled and organized.
--spec new() -> game().
-new() ->
-    Tiles = riichi:shuffle(riichi:tiles()),
-    #game{rinshan=lists:sublist(Tiles, 1, 4),
-          dora=lists:sublist(Tiles, 5, 5),
-          uradora=lists:sublist(Tiles, 10,5),
-          wall=lists:sublist(Tiles, 15, 124)}.

src/server_game.erl

@@ -0,0 +1,70 @@
+-module(server_game).
+-behaviour(gen_fsm).
+
+-export([start_link/0]).
+-export([waiting/3,
+         playing/2,
+         turn/2]).
+-export([init/1, handle_event/3, handle_sync_event/4, handle_info/3, terminate/3]).
+
+-include("../include/riichi.hrl").
+
+-record(state, {players=[]}).
+
+start_link() ->
+    gen_fsm:start_link(?MODULE, [], []).
+
+init([]) ->
+    {ok, waiting, #state{}}.
+
+waiting({add_player, Player}, _From, State) ->
+    error_logger:info_report({adding_player, [{player, Player}]}),
+    Players = [Player|State#state.players],
+    case length(Players) of
+        4 ->
+            Game = game:new(Players),
+            error_logger:info_report({starting_game, []}),
+            gen_fsm:send_event(self(), game_tree:build(Game)),
+            {reply, ok, playing, Game};
+        _ -> {reply, ok, waiting, State#state{players=Players}}
+    end.
+
+playing({game_tree, Game, Branches} = Tree, State) ->
+    Actions = proplists:get_keys(Branches),
+    [gen_server:cast(Player#player.pid, {new_state, Game}) || Player <- Game#game.players],
+    [Choice|_] = lists:flatten(lists:map(fun(Seat) ->
+                                                 Player = game:get_player(Game, Seat),
+                                                 PlayerActions = [A || A = {game_action, W, _, _} <- Actions,
+                                                                       W =:= Seat],
+                                                 case PlayerActions of
+                                                     [] ->
+                                                         [];
+                                                     _ ->
+                                                         [gen_server:call(Player#player.pid, {choose, PlayerActions})]
+                                                 end
+                                         end,
+                                         [east, south, west, north])),
+    error_logger:info_report([resolving_choice, {chosen, Choice}, {valid, Actions}]),
+    gen_fsm:send_event(self(), game_tree:do(Tree, Choice)),
+    {next_state, playing, State}.
+
+turn(start, Game) ->
+    error_logger:info_report({starting_turn, Game#game.turn}),
+    {next_state, start, Game}.
+
+handle_event(Event, StateName, State) ->
+    io:format("Unexpected ~p during ~p", [Event, StateName]),
+    {next_state, StateName, State}.
+
+handle_sync_event(Event, _From, StateName, State) ->
+    io:format("Unexpected ~p during ~p", [Event, StateName]),
+    {next_state, StateName, State}.
+    
+handle_info(_Info, StateName, State) ->
+    {next_state, StateName, State}.
+
+terminate(Reason, StateName, _State) ->
+    error_logger:error_report([terminating,
+                               {from_state, StateName},
+                               {reason, Reason}]),
+    ok.

src/yaku.erl

@@ -106,7 +106,7 @@ iipeikou(#game{}, #player{hand=#hand{melds=Melds}}) ->
 chanta(#game{}, #player{hand=#hand{tiles=[], melds=Melds}}) ->
     Sets = [[{T#tile.suit, T#tile.value} || T <- Tiles]
             || #meld{tiles=Tiles} <- Melds],
-    ChantaTiles = [{T#tile.suit, T#tile.value} || T <- (?TERMINALS ++ ?HONOURS)],
+    ChantaTiles = [{T#tile.suit, T#tile.value} || T <- (?T_TERMINALS ++ ?T_HONOURS)],
     lists:all(fun(Tiles) ->
                       (Tiles -- ChantaTiles =/= Tiles)
               end,
@@ -183,7 +183,7 @@ shou_san_gen(#game{}, #player{hand=#hand{melds=Melds}}) ->
 %% @doc Returns true for a Honrouto hand
 honrouto(#game{}, #player{hand=Hand}) ->
     IsHonour = fun(T) ->
-                       lists:member(T, ?HONOURS ++ ?TERMINALS)
+                       lists:member(T, ?T_HONOURS ++ ?T_TERMINALS)
                end,
     lists:all(IsHonour, riichi_hand:tiles(Hand)).
     
@@ -200,14 +200,14 @@ honitsu(#game{}, #player{hand=Hand}) ->
     Suits = sets:to_list(sets:from_list([Suit || #tile{suit=Suit} <- Tiles,
                                                  lists:member(Suit, [pin, sou, man])])),
     IsHonour = fun(T) ->
-                       lists:member(T, ?HONOURS)
+                       lists:member(T, ?T_HONOURS)
                end,
     length(Suits) == 1 andalso lists:any(IsHonour, Tiles).
 
 %% @doc Returns true for a Jun chan hand.
 jun_chan(#game{}, #player{hand=#hand{melds=Melds}}) ->
     IsTerminal = fun(T) ->
-                         lists:member(T, ?TERMINALS)
+                         lists:member(T, ?T_TERMINALS)
                  end,
     HasTerminal = fun(#meld{tiles=Tiles}) ->
                           lists:any(IsTerminal, Tiles)
@@ -226,7 +226,7 @@ chinitsu(#game{}, #player{hand=Hand}) ->
     Suits = sets:to_list(sets:from_list([Suit || #tile{suit=Suit} <- Tiles,
                                                  lists:member(Suit, [pin, sou, man])])),
     IsHonour = fun(T) ->
-                       lists:member(T, ?HONOURS)
+                       lists:member(T, ?T_HONOURS)
                end,
     length(Suits) == 1 andalso not lists:any(IsHonour, Tiles).
 
@@ -265,13 +265,13 @@ suu_an_kou(#game{}, #player{hand=#hand{melds=Melds}}) ->
 
 tsu_iisou(#game{}, #player{hand=Hand}) ->
     IsHonour = fun(T) ->
-                       lists:member(T, ?HONOURS)
+                       lists:member(T, ?T_HONOURS)
                end,
     lists:all(IsHonour, riichi_hand:tiles(Hand)).
 
 chinrouto(#game{}, #player{hand=Hand}) ->
     IsTerminal = fun(T) ->
-                         lists:member(T, ?TERMINALS)
+                         lists:member(T, ?T_TERMINALS)
                  end,
     lists:all(IsTerminal, riichi_hand:tiles(Hand)).
 

test/riichi_yaku_tests.erl

@@ -161,7 +161,7 @@ chinitsu_test() ->
     ?assertEqual(true, yaku:chinitsu(#game{}, #player{hand=Hand, drawn={tsumo, #tile{suit=sou, value=1}}})).
 
 kokushi_musou_test() ->
-    Hand = #hand{tiles=?TERMINALS ++ ?HONOURS -- [#tile{suit=pin, value=1}],
+    Hand = #hand{tiles=?T_TERMINALS ++ ?T_HONOURS -- [#tile{suit=pin, value=1}],
                 melds=[#meld{type=pair, tiles=lists:duplicate(2, #tile{suit=pin, value=1})}]},
     ?assertEqual(true, yaku:kokushi_musou(#game{}, #player{hand=Hand})).