Improves error msgs & UI controls.

9 files changed, 151 insertions, 32 deletions

diff --git a/elm/battlemap/src/Error.elm b/elm/battlemap/src/Error.elm
index e2906dc..581bb24 100644
--- a/elm/battlemap/src/Error.elm
+++ b/elm/battlemap/src/Error.elm
@@ -1,5 +1,29 @@
-module Error exposing (Type(..))
+module Error exposing (Type, Mode(..), new, to_string)
 
-type Type =
+type Mode =
    IllegalAction
    | Programming
+
+type alias Type =
+   {
+      mode: Mode,
+      message: String
+   }
+
+new : Mode -> String -> Type
+new mode str =
+   {
+      mode = mode,
+      message = str
+   }
+
+to_string : Type -> String
+to_string e =
+   (
+      (case e.mode of
+         IllegalAction -> "Request discarded: "
+         Programming -> "Error in the program (please report): "
+      )
+      ++ e.message
+   )
+
diff --git a/elm/battlemap/src/Model.elm b/elm/battlemap/src/Model.elm
index 4303b6f..437d118 100644
--- a/elm/battlemap/src/Model.elm
+++ b/elm/battlemap/src/Model.elm
@@ -1,10 +1,20 @@
-module Model exposing (Type, CharacterSelection, State(..))
+module Model exposing
+   (
+      Type,
+      CharacterSelection,
+      State(..),
+      get_state,
+      invalidate,
+      reset,
+      clear_error
+   )
 
 import Dict
 
 import Battlemap
 import Battlemap.Navigator
 import Battlemap.Location
+import Battlemap.Tile
 import Battlemap.RangeIndicator
 
 import Error
@@ -24,7 +34,6 @@ type alias CharacterSelection =
 
 type State =
    Default
-   | Error Error.Type
    | MovingCharacterWithButtons
    | MovingCharacterWithClick
    | FocusingTile
@@ -34,5 +43,28 @@ type alias Type =
       state: State,
       battlemap: Battlemap.Type,
       characters: (Dict.Dict Character.Ref Character.Type),
+      error: (Maybe Error.Type),
       selection: (Maybe CharacterSelection)
    }
