Write a basic view function. Without styling, it's impossible to see.
This commit is contained in:
parent
0283e060e4
commit
43ad995c62
8
Go.elm
8
Go.elm
|
@ -2,6 +2,7 @@ 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 WebSocket
|
import WebSocket
|
||||||
import Html exposing (Html, div, text)
|
import Html exposing (Html, div, text)
|
||||||
|
|
||||||
|
@ -26,11 +27,14 @@ initDummy = (Model
|
||||||
[], Cmd.none)
|
[], Cmd.none)
|
||||||
|
|
||||||
view : Model -> Html Msg
|
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 -> (Model, Cmd Msg)
|
||||||
update msg model = case msg of
|
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)
|
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
|
||||||
|
|
|
@ -1,11 +1,9 @@
|
||||||
module Go.Decoders exposing (..)
|
module Go.Decoders exposing (..)
|
||||||
import Go.Types exposing (..)
|
import Go.Types exposing (..)
|
||||||
|
import Go.Util exposing (pair)
|
||||||
import Json.Decode as Decode
|
import Json.Decode as Decode
|
||||||
import Json.Decode.Pipeline exposing (decode, required)
|
import Json.Decode.Pipeline exposing (decode, required)
|
||||||
|
|
||||||
pair : a -> b -> (a, b)
|
|
||||||
pair a1 a2 = (a1, a2)
|
|
||||||
|
|
||||||
decodeIndex : Decode.Decoder Index
|
decodeIndex : Decode.Decoder Index
|
||||||
decodeIndex = decode pair
|
decodeIndex = decode pair
|
||||||
|> required "x" Decode.int
|
|> required "x" Decode.int
|
||||||
|
|
|
@ -26,6 +26,6 @@ type alias Flags =
|
||||||
}
|
}
|
||||||
|
|
||||||
type Msg =
|
type Msg =
|
||||||
Place Cell
|
Place Index
|
||||||
| Update String
|
| Update String
|
||||||
| DismissError
|
| DismissError
|
||||||
|
|
|
@ -1,6 +1,9 @@
|
||||||
module Go.Util exposing (..)
|
module Go.Util exposing (..)
|
||||||
import Go.Types 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.
|
-- 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 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
|
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)
|
||||||
_ -> []
|
_ -> []
|
||||||
|
|
||||||
|
swap : (a -> b -> c) -> b -> a -> c
|
||||||
|
swap f vb va = f va vb
|
||||||
|
|
26
Go/View.elm
Normal file
26
Go/View.elm
Normal file
|
@ -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
|
Loading…
Reference in New Issue
Block a user