Clicking the move command triggers movement

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,35 +52,61 @@ 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"
                     ]
                     []
                 ]
 
 
+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

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

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