+
+get_state : Type -> State
+get_state model = model.state
+
+reset : Type -> Type
+reset model =
+   {model |
+      state = Default,
+      selection = Nothing,
+      error = Nothing,
+      battlemap =
+         (Battlemap.apply_to_all_tiles
+            model.battlemap
+            (Battlemap.Tile.reset)
+         )
+   }
+
+invalidate : Type -> Error.Type -> Type
+invalidate model err = {model | error = (Just err)}
+
+clear_error : Type -> Type
+clear_error model = {model | error = Nothing}
diff --git a/elm/battlemap/src/Shim/Model.elm b/elm/battlemap/src/Shim/Model.elm
index 03c2450..1ebe723 100644
--- a/elm/battlemap/src/Shim/Model.elm
+++ b/elm/battlemap/src/Shim/Model.elm
@@ -11,6 +11,7 @@ generate =
    {
       state = Model.Default,
       selection = Nothing,
+      error = Nothing,
       battlemap = (Shim.Battlemap.generate),
       characters =
          (Dict.insert
diff --git a/elm/battlemap/src/Update.elm b/elm/battlemap/src/Update.elm
index b6b2a80..0947e99 100644
--- a/elm/battlemap/src/Update.elm
+++ b/elm/battlemap/src/Update.elm
@@ -11,15 +11,18 @@ import Update.EndTurn
 
 update : Event.Type -> Model.Type -> Model.Type
 update event model =
+   let
+      new_model = (Model.clear_error model)
+   in
    case event of
       (Event.DirectionRequest d) ->
-         (Update.DirectionRequest.apply_to model d)
+         (Update.DirectionRequest.apply_to new_model d)
 
       (Event.SelectTile loc) ->
-         (Update.SelectTile.apply_to model loc)
+         (Update.SelectTile.apply_to new_model loc)
 
       (Event.SelectCharacter char_id) ->
-         (Update.SelectCharacter.apply_to model char_id)
+         (Update.SelectCharacter.apply_to new_model char_id)
 
       Event.EndTurn ->
-         (Update.EndTurn.apply_to model)
+         (Update.EndTurn.apply_to new_model)
diff --git a/elm/battlemap/src/Update/DirectionRequest.elm b/elm/battlemap/src/Update/DirectionRequest.elm
index da32240..e069439 100644
--- a/elm/battlemap/src/Update/DirectionRequest.elm
+++ b/elm/battlemap/src/Update/DirectionRequest.elm
@@ -11,7 +11,14 @@ import Error
 make_it_so : Model.Type -> Battlemap.Direction.Type -> Model.Type
 make_it_so model dir =
    case model.selection of
-      Nothing -> {model | state = (Model.Error Error.Programming)}
+      Nothing ->
+         (Model.invalidate
+            model
+            (Error.new
+               Error.Programming
+               "DirectionRequest: model moving char, no selection."
+            )
+         )
       (Just selection) ->
          let
             (new_bmap, new_nav) =
@@ -31,7 +38,14 @@ make_it_so model dir =
 
 apply_to : Model.Type -> Battlemap.Direction.Type -> Model.Type
 apply_to model dir =
-   case model.state of
+   case (Model.get_state model) of
       Model.MovingCharacterWithButtons -> (make_it_so model dir)
       Model.MovingCharacterWithClick -> (make_it_so model dir)
-      _ -> {model | state = (Model.Error Error.IllegalAction)}
+      _ ->
+         (Model.invalidate
+            model
+            (Error.new
+               Error.IllegalAction
+               "This can only be done while moving a character."
+            )
+         )
diff --git a/elm/battlemap/src/Update/EndTurn.elm b/elm/battlemap/src/Update/EndTurn.elm
index b8b4ee5..ce9da28 100644
--- a/elm/battlemap/src/Update/EndTurn.elm
+++ b/elm/battlemap/src/Update/EndTurn.elm
@@ -14,10 +14,24 @@ import Error
 make_it_so : Model.Type -> Model.Type
 make_it_so model =
    case model.selection of
-      Nothing -> {model | state = (Model.Error Error.Programming)}
+      Nothing ->
+         (Model.invalidate
+            model
+            (Error.new
+               Error.Programming
+               "EndTurn: model moving char, no selection."
+            )
+         )
       (Just selection) ->
          case (Dict.get selection.character model.characters) of
-            Nothing -> {model | state = (Model.Error Error.Programming)}
+            Nothing ->
+               (Model.invalidate
+                  model
+                  (Error.new
+                     Error.Programming
+                     "EndTurn: model moving char, unknown char selected."
+                  )
+               )
             (Just char) ->
                {model |
                   state = Model.Default,
@@ -54,8 +68,14 @@ make_it_so model =
 
 apply_to : Model.Type -> Model.Type
 apply_to model =
-   case model.state of
+   case (Model.get_state model) of
       Model.MovingCharacterWithButtons -> (make_it_so model)
       Model.MovingCharacterWithClick -> (make_it_so model)
-      _ -> {model | state = (Model.Error Error.IllegalAction)}
-
+      _ ->
+         (Model.invalidate
+            model
+            (Error.new
+               Error.IllegalAction
+               "This can only be done while moving a character."
+            )
+         )
diff --git a/elm/battlemap/src/Update/SelectCharacter.elm b/elm/battlemap/src/Update/SelectCharacter.elm
index d42c7fc..570f82c 100644
--- a/elm/battlemap/src/Update/SelectCharacter.elm
+++ b/elm/battlemap/src/Update/SelectCharacter.elm
@@ -44,7 +44,14 @@ display_range dist loc_ref indicator bmap =
 make_it_so : Model.Type -> Character.Ref -> Model.Type
 make_it_so model char_id =
    case (Dict.get char_id model.characters) of
-      Nothing -> {model | state = (Model.Error Error.Programming)}
+      Nothing ->
+         (Model.invalidate
+            model
+            (Error.new
+               Error.Programming
+               "SelectCharacter: Unknown char selected."
+            )
+         )
       (Just char) ->
          let
             new_range_indicator =
@@ -84,5 +91,5 @@ make_it_so model char_id =
 
 apply_to : Model.Type -> Character.Ref -> Model.Type
 apply_to model char_id =
-   case model.state of
+   case (Model.get_state model) of
       _ -> (make_it_so model char_id)
diff --git a/elm/battlemap/src/Update/SelectTile.elm b/elm/battlemap/src/Update/SelectTile.elm
index aa89c30..cc2af35 100644
--- a/elm/battlemap/src/Update/SelectTile.elm
+++ b/elm/battlemap/src/Update/SelectTile.elm
@@ -24,10 +24,18 @@ autopilot dir model =
 go_to_tile : Model.Type -> Battlemap.Location.Ref -> Model.Type
 go_to_tile model loc_ref =
    case model.selection of
-      Nothing -> {model | state = (Model.Error Error.Programming)}
+      Nothing ->
+         (Model.invalidate
+            model
+            (Error.new
+               Error.Programming
+               "SelectTile: model moving char, no selection."
+            )
+         )
       (Just selection) ->
          case (Dict.get loc_ref selection.range_indicator) of
-            Nothing -> {model | state = Model.Default, selection = Nothing}
+            Nothing -> -- Clicked outside of the range indicator
+               (Model.reset model)
             (Just indicator) ->
                let
                   new_model =
@@ -69,12 +77,19 @@ go_to_tile model loc_ref =
                   then
                      (Update.EndTurn.apply_to new_model)
                   else
-                     {new_model | state = model.state}
+                     {new_model | state = Model.MovingCharacterWithClick}
 
 
 apply_to : Model.Type -> Battlemap.Location.Ref -> Model.Type
 apply_to model loc_ref =
-   case model.state of
+   case (Model.get_state model) of
       Model.MovingCharacterWithButtons -> (go_to_tile model loc_ref)
       Model.MovingCharacterWithClick -> (go_to_tile model loc_ref)
-      _ -> {model | state = (Model.Error Error.IllegalAction)}
+      _ ->
+         (Model.invalidate
+            model
+            (Error.new
+               Error.IllegalAction
+               "This can only be done while moving a character."
+            )
+         )
diff --git a/elm/battlemap/src/View/Status.elm b/elm/battlemap/src/View/Status.elm
index a7beb28..5fcc663 100644
--- a/elm/battlemap/src/View/Status.elm
+++ b/elm/battlemap/src/View/Status.elm
@@ -29,14 +29,17 @@ moving_character_text model =
 view : Model.Type -> (Html.Html Event.Type)
 view model =
    (Html.text
-      (case model.state of
-         Model.Default -> "Click on a character to control it."
-         Model.MovingCharacterWithButtons -> (moving_character_text model)
-         Model.MovingCharacterWithClick -> (moving_character_text model)
-         Model.FocusingTile -> "Error: Unimplemented."
-         (Model.Error Error.Programming) ->
-            "Error of programming, please report."
-         (Model.Error Error.IllegalAction) ->
-            "This cannot be done while in this state."
+      (
+         (case model.state of
+            Model.Default -> "Click on a character to control it."
+            Model.MovingCharacterWithButtons -> (moving_character_text model)
+            Model.MovingCharacterWithClick -> (moving_character_text model)
+            Model.FocusingTile -> "Error: Unimplemented."
+         )
+         ++ " " ++
+         (case model.error of
+            Nothing -> ""
+            (Just error) -> (Error.to_string error)
+         )
       )
    )