From 67aaf62335a7a57a7e28c2c654a54e1be2de43b1 Mon Sep 17 00:00:00 2001 From: Correl Roush Date: Fri, 14 Jun 2013 23:43:46 -0400 Subject: [PATCH] Game server --- Makefile | 10 +++++ include/lazy.hrl | 7 ++++ include/riichi.hrl | 37 ++++++++++------- src/game.erl | 83 ++++++++++++++++++++++++++++++++++++++ src/game_tree.erl | 69 +++++++++++++++++++++++++++++++ src/hand.erl | 12 ++++++ src/lazy.erl | 17 ++++++++ src/player.erl | 26 ++++++++++++ src/player_dummy.erl | 35 +++++++++++++++- src/riichi.erl | 52 ++++++++++++++---------- src/riichi_game.erl | 20 --------- src/server_game.erl | 70 ++++++++++++++++++++++++++++++++ src/yaku.erl | 14 +++---- test/riichi_yaku_tests.erl | 2 +- 14 files changed, 388 insertions(+), 66 deletions(-) create mode 100644 include/lazy.hrl create mode 100644 src/game.erl create mode 100644 src/game_tree.erl create mode 100644 src/hand.erl create mode 100644 src/lazy.erl create mode 100644 src/player.erl delete mode 100644 src/riichi_game.erl create mode 100644 src/server_game.erl diff --git a/Makefile b/Makefile index 895aba8..e5f5458 100644 --- a/Makefile +++ b/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 diff --git a/include/lazy.hrl b/include/lazy.hrl new file mode 100644 index 0000000..9711dac --- /dev/null +++ b/include/lazy.hrl @@ -0,0 +1,7 @@ + +-define(LAZY(Expr), fun() -> + Expr + end). + +-define(FORCE(Expr), apply(Expr, [])). + diff --git a/include/riichi.hrl b/include/riichi.hrl index f1ce5f6..659f491 100644 --- a/include/riichi.hrl +++ b/include/riichi.hrl @@ -1,9 +1,12 @@ --define(SIMPLES, [#tile{suit=S, value=V} || S <- [pin, man, sou], V <- lists:seq(2,8)]). --define(TERMINALS, [#tile{suit=S, value=V} || S <- [pin, man, sou], V <- [1,9]]). --define(DRAGONS, [#tile{suit=dragon, value=V} || V <- [green, red, white]]). --define(WINDS, [#tile{suit=wind, value=V} || V <- [east, south, west, north]]). --define(HONOURS, ?DRAGONS ++ ?WINDS). --define(TILES, ?SIMPLES ++ ?TERMINALS ++ ?HONOURS). +-define(DRAGONS, [green, red, white]). +-define(WINDS, [east, south, west, north]). + +-define(T_SIMPLES, [#tile{suit=S, value=V} || S <- [pin, man, sou], V <- lists:seq(2,8)]). +-define(T_TERMINALS, [#tile{suit=S, value=V} || S <- [pin, man, sou], V <- [1,9]]). +-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(), - wall :: [tile()], - rinshan :: [tile()], - dora :: [tile()], - uradora :: [tile()], - players :: [player()] + phase=start :: phase(), + wall=[] :: [tile()], + rinshan=[] :: [tile()], + dora=[] :: [tile()], + uradora=[] :: [tile()], + players=[] :: [player()] }). -type game() :: #game{}. diff --git a/src/game.erl b/src/game.erl new file mode 100644 index 0000000..226338c --- /dev/null +++ b/src/game.erl @@ -0,0 +1,83 @@ +%% @author Correl Roush +%% +%% @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}. + diff --git a/src/game_tree.erl b/src/game_tree.erl new file mode 100644 index 0000000..7c08683 --- /dev/null +++ b/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. diff --git a/src/hand.erl b/src/hand.erl new file mode 100644 index 0000000..0c6008f --- /dev/null +++ b/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]}. diff --git a/src/lazy.erl b/src/lazy.erl new file mode 100644 index 0000000..ab7aef9 --- /dev/null +++ b/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. diff --git a/src/player.erl b/src/player.erl new file mode 100644 index 0000000..5b28795 --- /dev/null +++ b/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)}. diff --git a/src/player_dummy.erl b/src/player_dummy.erl index d3cace5..ae63de6 100644 --- a/src/player_dummy.erl +++ b/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}. @@ -33,4 +49,19 @@ terminate(_Reason, _State) -> ok. code_change(_OldVsn, State, _Extra) -> - {ok, State}. \ No newline at end of file + {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). diff --git a/src/riichi.erl b/src/riichi.erl index dd58788..8212ef4 100644 --- a/src/riichi.erl +++ b/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) -> - 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) -> +dora(#tile{suit = Suit, value = Value} = Indicator) -> case is_valid_tile(Indicator) of - false -> - throw({error, invalid_tile}); - _ -> - if - Value == 9 -> Indicator#tile{value=1}; - true -> Indicator#tile{value=Value + 1} - end + true -> + Next = next(Suit, Value), + Indicator#tile{value = Next}; + _ -> + throw({error, invalid_tile}) + 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(). diff --git a/src/riichi_game.erl b/src/riichi_game.erl deleted file mode 100644 index cdc706e..0000000 --- a/src/riichi_game.erl +++ /dev/null @@ -1,20 +0,0 @@ -%% @author Correl Roush -%% -%% @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)}. diff --git a/src/server_game.erl b/src/server_game.erl new file mode 100644 index 0000000..9ad483b --- /dev/null +++ b/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. diff --git a/src/yaku.erl b/src/yaku.erl index 2f647cb..6eb848b 100644 --- a/src/yaku.erl +++ b/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)). diff --git a/test/riichi_yaku_tests.erl b/test/riichi_yaku_tests.erl index 2ce7ab1..4105002 100644 --- a/test/riichi_yaku_tests.erl +++ b/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})).