summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/battlemap/elm-package.json1
-rw-r--r--src/battlemap/src/Action/Scroll.elm53
-rw-r--r--src/battlemap/src/Constants/UI.elm3
-rw-r--r--src/battlemap/src/ElmModule/Update.elm8
-rw-r--r--src/battlemap/src/ElmModule/View.elm5
-rw-r--r--src/battlemap/src/Struct/Error.elm2
-rw-r--r--src/battlemap/src/Struct/Event.elm12
-rw-r--r--src/battlemap/src/Update/SelectCharacter.elm20
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 ->