Scrolls to show focused character (WIP).

8 files changed, 100 insertions, 4 deletions

diff --git a/src/battlemap/elm-package.json b/src/battlemap/elm-package.json
index 82d19f0..5f6573f 100644
--- a/src/battlemap/elm-package.json
+++ b/src/battlemap/elm-package.json
@@ -10,6 +10,7 @@
     "dependencies": {
         "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0",
         "elm-lang/core": "5.1.1 <= v < 6.0.0",
+        "elm-lang/dom": "1.1.1 <= v < 2.0.0",
         "elm-lang/html": "2.0.0 <= v < 3.0.0",
         "elm-lang/http": "1.0.0 <= v < 2.0.0"
     },
diff --git a/src/battlemap/src/Action/Scroll.elm b/src/battlemap/src/Action/Scroll.elm
new file mode 100644
index 0000000..e84e6d5
--- /dev/null
+++ b/src/battlemap/src/Action/Scroll.elm
@@ -0,0 +1,53 @@
+module Action.Scroll exposing (to)
+
+-- Elm -------------------------------------------------------------------------
+import Dom
+import Dom.Scroll
+
+import Task
+
+-- Battlemap -------------------------------------------------------------------
+import Constants.UI
+
+import Struct.UI
+import Struct.Location
+
+--------------------------------------------------------------------------------
+-- LOCAL -----------------------------------------------------------------------
+--------------------------------------------------------------------------------
+-- FIXME: Scrolling so that the focused element is in the middle, not in the top
+-- left corner, would be much better.
+
+scroll_to_x : Int -> Struct.UI.Type -> (Task.Task Dom.Error ())
+scroll_to_x x ui =
+   (Dom.Scroll.toX
+      Constants.UI.viewer_html_id
+      (
+         (toFloat x)
+         * (Struct.UI.get_zoom_level ui)
+         * (toFloat Constants.UI.tile_size)
+      )
+   )
+
+scroll_to_y : Int -> Struct.UI.Type -> (Task.Task Dom.Error ())
+scroll_to_y y ui =
+   (Dom.Scroll.toY
+      Constants.UI.viewer_html_id
+      (
+         (toFloat y)
+         * (Struct.UI.get_zoom_level ui)
+         * (toFloat Constants.UI.tile_size)
+      )
+   )
+
+--------------------------------------------------------------------------------
+-- EXPORTED --------------------------------------------------------------------
+--------------------------------------------------------------------------------
+to : Struct.Location.Type -> Struct.UI.Type -> (Task.Task Dom.Error (List ()))
+to loc ui =
+   (Task.sequence
+      [
+         (scroll_to_x loc.x ui),
+         (scroll_to_y loc.y ui)
+      ]
+   )
diff --git a/src/battlemap/src/Constants/UI.elm b/src/battlemap/src/Constants/UI.elm
index eca47b7..303f69e 100644
--- a/src/battlemap/src/Constants/UI.elm
+++ b/src/battlemap/src/Constants/UI.elm
@@ -2,3 +2,6 @@ module Constants.UI exposing (..)
 
 tile_size : Int
 tile_size = 32
+
+viewer_html_id : String
+viewer_html_id = "battlemap_viewer"
diff --git a/src/battlemap/src/ElmModule/Update.elm b/src/battlemap/src/ElmModule/Update.elm
index 3a01c23..14fd7f3 100644
--- a/src/battlemap/src/ElmModule/Update.elm
+++ b/src/battlemap/src/ElmModule/Update.elm
@@ -38,6 +38,14 @@ update event model =
       new_model = (Struct.Model.clear_error model)
    in
    case event of
+      Struct.Event.None -> (model, Cmd.none)
+
+      (Struct.Event.Failed err) ->
+         (
+            (Struct.Model.invalidate err new_model),
+            Cmd.none
+         )
+
       Struct.Event.AttackWithoutMovingRequest ->
          (Update.AttackWithoutMoving.apply_to new_model)
 
