mirror of
https://github.com/correl/riichi.git
synced 2024-11-14 11:09:36 +00:00
Add websocket server
This commit is contained in:
parent
be02a1fa12
commit
7fb216a351
15 changed files with 392 additions and 63 deletions
|
@ -8,10 +8,12 @@
|
|||
],
|
||||
"exposed-modules": [],
|
||||
"dependencies": {
|
||||
"elm-community/json-extra": "2.3.0 <= v < 3.0.0",
|
||||
"elm-community/list-extra": "6.1.0 <= v < 7.0.0",
|
||||
"elm-community/maybe-extra": "4.0.0 <= v < 5.0.0",
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0",
|
||||
"elm-lang/websocket": "1.0.2 <= v < 2.0.0",
|
||||
"rtfeldman/elm-css": "9.1.0 <= v < 10.0.0",
|
||||
"rtfeldman/elm-css-helpers": "2.1.0 <= v < 3.0.0"
|
||||
},
|
||||
|
|
93
priv/src/Client.elm
Normal file
93
priv/src/Client.elm
Normal file
|
@ -0,0 +1,93 @@
|
|||
module Client exposing (..)
|
||||
|
||||
import Debug
|
||||
import Client.Decode
|
||||
import Client.Game exposing (Game)
|
||||
import Html exposing (..)
|
||||
import Json.Decode exposing (decodeString)
|
||||
import String
|
||||
import WebSocket
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ game : Maybe Game
|
||||
, log : List String
|
||||
}
|
||||
|
||||
|
||||
type Msg
|
||||
= Receive String
|
||||
| Send String
|
||||
| Log String
|
||||
| NewState Game
|
||||
|
||||
|
||||
init : Model
|
||||
init =
|
||||
{ game = Nothing
|
||||
, log = []
|
||||
}
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
Receive m ->
|
||||
socketMsg m
|
||||
|> Maybe.map (\msg -> update msg model)
|
||||
|> Maybe.withDefault ( model, Cmd.none )
|
||||
|
||||
Log m ->
|
||||
( { model | log = m :: model.log }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
NewState game ->
|
||||
( { model | game = Just (Debug.log "game" game) }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
_ ->
|
||||
( model, Cmd.none )
|
||||
|
||||
|
||||
socketMsg : String -> Maybe Msg
|
||||
socketMsg message =
|
||||
let
|
||||
splitMsg =
|
||||
case String.split ":" message of
|
||||
msgType :: rest ->
|
||||
Just ( msgType, String.join ":" rest )
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
|
||||
toMsg ( msgType, rest ) =
|
||||
case msgType of
|
||||
"log" ->
|
||||
Just (Log rest)
|
||||
|
||||
"new_state" ->
|
||||
decodeString Client.Decode.game rest
|
||||
|> Result.toMaybe
|
||||
|> Maybe.map NewState
|
||||
|
||||
_ ->
|
||||
Nothing
|
||||
in
|
||||
splitMsg
|
||||
|> Maybe.andThen toMsg
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
WebSocket.listen "ws://localhost:8080/websocket" Receive
|
||||
|
||||
|
||||
view : Model -> Html msg
|
||||
view model =
|
||||
div []
|
||||
[ Maybe.map Client.Game.view model.game
|
||||
|> Maybe.withDefault (div [] [])
|
||||
, pre [] [ text <| String.join "\n" model.log ]
|
||||
]
|
49
priv/src/Client/Decode.elm
Normal file
49
priv/src/Client/Decode.elm
Normal file
|
@ -0,0 +1,49 @@
|
|||
module Client.Decode exposing (..)
|
||||
|
||||
import Client.Hand exposing (Hand)
|
||||
import Client.Game exposing (Game)
|
||||
import Client.Player exposing (Player)
|
||||
import Json.Decode exposing (..)
|
||||
import Json.Decode.Extra exposing (fromResult)
|
||||
import Tile exposing (Tile)
|
||||
|
||||
|
||||
tile : Decoder Tile
|
||||
tile =
|
||||
let
|
||||
combine a b =
|
||||
a ++ " " ++ b
|
||||
|
||||
stringOrInt =
|
||||
oneOf
|
||||
[ string
|
||||
, int |> map toString
|
||||
]
|
||||
in
|
||||
map2 combine
|
||||
(field "value" stringOrInt)
|
||||
(field "suit" string)
|
||||
|> andThen
|
||||
(Tile.fromString
|
||||
>> (Result.fromMaybe "invalid tile")
|
||||
>> fromResult
|
||||
)
|
||||
|
||||
|
||||
hand : Decoder Hand
|
||||
hand =
|
||||
map Hand
|
||||
(field "tiles" (list tile))
|
||||
|
||||
|
||||
player : Decoder Player
|
||||
player =
|
||||
map2 Player
|
||||
(field "name" string)
|
||||
(field "hand" hand)
|
||||
|
||||
|
||||
game : Decoder Game
|
||||
game =
|
||||
map Game
|
||||
(field "players" (list player))
|
16
priv/src/Client/Game.elm
Normal file
16
priv/src/Client/Game.elm
Normal file
|
@ -0,0 +1,16 @@
|
|||
module Client.Game exposing (..)
|
||||
|
||||
import Client.Player exposing (Player)
|
||||
import Html exposing (..)
|
||||
|
||||
|
||||
type alias Game =
|
||||
{ players : List Player }
|
||||
|
||||
|
||||
view : Game -> Html msg
|
||||
view game =
|
||||
div [] <|
|
||||
List.map
|
||||
Client.Player.view
|
||||
game.players
|
18
priv/src/Client/Hand.elm
Normal file
18
priv/src/Client/Hand.elm
Normal file
|
@ -0,0 +1,18 @@
|
|||
module Client.Hand exposing (..)
|
||||
|
||||
import Html exposing (Html, div, text)
|
||||
import Html.Attributes exposing (class)
|
||||
import Tile exposing (Tile)
|
||||
|
||||
|
||||
type alias Hand =
|
||||
{ tiles : List Tile
|
||||
}
|
||||
|
||||
|
||||
view : Hand -> Html a
|
||||
view model =
|
||||
div [ class "hand" ]
|
||||
[ div [ class "tiles open" ] <|
|
||||
List.map Tile.view model.tiles
|
||||
]
|
18
priv/src/Client/Player.elm
Normal file
18
priv/src/Client/Player.elm
Normal file
|
@ -0,0 +1,18 @@
|
|||
module Client.Player exposing (..)
|
||||
|
||||
import Client.Hand exposing (Hand)
|
||||
import Html exposing (..)
|
||||
|
||||
|
||||
type alias Player =
|
||||
{ name : String
|
||||
, hand : Hand
|
||||
}
|
||||
|
||||
|
||||
view : Player -> Html msg
|
||||
view player =
|
||||
fieldset []
|
||||
[ legend [] [ text ("Player: " ++ player.name) ]
|
||||
, Client.Hand.view player.hand
|
||||
]
|
|
@ -1,33 +0,0 @@
|
|||
module Hand exposing (..)
|
||||
|
||||
import Html exposing (Html, div, text)
|
||||
import Html.Attributes exposing (class)
|
||||
import Maybe.Extra
|
||||
import Tile exposing (Tile)
|
||||
|
||||
|
||||
type alias JSON =
|
||||
{ tiles : List String
|
||||
}
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ tiles : List Tile
|
||||
}
|
||||
|
||||
|
||||
fromJSON : JSON -> Model
|
||||
fromJSON j =
|
||||
{ tiles =
|
||||
j.tiles
|
||||
|> List.map Tile.fromString
|
||||
|> Maybe.Extra.values
|
||||
}
|
||||
|
||||
|
||||
view : Model -> Html a
|
||||
view model =
|
||||
div [ class "hand" ]
|
||||
[ div [ class "tiles open" ] <|
|
||||
List.map Tile.view model.tiles
|
||||
]
|
|
@ -1,6 +1,6 @@
|
|||
module Riichi exposing (..)
|
||||
|
||||
import Hand
|
||||
import Client
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick)
|
||||
|
@ -14,32 +14,19 @@ import Stylesheets as S
|
|||
|
||||
type alias Model =
|
||||
{ tileset : S.Tileset
|
||||
, hand : Hand.Model
|
||||
, client : Client.Model
|
||||
}
|
||||
|
||||
|
||||
type Msg
|
||||
= SetTileset S.Tileset
|
||||
| ClientMsg Client.Msg
|
||||
|
||||
|
||||
init : ( Model, Cmd Msg )
|
||||
init =
|
||||
( { tileset = S.White
|
||||
, hand =
|
||||
Hand.fromJSON
|
||||
{ tiles =
|
||||
[ "4 pin"
|
||||
, "5 pin"
|
||||
, "6 pin"
|
||||
, "4 sou"
|
||||
, "5 sou"
|
||||
, "6 sou"
|
||||
, "4 man"
|
||||
, "5 man"
|
||||
, "6 man"
|
||||
, "red dragon"
|
||||
]
|
||||
}
|
||||
, client = Client.init
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
@ -53,6 +40,15 @@ update msg model =
|
|||
, Cmd.none
|
||||
)
|
||||
|
||||
ClientMsg m ->
|
||||
let
|
||||
( client, effects ) =
|
||||
Client.update m model.client
|
||||
in
|
||||
( { model | client = client }
|
||||
, Cmd.map ClientMsg effects
|
||||
)
|
||||
|
||||
|
||||
main : Program Never Model Msg
|
||||
main =
|
||||
|
@ -60,10 +56,15 @@ main =
|
|||
{ init = init
|
||||
, update = update
|
||||
, view = view
|
||||
, subscriptions = \_ -> Sub.none
|
||||
, subscriptions = subscriptions
|
||||
}
|
||||
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
Sub.batch [ Sub.map ClientMsg <| Client.subscriptions model.client ]
|
||||
|
||||
|
||||
view : Model -> Html Msg
|
||||
view model =
|
||||
div [ class [ S.Tileset model.tileset ] ]
|
||||
|
@ -73,7 +74,7 @@ view model =
|
|||
, radio "tileset" "White" (SetTileset S.White) (model.tileset == S.White)
|
||||
, radio "tileset" "Black" (SetTileset S.Black) (model.tileset == S.Black)
|
||||
]
|
||||
, Hand.view model.hand
|
||||
, Client.view model.client
|
||||
]
|
||||
|
||||
|
||||
|
|
|
@ -1,5 +1,13 @@
|
|||
%% -*- mode: erlang -*-
|
||||
|
||||
{plugins, [rebar3_auto]}.
|
||||
|
||||
{deps, [cowboy,
|
||||
lager,
|
||||
jsx]}.
|
||||
|
||||
{erl_opts, [{parse_transform, lager_transform}]}.
|
||||
|
||||
{pre_hooks,
|
||||
[{"(linux|darwin|solaris)", compile,"make elm"},
|
||||
{"(freebsd|netbsd|openbsd)",compile,"gmake elm"},
|
||||
|
|
|
@ -5,6 +5,7 @@
|
|||
-export([new/0,
|
||||
new/1,
|
||||
new/2,
|
||||
send/2,
|
||||
discards/1,
|
||||
draw/2]).
|
||||
|
||||
|
@ -12,11 +13,14 @@ new() ->
|
|||
new("Computer").
|
||||
|
||||
new(Name) ->
|
||||
new(Name, player_dummy).
|
||||
{ok, Pid} = player_dummy:start_link(Name),
|
||||
new(Name, Pid).
|
||||
|
||||
new(Name, Type) ->
|
||||
{ok, PID} = Type:start_link(Name),
|
||||
#player{name = Name, pid = PID}.
|
||||
new(Name, Pid) ->
|
||||
#player{name = Name, pid = Pid}.
|
||||
|
||||
send(#player{pid = Pid}, Message) ->
|
||||
gen_server:cast(Pid, Message).
|
||||
|
||||
discards(#player{discards = Discards} = Player) ->
|
||||
[{discard, Tile, Player#player{hand = Hand, discards = [Tile|Discards]}}
|
||||
|
|
56
src/player_websocket.erl
Normal file
56
src/player_websocket.erl
Normal file
|
@ -0,0 +1,56 @@
|
|||
-module(player_websocket).
|
||||
-behaviour(gen_server).
|
||||
|
||||
-export([start_link/1]).
|
||||
-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2,
|
||||
code_change/3]).
|
||||
|
||||
-record(state, {socket, game, seat}).
|
||||
|
||||
start_link(Socket) ->
|
||||
gen_server:start_link(?MODULE, [Socket], []).
|
||||
|
||||
init([Socket]) ->
|
||||
Socket ! <<"oh hello!">>,
|
||||
{ok, #state{socket=Socket}}.
|
||||
|
||||
handle_call({choose, Actions}, _From, State) ->
|
||||
%% [Action|_] = sort_actions(Actions),
|
||||
%% {reply, Action, State};
|
||||
State#state.socket ! {choose, Actions},
|
||||
{noreply, State};
|
||||
|
||||
handle_call(get_name, _From, State) ->
|
||||
{reply, io_lib:format("~p", [State#state.socket]), State};
|
||||
|
||||
handle_call(_Msg, _From, State) ->
|
||||
{noreply, State}.
|
||||
|
||||
handle_cast(Msg, State) ->
|
||||
State#state.socket! Msg,
|
||||
{noreply, State}.
|
||||
|
||||
handle_info(Msg, State) ->
|
||||
State#state.socket ! Msg,
|
||||
{noreply, State}.
|
||||
|
||||
terminate(_Reason, _State) ->
|
||||
ok.
|
||||
|
||||
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).
|
|
@ -6,7 +6,9 @@
|
|||
{applications, [
|
||||
kernel,
|
||||
stdlib,
|
||||
cowboy
|
||||
lager,
|
||||
cowboy,
|
||||
jsx
|
||||
]},
|
||||
{modules, []},
|
||||
{mod, { riichi_app, []}},
|
||||
|
|
|
@ -14,7 +14,8 @@ start(_StartType, _StartArgs) ->
|
|||
[{'_', [{"/", cowboy_static, {priv_file, riichi, "index.html"}},
|
||||
{"/js/[...]", cowboy_static, {priv_dir, riichi, "js"}},
|
||||
{"/css/[...]", cowboy_static, {priv_dir, riichi, "css"}},
|
||||
{"/images/[...]", cowboy_static, {priv_dir, riichi, "images"}}
|
||||
{"/images/[...]", cowboy_static, {priv_dir, riichi, "images"}},
|
||||
{"/websocket", server_websocket, []}
|
||||
]}
|
||||
]),
|
||||
{ok, _} = cowboy:start_http(
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
-behaviour(gen_fsm).
|
||||
|
||||
-export([start_link/0]).
|
||||
-export([waiting/3,
|
||||
-export([waiting/2,
|
||||
playing/2,
|
||||
turn/2]).
|
||||
-export([init/1, handle_event/3, handle_sync_event/4, handle_info/3, terminate/3, code_change/4]).
|
||||
|
@ -17,16 +17,19 @@ start_link() ->
|
|||
init([]) ->
|
||||
{ok, waiting, #state{}}.
|
||||
|
||||
waiting({add_player, Player}, _From, State) ->
|
||||
waiting({add_player, Player}, State) ->
|
||||
error_logger:info_report({adding_player, [{player, Player}]}),
|
||||
Players = [Player|State#state.players],
|
||||
[player:send(P, {joined, Player}) || P <- Players],
|
||||
case length(Players) of
|
||||
4 ->
|
||||
Game = game:new(Players),
|
||||
error_logger:info_report({starting_game, []}),
|
||||
[player:send(P, {log ,<<"starting game">>}) || P <- Players],
|
||||
gen_fsm:send_event(self(), game_tree:build(Game)),
|
||||
{reply, ok, playing, Game};
|
||||
_ -> {reply, ok, waiting, State#state{players=Players}}
|
||||
{next_state, playing, Game};
|
||||
_ ->
|
||||
{next_state, waiting, State#state{players=Players}}
|
||||
end.
|
||||
|
||||
playing({game_tree, Game, Branches} = Tree, State) ->
|
||||
|
@ -40,7 +43,7 @@ playing({game_tree, Game, Branches} = Tree, State) ->
|
|||
[] ->
|
||||
[];
|
||||
_ ->
|
||||
[gen_server:call(Player#player.pid, {choose, PlayerActions})]
|
||||
[gen_server:call(Player#player.pid, {choose, PlayerActions}, infinity)]
|
||||
end
|
||||
end,
|
||||
[east, south, west, north])),
|
||||
|
|
91
src/server_websocket.erl
Normal file
91
src/server_websocket.erl
Normal file
|
@ -0,0 +1,91 @@
|
|||
-module(server_websocket).
|
||||
-behaviour(cowboy_http_handler).
|
||||
-behaviour(cowboy_websocket_handler).
|
||||
|
||||
-include("../include/riichi.hrl").
|
||||
|
||||
-export([init/3, handle/2, terminate/3]).
|
||||
-export([
|
||||
websocket_init/3, websocket_handle/3,
|
||||
websocket_info/3, websocket_terminate/3
|
||||
]).
|
||||
|
||||
-record(state, {game, player}).
|
||||
|
||||
init({tcp, http}, _Req, _Opts) ->
|
||||
{upgrade, protocol, cowboy_websocket}.
|
||||
|
||||
handle(_Req, State) ->
|
||||
{ok, Response} = cowboy_http_req:reply(404, [{'Content-Type', <<"text/html">>}]),
|
||||
{ok, Response, State}.
|
||||
|
||||
websocket_init(_TransportName, Req, _Opts) ->
|
||||
lager:info("init websocket"),
|
||||
{ok, Game} = server_game:start_link(),
|
||||
{ok, Pid} = player_websocket:start_link(self()),
|
||||
Player = player:new("Websocket", Pid),
|
||||
gen_fsm:send_event(Game, {add_player, Player}),
|
||||
[gen_fsm:send_event(Game,{add_player, player:new()})
|
||||
|| _N <- lists:seq(1, 3)],
|
||||
{ok, Req, #state{game=Game,player=Player}}.
|
||||
|
||||
websocket_handle({text, Msg}, Req, State) ->
|
||||
lager:info("Got Data: ~p", [Msg]),
|
||||
{reply, {text, << "responding to ", Msg/binary >>}, Req, State, hibernate };
|
||||
|
||||
|
||||
websocket_handle(_Any, Req, State) ->
|
||||
{reply, {text, << "whut?">>}, Req, State, hibernate }.
|
||||
|
||||
websocket_info({timeout, _Ref, Msg}, Req, State) ->
|
||||
{reply, {text, Msg}, Req, State};
|
||||
|
||||
websocket_info(Info, Req, State) ->
|
||||
lager:info("websocket info: ~p", [Info]),
|
||||
case encode(Info) of
|
||||
{ok, Msg} ->
|
||||
{reply, {text, Msg}, Req, State};
|
||||
{error, _Reason} ->
|
||||
lager:error("Unhandled message: ~p", [Info]),
|
||||
{ok, Req, State, hibernate}
|
||||
end.
|
||||
|
||||
websocket_terminate(_Reason, _Req, _State) ->
|
||||
ok.
|
||||
|
||||
terminate(_Reason, _Req, _State) ->
|
||||
ok.
|
||||
|
||||
encode({log, Msg}) ->
|
||||
{ok, io_lib:format("log: ~s", [Msg])};
|
||||
encode({new_state, Game}) ->
|
||||
{ok, ["new_state: ", jsx:encode(encode_game(Game))]};
|
||||
encode(_) ->
|
||||
{error, invalid_message}.
|
||||
|
||||
encode_game(Game) ->
|
||||
#{round => Game#game.round,
|
||||
turn => Game#game.turn,
|
||||
phase => Game#game.phase,
|
||||
wall => length(Game#game.wall),
|
||||
dora => lists:map(fun encode_tile/1, Game#game.dora),
|
||||
players => lists:map(fun encode_player/1, Game#game.players)}.
|
||||
|
||||
encode_tile(Tile) ->
|
||||
#{suit => Tile#tile.suit,
|
||||
value => Tile#tile.value,
|
||||
from => Tile#tile.from}.
|
||||
|
||||
encode_player(Player) ->
|
||||
#{name => list_to_binary(Player#player.name),
|
||||
seat => Player#player.seat,
|
||||
hand => encode_hand(Player#player.hand),
|
||||
discards => lists:map(fun encode_tile/1, Player#player.discards)}.
|
||||
|
||||
encode_hand(Hand) ->
|
||||
#{tiles => lists:map(fun encode_tile/1, Hand#hand.tiles),
|
||||
melds => lists:map(fun encode_meld/1, Hand#hand.melds)}.
|
||||
|
||||
encode_meld(Meld) ->
|
||||
#{type => Meld#meld.type,
|
||||
tiles => lists:map(fun encode_tile/1, Meld#meld.tiles)}.
|
Loading…
Reference in a new issue