Write a basic view function. Without styling, it's impossible to see.

This commit is contained in:
Danila Fedorin 2018-05-25 12:06:15 -07:00
parent 0283e060e4
commit 43ad995c62
5 changed files with 40 additions and 6 deletions

8
Go.elm
View File

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

View File

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

View File

@ -26,6 +26,6 @@ type alias Flags =
} }
type Msg = type Msg =
Place Cell Place Index
| Update String | Update String
| DismissError | DismissError

View File

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