diff --git a/src/battlemap/src/ElmModule/View.elm b/src/battlemap/src/ElmModule/View.elm
index bb25fb7..05fbc1c 100644
--- a/src/battlemap/src/ElmModule/View.elm
+++ b/src/battlemap/src/ElmModule/View.elm
@@ -5,6 +5,8 @@ import Html
 import Html.Attributes
 
 -- Battlemap -------------------------------------------------------------------
+import Constants.UI
+
 import Struct.Event
 import Struct.Model
 
@@ -32,7 +34,8 @@ view model =
          (View.Controlled.get_html model),
          (Html.div
             [
-               (Html.Attributes.class "battlemap-container")
+               (Html.Attributes.class "battlemap-container"),
+               (Html.Attributes.id Constants.UI.viewer_html_id)
             ]
             [(View.Battlemap.get_html model)]
          ),
diff --git a/src/battlemap/src/Struct/Error.elm b/src/battlemap/src/Struct/Error.elm
index 3607d1d..5f40c09 100644
--- a/src/battlemap/src/Struct/Error.elm
+++ b/src/battlemap/src/Struct/Error.elm
@@ -8,6 +8,7 @@ type Mode =
    | Programming
    | Unimplemented
    | Networking
+   | Failure
 
 type alias Type =
    {
@@ -33,6 +34,7 @@ to_string : Type -> String
 to_string e =
    (
       (case e.mode of
+         Failure -> "The action failed: "
          IllegalAction -> "Request discarded: "
          Programming -> "Error in the program (please report): "
          Unimplemented -> "Update discarded due to unimplemented feature: "
diff --git a/src/battlemap/src/Struct/Event.elm b/src/battlemap/src/Struct/Event.elm
index bc4de17..0aaa774 100644
--- a/src/battlemap/src/Struct/Event.elm
+++ b/src/battlemap/src/Struct/Event.elm
@@ -1,4 +1,4 @@
-module Struct.Event exposing (Type(..))
+module Struct.Event exposing (Type(..), attempted)
 
 -- Elm -------------------------------------------------------------------------
 import Http
@@ -6,6 +6,7 @@ import Http
 -- Battlemap -------------------------------------------------------------------
 import Struct.Character
 import Struct.Direction
+import Struct.Error
 import Struct.Location
 import Struct.ServerReply
 import Struct.UI
@@ -27,3 +28,12 @@ type Type =
    | WeaponSwitchRequest
    | AttackWithoutMovingRequest
    | AbortTurnRequest
+   | None
+   | Failed Struct.Error.Type
+
+attempted : (Result.Result err val) -> Type
+attempted act =
+   case act of
+      (Result.Ok _) -> None
+      (Result.Err msg) ->
+         (Failed (Struct.Error.new Struct.Error.Failure (toString msg)))
diff --git a/src/battlemap/src/Update/SelectCharacter.elm b/src/battlemap/src/Update/SelectCharacter.elm
index 1e2c2df..7a4e736 100644
--- a/src/battlemap/src/Update/SelectCharacter.elm
+++ b/src/battlemap/src/Update/SelectCharacter.elm
@@ -3,7 +3,11 @@ module Update.SelectCharacter exposing (apply_to)
 -- Elm -------------------------------------------------------------------------
 import Dict
 
+import Task
+
 -- Battlemap -------------------------------------------------------------------
+import Action.Scroll
+
 import Struct.Battlemap
 import Struct.Character
 import Struct.CharacterTurn
@@ -149,13 +153,25 @@ double_clicked_character model target_char_id =
                else
                   (
                      (ctrl_or_focus_character model target_char_id target_char),
-                     Cmd.none
+                     (Task.attempt
+                        (Struct.Event.attempted)
+                        (Action.Scroll.to
+                           (Struct.Character.get_location target_char)
+                           model.ui
+                        )
+                     )
                   )
 
             _ ->
                (
                   (ctrl_or_focus_character model target_char_id target_char),
-                  Cmd.none
+                  (Task.attempt
+                     (Struct.Event.attempted)
+                     (Action.Scroll.to
+                        (Struct.Character.get_location target_char)
+                        model.ui
+                     )
+                  )
                )
 
       Nothing ->