summaryrefslogtreecommitdiff
path: root/src/battlemap
diff options
context:
space:
mode:
Diffstat (limited to 'src/battlemap')
-rw-r--r--src/battlemap/src/Send/AddChar.elm84
-rw-r--r--src/battlemap/src/Send/Send.elm10
-rw-r--r--src/battlemap/src/Send/SetMap.elm51
-rw-r--r--src/battlemap/src/Struct/Event.elm5
-rw-r--r--src/battlemap/src/Update/HandleServerReply.elm40
5 files changed, 111 insertions, 79 deletions
diff --git a/src/battlemap/src/Send/AddChar.elm b/src/battlemap/src/Send/AddChar.elm
index 762d859..66a837f 100644
--- a/src/battlemap/src/Send/AddChar.elm
+++ b/src/battlemap/src/Send/AddChar.elm
@@ -11,7 +11,6 @@ import Data.Weapons
import Struct.Attributes
import Struct.Character
-import Struct.Error
import Struct.Model
import Struct.ServerReply
import Struct.WeaponSet
@@ -90,50 +89,47 @@ char_decoder =
|> (Json.Decode.Pipeline.required "swp" Json.Decode.int)
)
---------------------------------------------------------------------------------
--- EXPORTED --------------------------------------------------------------------
---------------------------------------------------------------------------------
-decode : (Struct.Model.Struct -> (Json.Decode.Decoder Struct.ServerReply.Type))
-decode model input =
- case (Json.Decode.decodeString char_decoder input) of
- (Result.Ok char_data) ->
- (Result.Ok
- (Struct.ServerReply.AddCharacter
- (Struct.Character.new
- (toString char_data.ix)
- char_data.nam
- char_data.ico
- char_data.prt
- {x = char_data.lc.x, y = char_data.lc.y}
- char_data.hea
- char_data.pla
- char_data.ena
- (Struct.Attributes.new
- char_data.att.con
- char_data.att.dex
- char_data.att.int
- char_data.att.min
- char_data.att.spe
- char_data.att.str
- )
- (
- case
- (
- (Dict.get char_data.awp model.weapons),
- (Dict.get char_data.swp model.weapons)
- )
- of
- ((Just wp_0), (Just wp_1)) ->
- (Struct.WeaponSet.new wp_0 wp_1)
+internal_decoder : Struct.Model.Type -> CharData -> Struct.ServerReply.Type
+internal_decoder model char_data =
+ (Struct.ServerReply.AddCharacter
+ (Struct.Character.new
+ (toString char_data.ix)
+ char_data.nam
+ char_data.ico
+ char_data.prt
+ {x = char_data.lc.x, y = char_data.lc.y}
+ char_data.hea
+ char_data.pla
+ char_data.ena
+ (Struct.Attributes.new
+ char_data.att.con
+ char_data.att.dex
+ char_data.att.int
+ char_data.att.min
+ char_data.att.spe
+ char_data.att.str
+ )
+ (
+ case
+ (
+ (Dict.get char_data.awp model.weapons),
+ (Dict.get char_data.swp model.weapons)
+ )
+ of
+ ((Just wp_0), (Just wp_1)) ->
+ (Struct.WeaponSet.new wp_0 wp_1)
- _ ->
- (Struct.WeaponSet.new
- (Data.Weapons.none)
- (Data.Weapons.none)
- )
+ _ ->
+ (Struct.WeaponSet.new
+ (Data.Weapons.none)
+ (Data.Weapons.none)
)
- )
- )
)
+ )
+ )
- other -> other
+--------------------------------------------------------------------------------
+-- EXPORTED --------------------------------------------------------------------
+--------------------------------------------------------------------------------
+decode : (Struct.Model.Type -> (Json.Decode.Decoder Struct.ServerReply.Type))
+decode model = (Json.Decode.map (internal_decoder model) char_decoder)
diff --git a/src/battlemap/src/Send/Send.elm b/src/battlemap/src/Send/Send.elm
index cd3d68e..da26864 100644
--- a/src/battlemap/src/Send/Send.elm
+++ b/src/battlemap/src/Send/Send.elm
@@ -30,6 +30,14 @@ internal_decoder model reply_type =
case reply_type of
"add_char" -> (Send.AddChar.decode model)
"set_map" -> (Send.SetMap.decode model)
+ other ->
+ (Json.Decode.fail
+ (
+ "Unknown server command \""
+ ++ other
+ ++ "\""
+ )
+ )
decode : Struct.Model.Type -> (Json.Decode.Decoder Struct.ServerReply.Type)
decode model =
@@ -54,7 +62,7 @@ try_sending model recipient try_encoding_fun =
(Http.post
recipient
(Http.jsonBody serial)
- (decode model)
+ (Json.Decode.list (decode model))
)
)
)
diff --git a/src/battlemap/src/Send/SetMap.elm b/src/battlemap/src/Send/SetMap.elm
index 132216c..f09e6bf 100644
--- a/src/battlemap/src/Send/SetMap.elm
+++ b/src/battlemap/src/Send/SetMap.elm
@@ -1,7 +1,6 @@
module Send.SetMap exposing (decode)
-- Elm -------------------------------------------------------------------------
-import Dict
import Json.Decode
-- Battlemap -------------------------------------------------------------------
@@ -34,36 +33,32 @@ deserialize_tile map_width index id =
(Data.Tiles.get_cost id)
)
+internal_decoder : MapData -> Struct.ServerReply.Type
+internal_decoder map_data =
+ (Struct.ServerReply.SetMap
+ (Struct.Battlemap.new
+ map_data.w
+ map_data.h
+ (List.indexedMap
+ (deserialize_tile map_data.w)
+ map_data.t
+ )
+ )
+ )
+
--------------------------------------------------------------------------------
-- EXPORTED --------------------------------------------------------------------
--------------------------------------------------------------------------------
decode : (Struct.Model.Type -> (Json.Decode.Decoder Struct.ServerReply.Type))
-decode model input =
- case
- (Json.Decode.decodeString
- (Json.Decode.map3 MapData
- (Json.Decode.field "w" Json.Decode.int)
- (Json.Decode.field "h" Json.Decode.int)
- (Json.Decode.field
- "t"
- (Json.Decode.list Json.Decode.int)
- )
+decode model =
+ (Json.Decode.map
+ internal_decoder
+ (Json.Decode.map3 MapData
+ (Json.Decode.field "w" Json.Decode.int)
+ (Json.Decode.field "h" Json.Decode.int)
+ (Json.Decode.field
+ "t"
+ (Json.Decode.list Json.Decode.int)
)
- input
)
- of
- (Result.Ok map_data) ->
- (Result.Ok
- (Struct.ServerReply.SetMap
- (Struct.Battlemap.new
- map_data.w
- map_data.h
- (List.indexedMap
- (deserialize_tile map_data.w)
- map_data.t
- )
- )
- )
- )
-
- error -> error
+ )
diff --git a/src/battlemap/src/Struct/Event.elm b/src/battlemap/src/Struct/Event.elm
index 6231761..ecda85b 100644
--- a/src/battlemap/src/Struct/Event.elm
+++ b/src/battlemap/src/Struct/Event.elm
@@ -4,9 +4,10 @@ module Struct.Event exposing (Type(..))
import Http
-- Battlemap -------------------------------------------------------------------
+import Struct.Character
import Struct.Direction
import Struct.Location
-import Struct.Character
+import Struct.ServerReply
import Struct.UI
--------------------------------------------------------------------------------
@@ -20,7 +21,7 @@ type Type =
| TurnEnded
| ScaleChangeRequested Float
| TabSelected Struct.UI.Tab
- | ServerReplied (Result Http.Error (List (List String)))
+ | ServerReplied (Result Http.Error (List Struct.ServerReply.Type))
| DebugTeamSwitchRequest
| DebugLoadBattlemapRequest
| WeaponSwitchRequest
diff --git a/src/battlemap/src/Update/HandleServerReply.elm b/src/battlemap/src/Update/HandleServerReply.elm
index da5d95d..9b7cd36 100644
--- a/src/battlemap/src/Update/HandleServerReply.elm
+++ b/src/battlemap/src/Update/HandleServerReply.elm
@@ -6,6 +6,7 @@ import Http
-- Battlemap -------------------------------------------------------------------
import Struct.Error
import Struct.Event
+import Struct.ServerReply
import Struct.Model
--------------------------------------------------------------------------------
@@ -15,13 +16,43 @@ import Struct.Model
--------------------------------------------------------------------------------
-- LOCAL -----------------------------------------------------------------------
--------------------------------------------------------------------------------
+apply_command : (
+ Struct.ServerReply.Type ->
+ (Struct.Model.Type, (Maybe Struct.Error.Type)) ->
+ (Struct.Model.Type, (Maybe Struct.Error.Type))
+ )
+apply_command command current_state =
+ case (command, current_state) of
+ (_, (_, (Just error))) -> current_state
+
+ (
+ (Struct.ServerReply.AddCharacter char),
+ (model, _)
+ ) ->
+ current_state
+ (
+ (Struct.ServerReply.SetMap map),
+ (model, _)
+ ) ->
+ current_state
+
+ (_, (model, _)) ->
+ (
+ model,
+ (Just
+ (Struct.Error.new
+ Struct.Error.Unimplemented
+ "Unimplemented server command received"
+ )
+ )
+ )
--------------------------------------------------------------------------------
-- EXPORTED --------------------------------------------------------------------
--------------------------------------------------------------------------------
apply_to : (
Struct.Model.Type ->
- (Result Http.Error (List (List String))) ->
+ (Result Http.Error (List Struct.ServerReply.Type)) ->
(Struct.Model.Type, (Cmd Struct.Event.Type))
)
apply_to model query_result =
@@ -37,9 +68,10 @@ apply_to model query_result =
(Result.Ok commands) ->
(
- (Struct.Model.invalidate
- model
- (Struct.Error.new Struct.Error.Unimplemented "Network Comm.")
+ (
+ case (List.foldl (apply_command) (model, Nothing) commands) of
+ (updated_model, Nothing) -> updated_model
+ (_, (Just error)) -> (Struct.Model.invalidate model error)
),
Cmd.none
)