Compare commits
8 Commits
74d844b60f
...
master
| Author | SHA1 | Date | |
|---|---|---|---|
| b68222dab7 | |||
| 237630054b | |||
| 54d1229c9f | |||
| 4acfc0911a | |||
| 6968a732d8 | |||
| 0d31433b96 | |||
| b0c9c5ec18 | |||
| e56560bcce |
13
Go.elm
13
Go.elm
@@ -1,6 +1,6 @@
|
|||||||
import Go.Types exposing (..)
|
import Go.Types exposing (..)
|
||||||
import Go.Game exposing (verify)
|
import Go.Game exposing (verify)
|
||||||
import Go.Decoders exposing (decodeUpdatestring)
|
import Go.Decoders exposing (decodeUpdateString)
|
||||||
import Go.Ws exposing (..)
|
import Go.Ws exposing (..)
|
||||||
import Go.View exposing (..)
|
import Go.View exposing (..)
|
||||||
import WebSocket
|
import WebSocket
|
||||||
@@ -20,7 +20,7 @@ initDummy : (Model, Cmd Msg)
|
|||||||
initDummy = (Model
|
initDummy = (Model
|
||||||
Black
|
Black
|
||||||
"ws://localhost:3000"
|
"ws://localhost:3000"
|
||||||
1
|
"debug"
|
||||||
9
|
9
|
||||||
Nothing
|
Nothing
|
||||||
Nothing
|
Nothing
|
||||||
@@ -28,8 +28,7 @@ initDummy = (Model
|
|||||||
|
|
||||||
view : Model -> Html Msg
|
view : Model -> Html Msg
|
||||||
view m = div []
|
view m = div []
|
||||||
[ text (toString m.currentColor)
|
[ renderBoard m.sessionSize m.board
|
||||||
, renderBoard m.sessionSize m.board
|
|
||||||
]
|
]
|
||||||
|
|
||||||
update : Msg -> Model -> (Model, Cmd Msg)
|
update : Msg -> Model -> (Model, Cmd Msg)
|
||||||
@@ -37,13 +36,13 @@ update msg model = case msg of
|
|||||||
Place indx -> case verify (indx, model.sessionColor) model of
|
Place indx -> case verify (indx, model.sessionColor) model of
|
||||||
Nothing -> ( { model | error = Just "Can't place piece" }, Cmd.none)
|
Nothing -> ( { model | error = Just "Can't place piece" }, Cmd.none)
|
||||||
Just c -> ( { model | board = c::model.board }, sendMove model c)
|
Just c -> ( { model | board = c::model.board }, sendMove model c)
|
||||||
Update s -> case decodeUpdatestring s of
|
Update s -> case decodeUpdateString s of
|
||||||
Ok (c, xs) -> ( { model | board = xs, currentColor = Just c }, Cmd.none)
|
Ok (c, xs) -> ( { model | board = xs, currentColor = Just c }, Cmd.none)
|
||||||
Err s -> ( { model | error = Just "Can't parse server response" }, Cmd.none)
|
Err s -> ( { model | error = Just "Can't parse server response" }, Cmd.none)
|
||||||
DismissError -> ({ model | error = Nothing }, Cmd.none)
|
DismissError -> ({ model | error = Nothing }, Cmd.none)
|
||||||
|
|
||||||
subscriptions : Model -> Sub Msg
|
subscriptions : Model -> Sub Msg
|
||||||
subscriptions m =
|
subscriptions m =
|
||||||
WebSocket.listen m.sessionUrl Update
|
WebSocket.listen (wsUrl m) Update
|
||||||
|
|
||||||
main = Html.program { init = initDummy, update = update, subscriptions = subscriptions, view = view }
|
main = Html.programWithFlags { init = init, update = update, subscriptions = subscriptions, view = view }
|
||||||
|
|||||||
@@ -30,5 +30,5 @@ decodeUpdate = decode pair
|
|||||||
|> required "turn" decodeColor
|
|> required "turn" decodeColor
|
||||||
|> required "board" (Decode.list decodeCell)
|
|> required "board" (Decode.list decodeCell)
|
||||||
|
|
||||||
decodeUpdatestring : String -> Result String Update
|
decodeUpdateString : String -> Result String Update
|
||||||
decodeUpdatestring = Decode.decodeString decodeUpdate
|
decodeUpdateString = Decode.decodeString decodeUpdate
|
||||||
|
|||||||
@@ -1,6 +1,8 @@
|
|||||||
module Go.Game exposing (verify)
|
module Go.Game exposing (verify)
|
||||||
import Go.Types exposing (..)
|
import Go.Types exposing (..)
|
||||||
import Go.Util exposing (lookup)
|
import Go.Util exposing (lookup)
|
||||||
|
import List exposing (foldl)
|
||||||
|
import Maybe exposing (andThen)
|
||||||
|
|
||||||
-- Make sure it's our turn to play.
|
-- Make sure it's our turn to play.
|
||||||
verifyTurn : Model -> Cell -> Maybe Cell
|
verifyTurn : Model -> Cell -> Maybe Cell
|
||||||
@@ -24,7 +26,7 @@ verifyBounds model ((x, y), c) = if x >= 0 && x < model.sessionSize && y >= 0 &&
|
|||||||
|
|
||||||
-- Verify a cell placemenet using a list of verification functions.
|
-- Verify a cell placemenet using a list of verification functions.
|
||||||
verifyAll : Cell -> List (Model -> Cell -> Maybe Cell) -> Model -> Maybe Cell
|
verifyAll : Cell -> List (Model -> Cell -> Maybe Cell) -> Model -> Maybe Cell
|
||||||
verifyAll cell funcs model = List.foldl (\a b -> Maybe.andThen (a model) b) (Just cell) funcs
|
verifyAll cell funcs model = List.foldl (\a b -> andThen (a model) b) (Just cell) funcs
|
||||||
|
|
||||||
-- Make sure that a move to the given cell can be made.
|
-- Make sure that a move to the given cell can be made.
|
||||||
verify : Cell -> Model -> Maybe Cell
|
verify : Cell -> Model -> Maybe Cell
|
||||||
|
|||||||
@@ -10,7 +10,7 @@ type alias Update = (Color, List Cell)
|
|||||||
type alias Model =
|
type alias Model =
|
||||||
{ sessionColor : Color
|
{ sessionColor : Color
|
||||||
, sessionUrl : String
|
, sessionUrl : String
|
||||||
, sessionId : Int
|
, sessionId : String
|
||||||
, sessionSize : Int
|
, sessionSize : Int
|
||||||
|
|
||||||
, error : Maybe String
|
, error : Maybe String
|
||||||
@@ -21,7 +21,7 @@ type alias Model =
|
|||||||
type alias Flags =
|
type alias Flags =
|
||||||
{ black : Bool
|
{ black : Bool
|
||||||
, url : String
|
, url : String
|
||||||
, id : Int
|
, id : String
|
||||||
, size : Int
|
, size : Int
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
13
Go/Util.elm
13
Go/Util.elm
@@ -1,27 +1,34 @@
|
|||||||
module Go.Util exposing (..)
|
module Go.Util exposing (..)
|
||||||
import Go.Types exposing (..)
|
import Go.Types exposing (..)
|
||||||
|
import List exposing (map, head, filter, range)
|
||||||
|
import Tuple exposing (second, first)
|
||||||
|
|
||||||
|
-- Creates a pair of two elements.
|
||||||
pair : a -> b -> (a, b)
|
pair : a -> b -> (a, b)
|
||||||
pair a1 a2 = (a1, a2)
|
pair a1 a2 = (a1, a2)
|
||||||
|
|
||||||
-- Search for a value in a list of key-value pairs.
|
-- Search for a value in a list of key-value pairs.
|
||||||
lookup : a -> List (a, b) -> Maybe b
|
lookup : a -> List (a, b) -> Maybe b
|
||||||
lookup val list = Maybe.map Tuple.second (List.head (List.filter (\(a, _) -> a == val) list))
|
lookup val list = Maybe.map second
|
||||||
|
<| head
|
||||||
|
<| filter ((\a -> a == val) << first) list
|
||||||
|
|
||||||
-- Computes all possible indices on a board of size n.
|
-- Computes all possible indices on a board of size n.
|
||||||
allIndices : Int -> List Index
|
allIndices : Int -> List Index
|
||||||
allIndices n =
|
allIndices n =
|
||||||
let
|
let
|
||||||
vals = List.range 0 (n - 1)
|
vals = range 0 (n - 1)
|
||||||
pairs = \xs i -> List.map (\x -> (i, x)) xs
|
pairs = \xs i -> map (pair i) xs
|
||||||
in
|
in
|
||||||
List.concatMap (pairs vals) vals
|
List.concatMap (pairs vals) vals
|
||||||
|
|
||||||
|
|
||||||
|
-- Computes a zip of two lists.
|
||||||
zip : List a -> List b -> List (a, b)
|
zip : List a -> List b -> List (a, b)
|
||||||
zip xs ys = case (xs, ys) of
|
zip xs ys = case (xs, ys) of
|
||||||
(x::xb, y::yb) -> (x, y) :: (zip xb yb)
|
(x::xb, y::yb) -> (x, y) :: (zip xb yb)
|
||||||
_ -> []
|
_ -> []
|
||||||
|
|
||||||
|
-- Swaps the arguments of a two-argument function.
|
||||||
swap : (a -> b -> c) -> b -> a -> c
|
swap : (a -> b -> c) -> b -> a -> c
|
||||||
swap f vb va = f va vb
|
swap f vb va = f va vb
|
||||||
|
|||||||
@@ -4,6 +4,7 @@ import Go.Types exposing (..)
|
|||||||
import Html exposing (Html, div, text, p)
|
import Html exposing (Html, div, text, p)
|
||||||
import Html.Attributes exposing (class, classList)
|
import Html.Attributes exposing (class, classList)
|
||||||
import Html.Events exposing (onClick)
|
import Html.Events exposing (onClick)
|
||||||
|
import List exposing (map)
|
||||||
|
|
||||||
renderIndex : (Index, Maybe Color) -> Html Msg
|
renderIndex : (Index, Maybe Color) -> Html Msg
|
||||||
renderIndex (index, color) =
|
renderIndex (index, color) =
|
||||||
@@ -15,12 +16,12 @@ renderIndex (index, color) =
|
|||||||
div [ classList [ ("board-cell", True), extraClass ]
|
div [ classList [ ("board-cell", True), extraClass ]
|
||||||
, onClick (Place index)
|
, onClick (Place index)
|
||||||
]
|
]
|
||||||
[
|
[ div [ class "overlay" ] []
|
||||||
]
|
]
|
||||||
|
|
||||||
renderBoard : Int -> Board -> Html Msg
|
renderBoard : Int -> Board -> Html Msg
|
||||||
renderBoard size board =
|
renderBoard size board =
|
||||||
let
|
let
|
||||||
cells = List.map (\i -> (lookup i board) |> (pair i)) <| allIndices size
|
cells = map (\i -> (i, lookup i board)) <| allIndices size
|
||||||
in
|
in
|
||||||
div [ class "board" ] <| List.map renderIndex cells
|
div [ class "board" ] <| map renderIndex cells
|
||||||
|
|||||||
@@ -2,6 +2,9 @@ module Go.Ws exposing (..)
|
|||||||
import Go.Types exposing (..)
|
import Go.Types exposing (..)
|
||||||
import WebSocket
|
import WebSocket
|
||||||
|
|
||||||
|
wsUrl : Model -> String
|
||||||
|
wsUrl m = (m.sessionUrl ++ "/game/" ++ m.sessionId)
|
||||||
|
|
||||||
encodeCell : Cell -> String
|
encodeCell : Cell -> String
|
||||||
encodeCell ((x, y), c) = "place "
|
encodeCell ((x, y), c) = "place "
|
||||||
++ (toString x) ++ " "
|
++ (toString x) ++ " "
|
||||||
@@ -9,4 +12,4 @@ encodeCell ((x, y), c) = "place "
|
|||||||
++ (toString c)
|
++ (toString c)
|
||||||
|
|
||||||
sendMove : Model -> Cell -> Cmd Msg
|
sendMove : Model -> Cell -> Cmd Msg
|
||||||
sendMove m c = WebSocket.send m.sessionUrl (encodeCell c)
|
sendMove m c = WebSocket.send (wsUrl m) (encodeCell c)
|
||||||
|
|||||||
Reference in New Issue
Block a user