diff --git a/Go.elm b/Go.elm index 04d3a17..3642b19 100644 --- a/Go.elm +++ b/Go.elm @@ -2,6 +2,7 @@ import Go.Types exposing (..) import Go.Game exposing (verify) import Go.Decoders exposing (decodeUpdatestring) import Go.Ws exposing (..) +import Go.View exposing (..) import WebSocket import Html exposing (Html, div, text) @@ -26,11 +27,14 @@ initDummy = (Model [], Cmd.none) view : Model -> Html Msg -view m = div [] [ text (toString m.currentColor) ] +view m = div [] + [ text (toString m.currentColor) + , renderBoard m.sessionSize m.board + ] update : Msg -> Model -> (Model, Cmd Msg) update msg model = case msg of - Place c -> case verify c model of + Place indx -> case verify (indx, model.sessionColor) model of Nothing -> ( { model | error = Just "Can't place piece" }, Cmd.none) Just c -> ( { model | board = c::model.board }, sendMove model c) Update s -> case decodeUpdatestring s of diff --git a/Go/Decoders.elm b/Go/Decoders.elm index ceb4800..30d045e 100644 --- a/Go/Decoders.elm +++ b/Go/Decoders.elm @@ -1,11 +1,9 @@ module Go.Decoders exposing (..) import Go.Types exposing (..) +import Go.Util exposing (pair) import Json.Decode as Decode import Json.Decode.Pipeline exposing (decode, required) -pair : a -> b -> (a, b) -pair a1 a2 = (a1, a2) - decodeIndex : Decode.Decoder Index decodeIndex = decode pair |> required "x" Decode.int diff --git a/Go/Types.elm b/Go/Types.elm index 9871d23..cf8357a 100644 --- a/Go/Types.elm +++ b/Go/Types.elm @@ -26,6 +26,6 @@ type alias Flags = } type Msg = - Place Cell + Place Index | Update String | DismissError diff --git a/Go/Util.elm b/Go/Util.elm index 223e410..d9d9c81 100644 --- a/Go/Util.elm +++ b/Go/Util.elm @@ -1,6 +1,9 @@ module Go.Util exposing (..) import Go.Types exposing (..) +pair : a -> b -> (a, b) +pair a1 a2 = (a1, a2) + -- Search for a value in a list of key-value pairs. lookup : a -> List (a, b) -> Maybe b lookup val list = Maybe.map Tuple.second (List.head (List.filter (\(a, _) -> a == val) list)) @@ -19,3 +22,6 @@ zip : List a -> List b -> List (a, b) zip xs ys = case (xs, ys) of (x::xb, y::yb) -> (x, y) :: (zip xb yb) _ -> [] + +swap : (a -> b -> c) -> b -> a -> c +swap f vb va = f va vb diff --git a/Go/View.elm b/Go/View.elm new file mode 100644 index 0000000..856e504 --- /dev/null +++ b/Go/View.elm @@ -0,0 +1,26 @@ +module Go.View exposing (..) +import Go.Util exposing (allIndices, pair, lookup) +import Go.Types exposing (..) +import Html exposing (Html, div, text, p) +import Html.Attributes exposing (class, classList) +import Html.Events exposing (onClick) + +renderIndex : (Index, Maybe Color) -> Html Msg +renderIndex (index, color) = + let + extraClass = case color of + Just c -> (if c == Black then "black-cell" else "white-cell", True) + Nothing -> ("", False) + in + div [ classList [ ("board-cell", True), extraClass ] + , onClick (Place index) + ] + [ + ] + +renderBoard : Int -> Board -> Html Msg +renderBoard size board = + let + cells = List.map (\i -> (lookup i board) |> (pair i)) <| allIndices size + in + div [] <| List.map renderIndex cells