summaryrefslogtreecommitdiff
path: root/src/map-editor
diff options
context:
space:
mode:
Diffstat (limited to 'src/map-editor')
-rw-r--r--src/map-editor/src/Comm/Send.elm1
-rw-r--r--src/map-editor/src/Struct/Flags.elm42
-rw-r--r--src/map-editor/src/Struct/Model.elm8
-rw-r--r--src/map-editor/src/Struct/ServerReply.elm3
-rw-r--r--src/map-editor/src/Update/HandleServerReply.elm100
5 files changed, 72 insertions, 82 deletions
diff --git a/src/map-editor/src/Comm/Send.elm b/src/map-editor/src/Comm/Send.elm
index d70fc13..c61be07 100644
--- a/src/map-editor/src/Comm/Send.elm
+++ b/src/map-editor/src/Comm/Send.elm
@@ -30,6 +30,7 @@ internal_decoder reply_type =
"add_tile_pattern" -> (Comm.AddTilePattern.decode)
"set_map" -> (Comm.SetMap.decode)
"okay" -> (Comm.Okay.decode)
+ "disconnected" -> (Json.Decode.succeed Struct.ServerReply.Disconnected)
other ->
(Json.Decode.fail
(
diff --git a/src/map-editor/src/Struct/Flags.elm b/src/map-editor/src/Struct/Flags.elm
deleted file mode 100644
index c0316f0..0000000
--- a/src/map-editor/src/Struct/Flags.elm
+++ /dev/null
@@ -1,42 +0,0 @@
-module Struct.Flags exposing
- (
- Type,
- maybe_get_param
- )
-
--- Elm -------------------------------------------------------------------------
-import List
-
--- Battlemap -------------------------------------------------------------------
-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/map-editor/src/Struct/Model.elm b/src/map-editor/src/Struct/Model.elm
index 70b840f..a7ec964 100644
--- a/src/map-editor/src/Struct/Model.elm
+++ b/src/map-editor/src/Struct/Model.elm
@@ -12,9 +12,11 @@ module Struct.Model exposing
-- Elm -------------------------------------------------------------------------
import Dict
--- Map -------------------------------------------------------------------
-import Struct.Error
+-- Shared ----------------------------------------------------------------------
import Struct.Flags
+
+-- Map Editor ------------------------------------------------------------------
+import Struct.Error
import Struct.HelpRequest
import Struct.Map
import Struct.Tile
@@ -27,6 +29,7 @@ import Struct.UI
--------------------------------------------------------------------------------
type alias Type =
{
+ flags: Struct.Flags.Type,
toolbox: Struct.Toolbox.Type,
help_request: Struct.HelpRequest.Type,
map: Struct.Map.Type,
@@ -53,6 +56,7 @@ new flags =
maybe_map_id = (Struct.Flags.maybe_get_param "id" flags)
model =
{
+ flags = flags,
toolbox = (Struct.Toolbox.default),
help_request = Struct.HelpRequest.None,
map = (Struct.Map.empty),
diff --git a/src/map-editor/src/Struct/ServerReply.elm b/src/map-editor/src/Struct/ServerReply.elm
index 177950b..e3116fe 100644
--- a/src/map-editor/src/Struct/ServerReply.elm
+++ b/src/map-editor/src/Struct/ServerReply.elm
@@ -2,7 +2,7 @@ module Struct.ServerReply exposing (Type(..))
-- Elm -------------------------------------------------------------------------
--- Battlemap -------------------------------------------------------------------
+-- Map Editor ------------------------------------------------------------------
import Struct.Map
import Struct.Tile
import Struct.TilePattern
@@ -13,6 +13,7 @@ import Struct.TilePattern
type Type =
Okay
+ | Disconnected
| AddTile Struct.Tile.Type
| AddTilePattern Struct.TilePattern.Type
| SetMap Struct.Map.Type
diff --git a/src/map-editor/src/Update/HandleServerReply.elm b/src/map-editor/src/Update/HandleServerReply.elm
index 0e69c51..e982ef7 100644
--- a/src/map-editor/src/Update/HandleServerReply.elm
+++ b/src/map-editor/src/Update/HandleServerReply.elm
@@ -3,7 +3,13 @@ module Update.HandleServerReply exposing (apply_to)
-- Elm -------------------------------------------------------------------------
import Http
--- Map -------------------------------------------------------------------
+-- Shared ----------------------------------------------------------------------
+import Action.Ports
+
+import Struct.Flags
+
+-- Map Editor ------------------------------------------------------------------
+import Constants.IO
import Struct.Map
import Struct.Error
import Struct.Event
@@ -19,61 +25,75 @@ import Struct.TilePattern
--------------------------------------------------------------------------------
-- LOCAL -----------------------------------------------------------------------
--------------------------------------------------------------------------------
+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
+ (
+ "/map-editor/?"
+ ++ (Struct.Flags.get_params_as_url model.flags)
+ )
+ )
+ )
+ )
+ ]
+ )
+
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_tile_pattern : (
Struct.TilePattern.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_pattern tp current_state =
- case current_state of
- (_, (Just _)) -> current_state
- (model, _) ->
- (
- (Struct.Model.add_tile_pattern tp model),
- Nothing
- )
+ let (model, cmds) = current_state in
+ ((Struct.Model.add_tile_pattern tp 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)
refresh_map : (
- (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)))
)
refresh_map current_state =
- case current_state of
- (_, (Just _)) -> current_state
- (model, _) ->
- (
- {model | map = (Struct.Map.solve_tiles model.tiles model.map)},
- Nothing
- )
+ let (model, cmds) = current_state in
+ ({model | map = (Struct.Map.solve_tiles model.tiles model.map)}, 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.AddTile tl) ->
(add_tile tl current_state)
@@ -106,10 +126,16 @@ apply_to model query_result =
)
(Result.Ok commands) ->
- case (List.foldl (apply_command) (model, Nothing) commands) of
- (updated_model, Nothing) -> (updated_model, Cmd.none)
- (_, (Just error)) ->
+ let
+ (new_model, elm_commands) =
+ (List.foldl (apply_command) (model, [Cmd.none]) commands)
+ in
+ (
+ new_model,
(
- (Struct.Model.invalidate error model),
- Cmd.none
+ case elm_commands of
+ [] -> Cmd.none
+ [cmd] -> cmd
+ _ -> (Cmd.batch elm_commands)
)
+ )