From 98c9c4f227af30cad5eb28b16d4c62c0c328ccbe Mon Sep 17 00:00:00 2001 From: nsensfel Date: Thu, 2 Nov 2017 13:10:37 +0100 Subject: Prepares the sending of a character's turn. --- src/battlemap/elm-package.json | 3 +- src/battlemap/src/Battlemap/Navigator.elm | 1 + src/battlemap/src/Error.elm | 2 + src/battlemap/src/Event.elm | 3 + src/battlemap/src/Send.elm | 7 ++ src/battlemap/src/Send/CharacterActions.elm | 95 ------------------------- src/battlemap/src/Send/CharacterTurn.elm | 106 ++++++++++++++++++++++++++++ src/battlemap/src/Shim/Model.elm | 105 ++++++++++++++------------- src/battlemap/src/Update.elm | 22 +++++- 9 files changed, 194 insertions(+), 150 deletions(-) create mode 100644 src/battlemap/src/Send.elm delete mode 100644 src/battlemap/src/Send/CharacterActions.elm create mode 100644 src/battlemap/src/Send/CharacterTurn.elm diff --git a/src/battlemap/elm-package.json b/src/battlemap/elm-package.json index 7c1672e..186986e 100644 --- a/src/battlemap/elm-package.json +++ b/src/battlemap/elm-package.json @@ -9,7 +9,8 @@ "exposed-modules": [], "dependencies": { "elm-lang/core": "5.1.1 <= v < 6.0.0", - "elm-lang/html": "2.0.0 <= v < 3.0.0" + "elm-lang/html": "2.0.0 <= v < 3.0.0", + "elm-lang/http": "1.0.0 <= v < 2.0.0" }, "elm-version": "0.18.0 <= v < 0.19.0" } diff --git a/src/battlemap/src/Battlemap/Navigator.elm b/src/battlemap/src/Battlemap/Navigator.elm index 852eb2c..2fb2213 100644 --- a/src/battlemap/src/Battlemap/Navigator.elm +++ b/src/battlemap/src/Battlemap/Navigator.elm @@ -7,6 +7,7 @@ module Battlemap.Navigator exposing get_starting_location, get_remaining_points, get_range_markers, + get_path, get_summary, clear_path, try_adding_step, diff --git a/src/battlemap/src/Error.elm b/src/battlemap/src/Error.elm index 581bb24..9f20eec 100644 --- a/src/battlemap/src/Error.elm +++ b/src/battlemap/src/Error.elm @@ -3,6 +3,7 @@ module Error exposing (Type, Mode(..), new, to_string) type Mode = IllegalAction | Programming + | Unimplemented type alias Type = { @@ -23,6 +24,7 @@ to_string e = (case e.mode of IllegalAction -> "Request discarded: " Programming -> "Error in the program (please report): " + Unimplemented -> "Update discarded due to unimplemented feature: " ) ++ e.message ) diff --git a/src/battlemap/src/Event.elm b/src/battlemap/src/Event.elm index 6b48d68..efa80c7 100644 --- a/src/battlemap/src/Event.elm +++ b/src/battlemap/src/Event.elm @@ -1,5 +1,7 @@ module Event exposing (Type(..)) +import Http + import Battlemap.Direction import Battlemap.Location @@ -14,4 +16,5 @@ type Type = | TurnEnded | ScaleChangeRequested Float | TabSelected UI.Tab + | ServerReplied (Result Http.Error String) | DebugTeamSwitchRequest diff --git a/src/battlemap/src/Send.elm b/src/battlemap/src/Send.elm new file mode 100644 index 0000000..9aafda0 --- /dev/null +++ b/src/battlemap/src/Send.elm @@ -0,0 +1,7 @@ +module Send exposing (Reply) + +type alias Reply = String +-- { +-- types : (List String), +-- data : (List String) +-- } diff --git a/src/battlemap/src/Send/CharacterActions.elm b/src/battlemap/src/Send/CharacterActions.elm deleted file mode 100644 index e7aee41..0000000 --- a/src/battlemap/src/Send/CharacterActions.elm +++ /dev/null @@ -1,95 +0,0 @@ -module IO.CharacterTurn exposing (send) - --- Elm ------------------------------------------------------------------------- -import Http - -import Json.Encode -import Json.Decode - --- Battlemap ------------------------------------------------------------------- -import Constants.IO - -import Event - --------------------------------------------------------------------------------- --- TYPES ------------------------------------------------------------------------ --------------------------------------------------------------------------------- -type alias Reply = - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -try_encoding : Model -> (Maybe String) -try_encoding model = - case (Model.get_state model) of - (Model.ControllingCharacter char_ref) -> - (Just - (Json.Encode.encode - 0 - (Json.Encode.object - [ - ("user_token", Json.Encode.string model.user_token), - ("char_id", Json.Encode.string char_ref), - ( - "path", - (Json.Encode.list - (List.map - ( - (Json.Encode.string) - << - (Battlemap.Direction.to_string) - ) - (Battlemap.get_navigator_path model.battlemap) - ) - ) - ), - ( - "target_id", - (Json.Encode.string - (case (UI.get_previous_action model.ui) of - (Just (UI.AttackedCharacter id)) -> id - _ -> "" - ) - ) - ) - ] - ) - ) - ) - - _ -> - Nothing - -decode : (Json.Decode.Decoder a) -decode = --- Reply: --- { --- TYPES: (list Instr-Type), --- DATA: (list Instr-Data) --- } --- --- Instr-Type : display-message, move-char, etc... --- Instr-Data : {category: int, content: string}, {char_id: string, x: int, y: int} - -receive : (Http.Result (Http.Error a)) -> Event -receive reply = - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -try_sending : Model -> (Maybe (Http.Request String)) -try_sending model = - case (try_encoding model) of - (Just serial) -> - (Just - (Http.send - (receive) - (Http.post - Constants.IO.battlemap_handler_url - (Http.jsonBody serial) - (decode) - ) - ) - ) - - Nothing -> Nothing diff --git a/src/battlemap/src/Send/CharacterTurn.elm b/src/battlemap/src/Send/CharacterTurn.elm new file mode 100644 index 0000000..daadf4b --- /dev/null +++ b/src/battlemap/src/Send/CharacterTurn.elm @@ -0,0 +1,106 @@ +module Send.CharacterTurn exposing (try_sending) + +-- Elm ------------------------------------------------------------------------- +import Http + +import Json.Encode +import Json.Decode + +-- Battlemap ------------------------------------------------------------------- +import Constants.IO + +import Battlemap +import Battlemap.Direction + +import UI + +import Model + +import Send + +import Event + +-------------------------------------------------------------------------------- +-- TYPES ------------------------------------------------------------------------ +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try_encoding : Model.Type -> (Maybe Json.Encode.Value) +try_encoding model = + case (Model.get_state model) of + (Model.ControllingCharacter char_ref) -> + (Just +-- (Json.Encode.encode +-- 0 + (Json.Encode.object + [ + -- ("user_token", Json.Encode.string model.user_token), + ("user_token", Json.Encode.string "user0"), + ("char_id", Json.Encode.string char_ref), + ( + "path", + (Json.Encode.list + (List.map + ( + (Json.Encode.string) + << + (Battlemap.Direction.to_string) + ) + (Battlemap.get_navigator_path model.battlemap) + ) + ) + ), + ( + "target_id", + (Json.Encode.string + (case (UI.get_previous_action model.ui) of + (Just (UI.AttackedCharacter id)) -> id + _ -> "" + ) + ) + ) + ] + ) +-- ) + ) + + _ -> + Nothing + +decode : (Json.Decode.Decoder String) --Send.Reply) +decode = + (Json.Decode.string ---Send.Reply +-- |> Json.Decode.required "types" (Json.Decode.list (Json.Decode.string)) +-- |> Json.Decode.required "data" (Json.Decode.list (Json.Decode.string)) + ) + +-- Reply: +-- { +-- TYPES: (list Instr-Type), +-- DATA: (list Instr-Data) +-- } +-- +-- Instr-Type : display-message, move-char, etc... +-- Instr-Data : {category: int, content: string}, {char_id: string, x: int, y: int} + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try_sending : Model.Type -> (Maybe (Cmd Event.Type)) +try_sending model = + case (try_encoding model) of + (Just serial) -> + (Just + (Http.send + Event.ServerReplied + (Http.post + Constants.IO.battlemap_handler_url + (Http.jsonBody serial) + (decode) + ) + ) + ) + + Nothing -> Nothing diff --git a/src/battlemap/src/Shim/Model.elm b/src/battlemap/src/Shim/Model.elm index a41e81f..6f03517 100644 --- a/src/battlemap/src/Shim/Model.elm +++ b/src/battlemap/src/Shim/Model.elm @@ -1,13 +1,42 @@ module Shim.Model exposing (generate) + import Dict +import Character + import UI import Model import Shim.Battlemap +new_char : ( + String -> + Int -> + Int -> + Int -> + Int -> + Int -> + (Dict.Dict Character.Ref Character.Type) -> + (Dict.Dict Character.Ref Character.Type) + ) +new_char id team x y mp ad storage = + (Dict.insert + id + { + id = id, + name = ("Char" ++ id), + icon = id, + team = team, + portrait = id, + location = {x = x, y = y}, + movement_points = mp, + atk_dist = ad + } + storage + ) + --generate : Model.Type generate = { @@ -16,58 +45,28 @@ generate = battlemap = (Shim.Battlemap.generate), controlled_team = 0, characters = - (Dict.insert - "3" - { - id = "3", - name = "Char3", - icon = "3", - team = 1, - portrait = "3", - location = {x = 3, y = 2}, - movement_points = 2, - atk_dist = 4 - } - (Dict.insert - "2" - { - id = "2", - name = "Char2", - icon = "2", - team = 1, - portrait = "2", - location = {x = 2, y = 2}, - movement_points = 3, - atk_dist = 3 - } - (Dict.insert - "1" - { - id = "1", - name = "Char1", - icon = "1", - team = 0, - portrait = "1", - location = {x = 1, y = 0}, - movement_points = 4, - atk_dist = 2 - } - (Dict.insert - "0" - { - id = "0", - name = "Char0", - icon = "0", - team = 0, - portrait = "0", - location = {x = 0, y = 0}, - movement_points = 5, - atk_dist = 1 - } - Dict.empty - ) - ) - ) - ), + (new_char "0" 0 0 0 7 0 + (new_char "1" 0 1 0 6 1 + (new_char "2" 1 2 7 5 2 + (new_char "3" 1 3 7 4 3 + Dict.empty + )))), +-- (new_char "0" 0 0 0 7 0 +-- (new_char "1" 0 1 0 6 1 +-- (new_char "2" 0 2 0 5 1 +-- (new_char "3" 0 3 0 4 2 +-- (new_char "4" 0 4 0 3 2 +-- (new_char "3" 0 3 0 2 3 +-- (new_char "4" 0 4 0 1 3 +-- (new_char "5" 1 0 7 7 0 +-- (new_char "6" 1 1 7 6 1 +-- (new_char "7" 1 2 7 5 1 +-- (new_char "8" 1 3 7 4 2 +-- (new_char "9" 1 4 7 3 2 +-- (new_char "10" 1 3 7 2 3 +-- (new_char "11" 1 4 7 1 3 +-- Dict.empty +-- )))))))))))))), + ui = (UI.default) } diff --git a/src/battlemap/src/Update.elm b/src/battlemap/src/Update.elm index c62100d..a171aa6 100644 --- a/src/battlemap/src/Update.elm +++ b/src/battlemap/src/Update.elm @@ -2,6 +2,8 @@ module Update exposing (update) import Event +import Error + import UI import Model @@ -10,6 +12,8 @@ import Model.SelectTile import Model.SelectCharacter import Model.EndTurn +import Send.CharacterTurn + update : Event.Type -> Model.Type -> (Model.Type, (Cmd Event.Type)) update event model = let @@ -26,7 +30,14 @@ update event model = ((Model.SelectCharacter.apply_to new_model char_id), Cmd.none) Event.TurnEnded -> - ((Model.EndTurn.apply_to new_model), Cmd.none) + ( + (Model.EndTurn.apply_to new_model), +-- Cmd.none + (case (Send.CharacterTurn.try_sending model) of + (Just cmd) -> cmd + Nothing -> Cmd.none + ) + ) (Event.ScaleChangeRequested mod) -> if (mod == 0.0) @@ -50,3 +61,12 @@ update event model = (Model.reset {model | controlled_team = 0} model.characters), Cmd.none ) + + (Event.ServerReplied _) -> + ( + (Model.invalidate + model + (Error.new Error.Unimplemented "Handle server reply.") + ), + Cmd.none + ) -- cgit v1.2.3-70-g09d2