Compare commits

...

8 Commits

7 changed files with 31 additions and 19 deletions

13
Go.elm
View File

@@ -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 }

View File

@@ -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

View File

@@ -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

View File

@@ -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
} }

View File

@@ -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

View File

@@ -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

View File

@@ -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)