Adds support for the "add_char" server reply.

6 files changed, 140 insertions, 3 deletions

diff --git a/src/battlemap/elm-package.json b/src/battlemap/elm-package.json
index 186986e..82d19f0 100644
--- a/src/battlemap/elm-package.json
+++ b/src/battlemap/elm-package.json
@@ -8,6 +8,7 @@
     ],
     "exposed-modules": [],
     "dependencies": {
+        "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0",
         "elm-lang/core": "5.1.1 <= v < 6.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/Character.elm b/src/battlemap/src/Character.elm
index 3c72c0c..0099b0e 100644
--- a/src/battlemap/src/Character.elm
+++ b/src/battlemap/src/Character.elm
@@ -2,6 +2,7 @@ module Character exposing
    (
       Type,
       Ref,
+      new,
       get_ref,
       get_team,
       get_icon_id,
@@ -12,8 +13,12 @@ module Character exposing
       get_attack_range
    )
 
+-- Battlemap -------------------------------------------------------------------
 import Battlemap.Location
 
+--------------------------------------------------------------------------------
+-- TYPES -----------------------------------------------------------------------
+--------------------------------------------------------------------------------
 type alias Type =
    {
       id : String,
@@ -28,6 +33,36 @@ type alias Type =
 
 type alias Ref = String
 
+--------------------------------------------------------------------------------
+-- LOCAL -----------------------------------------------------------------------
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+-- EXPORTED --------------------------------------------------------------------
+--------------------------------------------------------------------------------
+new : (
+      String -> -- id
+      String -> -- name
+      String -> -- icon
+      String -> -- portrait
+      Battlemap.Location.Type -> -- location
+      Int -> -- team
+      Int -> -- movement_points
+      Int -> -- atk_dist
+      Type
+   )
+new id name icon portrait location team movement_points atk_dist =
+   {
+      id = id,
+      name = name,
+      icon = icon,
+      portrait = portrait,
+      location = location,
+      team = team,
+      movement_points = movement_points,
+      atk_dist = atk_dist
+   }
+
 get_ref : Type -> Ref
 get_ref c = c.id
 
diff --git a/src/battlemap/src/Model.elm b/src/battlemap/src/Model.elm
index 082737f..0e93e2b 100644
--- a/src/battlemap/src/Model.elm
+++ b/src/battlemap/src/Model.elm
@@ -2,6 +2,7 @@ module Model exposing
    (
       Type,
       State(..),
+      add_character,
       get_state,
       invalidate,
       reset,
@@ -47,6 +48,17 @@ type alias Type =
 --------------------------------------------------------------------------------
 -- EXPORTED --------------------------------------------------------------------
 --------------------------------------------------------------------------------
+add_character : Type -> Character.Type -> Type
+add_character model char =
+   {model |
+      characters =
+         (Dict.insert
+            (Character.get_ref char)
+            char
+            model.characters
+         )
+   }
+
 get_state : Type -> State
 get_state model = model.state
 
diff --git a/src/battlemap/src/Model/HandleServerReply.elm b/src/battlemap/src/Model/HandleServerReply.elm
index 22b222b..6a3779d 100644
--- a/src/battlemap/src/Model/HandleServerReply.elm
+++ b/src/battlemap/src/Model/HandleServerReply.elm
@@ -9,6 +9,7 @@ import Error
 import Event
 
 import Model.HandleServerReply.SetMap
+import Model.HandleServerReply.AddChar
 
 --------------------------------------------------------------------------------
 -- LOCAL -----------------------------------------------------------------------
@@ -21,7 +22,8 @@ apply_command cmd model =
       ["set_map", data] ->
          (Model.HandleServerReply.SetMap.apply_to model data)
 
-      ["add_char", data] -> model
+      ["add_char", data] ->
+         (Model.HandleServerReply.AddChar.apply_to model data)
 
       _ ->
          (Model.invalidate
@@ -44,4 +46,4 @@ apply_to : (
       (Model.Type, (Cmd Event.Type))
    )
 apply_to model serialized_commands =
-   ((List.foldr (apply_command) model serialized_commands), Cmd.none)
+   ((List.foldl (apply_command) model serialized_commands), Cmd.none)
diff --git a/src/battlemap/src/Model/HandleServerReply/AddChar.elm b/src/battlemap/src/Model/HandleServerReply/AddChar.elm
new file mode 100644
index 0000000..0324faa
--- /dev/null
+++ b/src/battlemap/src/Model/HandleServerReply/AddChar.elm
@@ -0,0 +1,86 @@
+module Model.HandleServerReply.AddChar exposing (apply_to)
+
+-- Elm -------------------------------------------------------------------------
+import Array
+
+import Json.Decode
+import Json.Decode.Pipeline
+
+-- Battlemap -------------------------------------------------------------------
+import Battlemap
+import Battlemap.Location
+
+import Character
+
+import Error
+
+import Model
+
+--------------------------------------------------------------------------------
+-- TYPES -----------------------------------------------------------------------
+--------------------------------------------------------------------------------
+type alias CharData =
+   {
+      id : String,
+      name : String,
+      icon : String,
+      portrait : String,
+      loc_x : Int,
+      loc_y : Int,
+      team : Int,
+      mov_pts : Int,
+      atk_rg : Int
+   }
+
+--------------------------------------------------------------------------------
+-- LOCAL -----------------------------------------------------------------------
+--------------------------------------------------------------------------------
+char_decoder : (Json.Decode.Decoder CharData)
+char_decoder =
+   (Json.Decode.Pipeline.decode
+      CharData
+      |> (Json.Decode.Pipeline.required "id" Json.Decode.string)
+      |> (Json.Decode.Pipeline.required "name" Json.Decode.string)
+      |> (Json.Decode.Pipeline.required "icon" Json.Decode.string)
+      |> (Json.Decode.Pipeline.required "portrait" Json.Decode.string)
+      |> (Json.Decode.Pipeline.required "loc_x" Json.Decode.int)
+      |> (Json.Decode.Pipeline.required "loc_y" Json.Decode.int)
+      |> (Json.Decode.Pipeline.required "team" Json.Decode.int)
+      |> (Json.Decode.Pipeline.required "mov_pts" Json.Decode.int)
+      |> (Json.Decode.Pipeline.required "atk_rg" Json.Decode.int)
+   )
+
+--------------------------------------------------------------------------------
+-- EXPORTED --------------------------------------------------------------------
+--------------------------------------------------------------------------------
+apply_to : Model.Type -> String -> Model.Type
+apply_to model serialized_char =
+   case
+      (Json.Decode.decodeString
+         char_decoder
+         serialized_char
+      )
+   of
+      (Result.Ok char_data) ->
+         (Model.add_character
+            model
+            (Character.new
+               char_data.id
+               char_data.name
+               char_data.icon
+               char_data.portrait
+               {x = char_data.loc_x, y = char_data.loc_y}
+               char_data.team
+               char_data.mov_pts
+               char_data.atk_rg
+            )
+         )
+
+      (Result.Err msg) ->
+         (Model.invalidate
+            model
+            (Error.new
+               Error.Programming
+               ("Could not deserialize character: " ++ msg)
+            )
+         )
diff --git a/src/battlemap/src/Model/HandleServerReply/SetMap.elm b/src/battlemap/src/Model/HandleServerReply/SetMap.elm
index ab21075..f07e9d7 100644
--- a/src/battlemap/src/Model/HandleServerReply/SetMap.elm
+++ b/src/battlemap/src/Model/HandleServerReply/SetMap.elm
@@ -2,6 +2,7 @@ module Model.HandleServerReply.SetMap exposing (apply_to)
 
 -- Elm -------------------------------------------------------------------------
 import Array
+import Dict
 import Json.Decode
 
 -- Battlemap -------------------------------------------------------------------
@@ -73,7 +74,7 @@ apply_to model serialized_map =
                      )
                   )
             }
-            model.characters
+            (Dict.empty)
          )
 
       _ -> model