From c54834bf163a22839c7ac78774a362825646e700 Mon Sep 17 00:00:00 2001 From: Mark Wunsch Date: Fri, 21 Oct 2016 14:01:09 -0400 Subject: [PATCH] Clicking the move command triggers movement --- src/Action.elm | 55 ++++++++++++++++++++++++++++++++++++++------------ src/Main.elm | 44 +++++++++++++++++++++++++++------------- src/Player.elm | 20 +++++++++++++++--- 3 files changed, 89 insertions(+), 30 deletions(-) diff --git a/src/Action.elm b/src/Action.elm index a3d8c8d..9bf8526 100644 --- a/src/Action.elm +++ b/src/Action.elm @@ -1,5 +1,7 @@ module Action exposing (..) +import Html.Events exposing (onWithOptions) +import Json.Decode as Json import List import Model exposing (Model) import String @@ -24,7 +26,8 @@ select : Phase -> Model -> List Action select phase fighter = case phase of Movement -> - [ Move, Charge, Run, Hide, Cancel ] + -- [ Charge, Run, Hide, Cancel, + [ Move ] Shooting -> [ Shoot, Cancel ] @@ -49,16 +52,20 @@ symbol action = String.fromChar '🔜' -view : Action -> Phase -> Model -> Svg msg -view action phase model = - case action of - Await -> - viewSelection phase model +{-| TODO: Consider moving into a module +-} +onClick : msg -> Svg.Attribute msg +onClick message = + onWithOptions "click" { stopPropagation = True, preventDefault = False } (Json.succeed message) + +view : Action -> Phase -> Model -> (Action -> msg) -> Svg msg +view action phase model msg = + case action of _ -> g [ transformTranslate model.position ] [ circle - [ r (Tabletop.millimeter 25 |> toString) + [ r (Tabletop.millimeter 20 |> toString) , fill "red" , opacity "0.15" ] @@ -66,18 +73,40 @@ view action phase model = ] +viewControl : Action -> msg -> Svg msg +viewControl action msg = + g + [ transform "translate(0,1.15)" + , onClick msg + , Svg.Attributes.cursor "pointer" + ] + [ circle + [ r (Tabletop.millimeter 12 |> toString) + , fill "white" + , opacity "0.75" + ] + [] + , text' + [ fontSize (Tabletop.millimeter 15 |> toString) + , textAnchor "middle" + , alignmentBaseline "middle" + ] + [ text (symbol action) ] + ] + + {-| TODO: Just drawing a circle for now until can come up with better HUD. -} -viewSelection : Phase -> Model -> Svg msg -viewSelection phase { position } = - g [ transformTranslate position ] - [ circle - [ r (Tabletop.millimeter 35 |> toString) +viewSelection : Phase -> Model -> (Action -> msg) -> Svg msg +viewSelection phase model msg = + g [ transformTranslate model.position ] <| + circle + [ r "1.25" , fill "white" , opacity "0.15" ] [] - ] + :: List.map (\action -> viewControl action (msg action)) (select phase model) emptyView : Svg msg diff --git a/src/Main.elm b/src/Main.elm index 6d55fa9..a9e330b 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -14,6 +14,7 @@ import Model exposing (Model) import Mouse import Player exposing (Player) import Random +import Result import String exposing (join) import Svg exposing (..) import Svg.Attributes exposing (..) @@ -72,7 +73,7 @@ init = type Msg = Select Model | Click Mouse.Position - | Command Model Action + | Command Action -- idea here is to command a model to perform a certain action | Hover Mouse.Position | KeyPress Keyboard.KeyCode @@ -95,17 +96,37 @@ update msg game = pos = positionFromMouseCoords ( x, y ) game.windowScale in - if Tabletop.isWithinDistance 2 fighter.position pos then - ( game, Cmd.none ) - else - ( { game | player = Player.deselectAll game.player }, Cmd.none ) + case game.player.action of + Action.Move -> + let + move : Model -> Model + move f = + case Model.attemptMove f pos of + Ok model -> + model + + Err ( _, model ) -> + model + in + Gang.update fighter.id (Maybe.map move) game.player.gang + |> (\gang -> { game | player = game.player |> (\p -> { p | gang = gang, action = Action.Await }) }) + |> (flip (,)) Cmd.none + + _ -> + let + pos = + positionFromMouseCoords ( x, y ) game.windowScale + in + if Tabletop.isWithinDistance 2 fighter.position pos then + ( game, Cmd.none ) + else + ( { game | player = Player.deselectAll game.player }, Cmd.none ) Nothing -> ( game, Cmd.none ) - Command _ _ -> - -- TODO - ( game, Cmd.none ) + Command action -> + ( { game | player = game.player |> \p -> { p | action = action } }, Cmd.none ) Hover { x, y } -> ( { game @@ -204,13 +225,8 @@ onClickWithCoords message = view : GameState -> Html Msg view game = let - measuringTape = - Player.getSelectedGangMember game.player - |> Maybe.map (\fighter -> Tabletop.viewMeasuringTape fighter.position game.player.movementIntention fighter.remainingMove) - |> Maybe.withDefault (g [] []) - actionSelection = - Player.view game.player (Turn.phase game.turn) + Player.view game.player (Turn.phase game.turn) Command selectedFighterProfile = Player.getSelectedGangMember game.player diff --git a/src/Player.elm b/src/Player.elm index 0ee4510..1f4c019 100644 --- a/src/Player.elm +++ b/src/Player.elm @@ -33,6 +33,7 @@ selectModel player id = .gang (deselectAll player) |> Gang.update id (Maybe.map (\f -> { f | selected = True })) , selection = Just id + , action = Await } @@ -51,8 +52,21 @@ getSelectedGangMember player = player.selection `andThen` (flip Gang.get) player.gang -view : Player -> Phase -> Svg msg -view player phase = +view : Player -> Phase -> (Action -> msg) -> Svg msg +view player phase msg = getSelectedGangMember player - |> Maybe.map (Action.view player.action phase) + |> Maybe.map (actionView player phase msg) |> Maybe.withDefault (Action.emptyView) + + +actionView : Player -> Phase -> (Action -> msg) -> Model -> Svg msg +actionView player phase msg fighter = + case player.action of + Await -> + Action.viewSelection phase fighter msg + + Move -> + Tabletop.viewMeasuringTape fighter.position player.movementIntention fighter.remainingMove + + _ -> + Action.view player.action phase fighter msg