summaryrefslogtreecommitdiff
path: root/src/battle
diff options
context:
space:
mode:
Diffstat (limited to 'src/battle')
-rw-r--r--src/battle/src/Comm/Send.elm5
-rw-r--r--src/battle/src/Struct/Flags.elm42
-rw-r--r--src/battle/src/Struct/Model.elm6
-rw-r--r--src/battle/src/Struct/ServerReply.elm3
-rw-r--r--src/battle/src/Update/HandleServerReply.elm216
5 files changed, 129 insertions, 143 deletions
diff --git a/src/battle/src/Comm/Send.elm b/src/battle/src/Comm/Send.elm
index 98e3ba4..f501b19 100644
--- a/src/battle/src/Comm/Send.elm
+++ b/src/battle/src/Comm/Send.elm
@@ -6,7 +6,7 @@ import Http
import Json.Decode
import Json.Encode
--- Map -------------------------------------------------------------------
+-- Battle ----------------------------------------------------------------------
import Comm.AddArmor
import Comm.AddChar
import Comm.AddTile
@@ -36,6 +36,9 @@ internal_decoder reply_type =
"set_map" -> (Comm.SetMap.decode)
"turn_results" -> (Comm.TurnResults.decode)
"set_timeline" -> (Comm.SetTimeline.decode)
+ "disconnected" -> (Json.Decode.succeed Struct.ServerReply.Disconnected)
+ "okay" -> (Json.Decode.succeed Struct.ServerReply.Okay)
+
other ->
(Json.Decode.fail
(
diff --git a/src/battle/src/Struct/Flags.elm b/src/battle/src/Struct/Flags.elm
deleted file mode 100644
index 228d258..0000000
--- a/src/battle/src/Struct/Flags.elm
+++ /dev/null
@@ -1,42 +0,0 @@
-module Struct.Flags exposing
- (
- Type,
- maybe_get_param
- )
-
--- Elm -------------------------------------------------------------------------
-import List
-
--- Map -------------------------------------------------------------------
-import Util.List
-
---------------------------------------------------------------------------------
--- TYPES -----------------------------------------------------------------------
---------------------------------------------------------------------------------
-type alias Type =
- {
- user_id : String,
- token : String,
- url_params : (List (List String))
- }
-
---------------------------------------------------------------------------------
--- LOCAL -----------------------------------------------------------------------
---------------------------------------------------------------------------------
-
---------------------------------------------------------------------------------
--- EXPORTED --------------------------------------------------------------------
---------------------------------------------------------------------------------
-maybe_get_param : String -> Type -> (Maybe String)
-maybe_get_param param flags =
- case
- (Util.List.get_first
- (\e -> ((List.head e) == (Just param)))
- flags.url_params
- )
- of
- Nothing -> Nothing
- (Just a) ->
- case (List.tail a) of
- Nothing -> Nothing
- (Just b) -> (List.head b)
diff --git a/src/battle/src/Struct/Model.elm b/src/battle/src/Struct/Model.elm
index c32db67..8722066 100644
--- a/src/battle/src/Struct/Model.elm
+++ b/src/battle/src/Struct/Model.elm
@@ -23,12 +23,14 @@ import Array
import Dict
+-- Shared ----------------------------------------------------------------------
+import Struct.Flags
+
-- Battle ----------------------------------------------------------------------
import Struct.Armor
import Struct.Character
import Struct.CharacterTurn
import Struct.Error
-import Struct.Flags
import Struct.HelpRequest
import Struct.Location
import Struct.Map
@@ -46,6 +48,7 @@ import Util.Array
--------------------------------------------------------------------------------
type alias Type =
{
+ flags: Struct.Flags.Type,
help_request: Struct.HelpRequest.Type,
animator: (Maybe Struct.TurnResultAnimator.Type),
map: Struct.Map.Type,
@@ -80,6 +83,7 @@ new flags =
maybe_battle_id = (Struct.Flags.maybe_get_param "id" flags)
model =
{
+ flags = flags,
help_request = Struct.HelpRequest.None,
animator = Nothing,
map = (Struct.Map.empty),
diff --git a/src/battle/src/Struct/ServerReply.elm b/src/battle/src/Struct/ServerReply.elm
index 87325a5..28dde0d 100644
--- a/src/battle/src/Struct/ServerReply.elm
+++ b/src/battle/src/Struct/ServerReply.elm
@@ -2,7 +2,7 @@ module Struct.ServerReply exposing (Type(..))
-- Elm -------------------------------------------------------------------------
--- Map -------------------------------------------------------------------
+-- Battle ----------------------------------------------------------------------
import Struct.Armor
import Struct.Map
import Struct.Character
@@ -16,6 +16,7 @@ import Struct.Weapon
type Type =
Okay
+ | Disconnected
| AddArmor Struct.Armor.Type
| AddWeapon Struct.Weapon.Type
| AddCharacter (Struct.Character.Type, Int, Int, Int)
diff --git a/src/battle/src/Update/HandleServerReply.elm b/src/battle/src/Update/HandleServerReply.elm
index 85e7a39..b1506ba 100644
--- a/src/battle/src/Update/HandleServerReply.elm
+++ b/src/battle/src/Update/HandleServerReply.elm
@@ -11,7 +11,14 @@ import Http
import Time
--- Map -------------------------------------------------------------------
+-- Shared ----------------------------------------------------------------------
+import Action.Ports
+
+import Struct.Flags
+
+-- Battle ----------------------------------------------------------------------
+import Constants.IO
+
import Struct.Armor
import Struct.Map
import Struct.Character
@@ -46,135 +53,151 @@ armor_getter model ref =
-----------
+disconnected : (
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
+ )
+disconnected current_state =
+ let (model, cmds) = current_state in
+ (
+ model,
+ [
+ (Action.Ports.go_to
+ (
+ Constants.IO.base_url
+ ++ "/login/?action=disconnect&goto="
+ ++
+ (Http.encodeUri
+ (
+ "/battle/?"
+ ++ (Struct.Flags.get_params_as_url model.flags)
+ )
+ )
+ )
+ )
+ ]
+ )
+
add_armor : (
Struct.Armor.Type ->
- (Struct.Model.Type, (Maybe Struct.Error.Type)) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type))
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
)
add_armor ar current_state =
- case current_state of
- (_, (Just _)) -> current_state
- (model, _) -> ((Struct.Model.add_armor ar model), Nothing)
+ let (model, cmds) = current_state in
+ ((Struct.Model.add_armor ar model), cmds)
add_tile : (
Struct.Tile.Type ->
- (Struct.Model.Type, (Maybe Struct.Error.Type)) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type))
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
)
add_tile tl current_state =
- case current_state of
- (_, (Just _)) -> current_state
- (model, _) -> ((Struct.Model.add_tile tl model), Nothing)
+ let (model, cmds) = current_state in
+ ((Struct.Model.add_tile tl model), cmds)
add_weapon : (
Struct.Weapon.Type ->
- (Struct.Model.Type, (Maybe Struct.Error.Type)) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type))
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
)
add_weapon wp current_state =
- case current_state of
- (_, (Just _)) -> current_state
- (model, _) -> ((Struct.Model.add_weapon wp model), Nothing)
+ let (model, cmds) = current_state in
+ ((Struct.Model.add_weapon wp model), cmds)
add_character : (
(Struct.Character.Type, Int, Int, Int) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type)) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type))
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
)
add_character char_and_refs current_state =
- case current_state of
- (_, (Just _)) -> current_state
- (model, _) ->
- let
- (char, awp_ref, swp_ref, ar_ref) = char_and_refs
- awp = (weapon_getter model awp_ref)
- swp = (weapon_getter model swp_ref)
- ar = (armor_getter model ar_ref)
- in
- (
- (Struct.Model.add_character
- (Struct.Character.fill_missing_equipment_and_omnimods
- (Struct.Model.tile_omnimods_fun model)
- awp
- swp
- ar
- char
- )
- model
- ),
- Nothing
+ let
+ (model, cmds) = current_state
+ (char, awp_ref, swp_ref, ar_ref) = char_and_refs
+ awp = (weapon_getter model awp_ref)
+ swp = (weapon_getter model swp_ref)
+ ar = (armor_getter model ar_ref)
+ in
+ (
+ (Struct.Model.add_character
+ (Struct.Character.fill_missing_equipment_and_omnimods
+ (Struct.Model.tile_omnimods_fun model)
+ awp
+ swp
+ ar
+ char
)
+ model
+ ),
+ cmds
+ )
set_map : (
Struct.Map.Type ->
- (Struct.Model.Type, (Maybe Struct.Error.Type)) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type))
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
)
set_map map current_state =
- case current_state of
- (_, (Just _)) -> current_state
- (model, _) ->
- (
- {model |
- map =
- (Struct.Map.solve_tiles model.tiles map)
- },
- Nothing
- )
+ let (model, cmds) = current_state in
+ (
+ {model |
+ map = (Struct.Map.solve_tiles model.tiles map)
+ },
+ cmds
+ )
add_to_timeline : (
(List Struct.TurnResult.Type) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type)) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type))
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
)
add_to_timeline turn_results current_state =
- case current_state of
- (_, (Just _)) -> current_state
-
- (model, _) ->
+ let (model, cmds) = current_state in
+ (
+ {model |
+ animator =
+ (Struct.TurnResultAnimator.maybe_new
+ (List.reverse turn_results)
+ False
+ ),
+ timeline =
+ (Array.append
+ (Array.fromList turn_results)
+ model.timeline
+ ),
+ ui =
+ (Struct.UI.set_displayed_tab
+ Struct.UI.TimelineTab
+ model.ui
+ )
+ },
(
- {model |
- animator =
- (Struct.TurnResultAnimator.maybe_new
- (List.reverse turn_results)
- False
- ),
- timeline =
- (Array.append
- (Array.fromList turn_results)
- model.timeline
- ),
- ui =
- (Struct.UI.set_displayed_tab
- Struct.UI.TimelineTab
- model.ui
- )
- },
- Nothing
+ (Delay.after 1 Time.millisecond Struct.Event.AnimationEnded)
+ :: cmds
)
+ )
set_timeline : (
(List Struct.TurnResult.Type) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type)) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type))
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
)
set_timeline turn_results current_state =
- case current_state of
- (_, (Just _)) -> current_state
-
- (model, _) ->
- (
- {model | timeline = (Array.fromList turn_results)},
- Nothing
- )
+ let (model, cmds) = current_state in
+ (
+ {model | timeline = (Array.fromList turn_results)},
+ cmds
+ )
apply_command : (
Struct.ServerReply.Type ->
- (Struct.Model.Type, (Maybe Struct.Error.Type)) ->
- (Struct.Model.Type, (Maybe Struct.Error.Type))
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+ (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
)
apply_command command current_state =
case command of
+ Struct.ServerReply.Disconnected -> (disconnected current_state)
+
(Struct.ServerReply.AddWeapon wp) ->
(add_weapon wp current_state)
@@ -219,18 +242,15 @@ apply_to model query_result =
(Result.Ok commands) ->
let
- new_model =
- (
- case (List.foldl (apply_command) (model, Nothing) commands) of
- (updated_model, Nothing) -> updated_model
- (_, (Just error)) -> (Struct.Model.invalidate error model)
- )
+ (new_model, elm_commands) =
+ (List.foldl (apply_command) (model, [Cmd.none]) commands)
in
(
new_model,
- if (new_model.animator == Nothing)
- then
- Cmd.none
- else
- (Delay.after 1 Time.millisecond Struct.Event.AnimationEnded)
+ (
+ case elm_commands of
+ [] -> Cmd.none
+ [cmd] -> cmd
+ _ -> (Cmd.batch elm_commands)
+ )
)