Add tileset toggle

This commit is contained in:
Correl Roush 2017-08-17 23:31:24 -04:00
parent 671598933c
commit be02a1fa12
2 changed files with 38 additions and 6 deletions

View file

@ -2,6 +2,8 @@ module Riichi exposing (..)
import Hand
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Html.CssHelpers
import Stylesheets as S
@ -11,16 +13,19 @@ import Stylesheets as S
type alias Model =
{ hand : Hand.Model }
{ tileset : S.Tileset
, hand : Hand.Model
}
type Msg
= Noop
= SetTileset S.Tileset
init : ( Model, Cmd Msg )
init =
( { hand =
( { tileset = S.White
, hand =
Hand.fromJSON
{ tiles =
[ "4 pin"
@ -42,7 +47,11 @@ init =
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
( model, Cmd.none )
case msg of
SetTileset tileset ->
( { model | tileset = tileset }
, Cmd.none
)
main : Program Never Model Msg
@ -57,7 +66,26 @@ main =
view : Model -> Html Msg
view model =
div [ class [ S.Tileset S.White ] ]
div [ class [ S.Tileset model.tileset ] ]
[ h1 [] [ text "Riichi Mahjong" ]
, fieldset []
[ legend [] [ text "Tile Set" ]
, radio "tileset" "White" (SetTileset S.White) (model.tileset == S.White)
, radio "tileset" "Black" (SetTileset S.Black) (model.tileset == S.Black)
]
, Hand.view model.hand
]
radio : String -> String -> Msg -> Bool -> Html Msg
radio name_ value msg checked_ =
label []
[ input
[ type_ "radio"
, name name_
, onClick msg
, checked checked_
]
[]
, text value
]

View file

@ -63,5 +63,9 @@ do(Tree, Action) ->
undefined ->
error(invalid_game_action);
Thunk ->
?FORCE(Thunk)
case Action of
tsumo -> {win, tsumo, Tree#game_tree.game};
ron -> {win, ron, Tree#game_tree.game};
_ -> ?FORCE(Thunk)
end
end.