| summaryrefslogtreecommitdiff | 
diff options
| author | nsensfel <SpamShield0@noot-noot.org> | 2017-11-10 16:29:36 +0100 | 
|---|---|---|
| committer | nsensfel <SpamShield0@noot-noot.org> | 2017-11-10 16:29:36 +0100 | 
| commit | a1f1b7cf82862c0ecf7a3aa88631aa285e5496ca (patch) | |
| tree | 57ee759795a612885a04cf3fb4ec959024bfbb41 /src/battlemap | |
| parent | 60236a302381aeb4e97a42fdcc3afef53cf4e831 (diff) | |
The implementation is hacky, but it can change map.
Diffstat (limited to 'src/battlemap')
| -rw-r--r-- | src/battlemap/src/Event.elm | 2 | ||||
| -rw-r--r-- | src/battlemap/src/Model/HandleServerReply.elm | 41 | ||||
| -rw-r--r-- | src/battlemap/src/Model/SetMap.elm | 76 | ||||
| -rw-r--r-- | src/battlemap/src/Send.elm | 55 | ||||
| -rw-r--r-- | src/battlemap/src/Send/CharacterTurn.elm | 47 | ||||
| -rw-r--r-- | src/battlemap/src/Send/LoadBattlemap.elm | 39 | ||||
| -rw-r--r-- | src/battlemap/src/Update.elm | 4 | 
7 files changed, 165 insertions, 99 deletions
| diff --git a/src/battlemap/src/Event.elm b/src/battlemap/src/Event.elm index f9d4b33..21bbcb6 100644 --- a/src/battlemap/src/Event.elm +++ b/src/battlemap/src/Event.elm @@ -18,6 +18,6 @@ type Type =     | TurnEnded     | ScaleChangeRequested Float     | TabSelected UI.Tab -   | ServerReplied (Result Http.Error (Dict.Dict String (List String))) +   | ServerReplied (Result Http.Error (List (List String)))     | DebugTeamSwitchRequest     | DebugLoadBattlemapRequest diff --git a/src/battlemap/src/Model/HandleServerReply.elm b/src/battlemap/src/Model/HandleServerReply.elm index 7245cc4..59b614c 100644 --- a/src/battlemap/src/Model/HandleServerReply.elm +++ b/src/battlemap/src/Model/HandleServerReply.elm @@ -1,36 +1,47 @@  module Model.HandleServerReply exposing (apply_to)  -- Elm ------------------------------------------------------------------------- -import Dict +import Json.Decode  -- Battlemap -------------------------------------------------------------------  import Model  import Error  import Event +import Model.SetMap +  --------------------------------------------------------------------------------  -- LOCAL -----------------------------------------------------------------------  -------------------------------------------------------------------------------- +apply_command: (List String) -> Model.Type -> Model.Type +apply_command cmd model = +   case +      cmd +   of +      ["set_map", data] -> +         (Model.SetMap.apply_to model data) + +      ["add_char", data] -> model + +      _ -> +         (Model.invalidate +            model +            (Error.new +               Error.Programming +               ( +                  "Received invalid command from server:" +                  ++ (toString cmd) +               ) +            ) +         )  --------------------------------------------------------------------------------  -- EXPORTED --------------------------------------------------------------------  --------------------------------------------------------------------------------  apply_to : (        Model.Type -> -      (Dict.Dict String (List String)) -> +      (List (List String)) ->        (Model.Type, (Cmd Event.Type))     )  apply_to model serialized_commands = -   ( -      (Model.invalidate -         model -         (Error.new -            Error.Unimplemented -            ( -               "Received reply from server:" -               ++ (toString serialized_commands) -            ) -         ) -      ), -      Cmd.none -   ) +   ((List.foldr (apply_command) model serialized_commands), Cmd.none) diff --git a/src/battlemap/src/Model/SetMap.elm b/src/battlemap/src/Model/SetMap.elm new file mode 100644 index 0000000..eb6dc5b --- /dev/null +++ b/src/battlemap/src/Model/SetMap.elm @@ -0,0 +1,76 @@ +module Model.SetMap exposing (apply_to) +import Array +import Json.Decode + + + +import Battlemap.Tile + +import Model + +type alias MapData = +   { +      width : Int, +      height : Int, +      content : (List (List Int)) +   } + +from_int : Int -> Int -> (List Int) -> Battlemap.Tile.Type +from_int map_width index data = +   case data of +      [icon_id, cost] -> +         { +            location = +               { +                  x = (index % map_width), +                  y = (index // map_width) +               }, +            icon_id = (toString icon_id), +            crossing_cost = cost +         } +      _ -> +         { +            location = +               { +                  x = (index % map_width), +                  y = (index // map_width) +               }, +            icon_id = "0", +            crossing_cost = 1 +         } + +apply_to : Model.Type -> String -> Model.Type +apply_to model serialized_map = +   case +      (Json.Decode.decodeString +         (Json.Decode.map3 MapData +            (Json.Decode.field "width" Json.Decode.int) +            (Json.Decode.field "height" Json.Decode.int) +            (Json.Decode.field +               "content" +               (Json.Decode.list +                  (Json.Decode.list Json.Decode.int) +               ) +            ) +         ) +         serialized_map +      ) +   of +      (Result.Ok map_data) -> +         {model | +            battlemap = +               { +                  width = map_data.width, +                  height = map_data.height, +                  content = +                     (Array.fromList +                        (List.indexedMap +                           (from_int map_data.width) +                           map_data.content +                        ) +                     ), +                  navigator = Nothing +               } +         } + +      _ -> model diff --git a/src/battlemap/src/Send.elm b/src/battlemap/src/Send.elm index 8f8d44f..3288050 100644 --- a/src/battlemap/src/Send.elm +++ b/src/battlemap/src/Send.elm @@ -1,7 +1,50 @@ -module Send exposing (Reply) +module Send exposing (Reply, try_sending) -type alias Reply = --String -   { -      types : (List String), -      data : (List String) -   } +-- Elm ------------------------------------------------------------------------- +import Json.Decode +import Json.Encode + +import Http + +-- Battlemap ------------------------------------------------------------------- +import Model + +import Event + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Reply = (List String) + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +decoder : (Json.Decode.Decoder (List (List String))) +decoder = +   (Json.Decode.list (Json.Decode.list Json.Decode.string)) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +try_sending : ( +      Model.Type -> +      String -> +      (Model.Type -> (Maybe Json.Encode.Value)) -> +      (Maybe (Cmd Event.Type)) +   ) +try_sending model recipient try_encoding_fun = +   case (try_encoding_fun model) of +      (Just serial) -> +         (Just +            (Http.send +               Event.ServerReplied +               (Http.post +                  recipient +                  (Http.jsonBody serial) +                  (decoder) +               ) +            ) +         ) + +      Nothing -> Nothing diff --git a/src/battlemap/src/Send/CharacterTurn.elm b/src/battlemap/src/Send/CharacterTurn.elm index 9e2aa8f..ce1438e 100644 --- a/src/battlemap/src/Send/CharacterTurn.elm +++ b/src/battlemap/src/Send/CharacterTurn.elm @@ -1,27 +1,22 @@ -module Send.CharacterTurn exposing (try_sending) +module Send.CharacterTurn exposing (try)  -- Elm ------------------------------------------------------------------------- -import Http -  import Dict  import Json.Encode -import Json.Decode  -- Battlemap ------------------------------------------------------------------- -import Constants.IO -  import Battlemap  import Battlemap.Direction  import UI +import Constants.IO +import Event +  import Model  import Send - -import Event -  --------------------------------------------------------------------------------  -- TYPES ------------------------------------------------------------------------  -------------------------------------------------------------------------------- @@ -71,37 +66,9 @@ try_encoding model =        _ ->           Nothing -decode : (Json.Decode.Decoder (Dict.Dict String (List String))) --Send.Reply) -decode = -   (Json.Decode.dict -      (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.character_turn_handler -                  (Http.jsonBody serial) -                  (decode) -               ) -            ) -         ) - -      Nothing -> Nothing +try : Model.Type -> (Maybe (Cmd Event.Type)) +try model = +   (Send.try_sending model Constants.IO.character_turn_handler try_encoding) diff --git a/src/battlemap/src/Send/LoadBattlemap.elm b/src/battlemap/src/Send/LoadBattlemap.elm index e7dc82a..71758cf 100644 --- a/src/battlemap/src/Send/LoadBattlemap.elm +++ b/src/battlemap/src/Send/LoadBattlemap.elm @@ -1,12 +1,9 @@ -module Send.LoadBattlemap exposing (try_sending) +module Send.LoadBattlemap exposing (try)  -- Elm ------------------------------------------------------------------------- -import Http -  import Dict  import Json.Encode -import Json.Decode  -- Battlemap -------------------------------------------------------------------  import Constants.IO @@ -47,37 +44,9 @@ try_encoding model =        _ ->           Nothing -decode : (Json.Decode.Decoder (Dict.Dict String (List String))) --Send.Reply) -decode = -   (Json.Decode.dict -      (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_loading_handler -                  (Http.jsonBody serial) -                  (decode) -               ) -            ) -         ) - -      Nothing -> Nothing +try : Model.Type -> (Maybe (Cmd Event.Type)) +try model = +   (Send.try_sending model Constants.IO.battlemap_loading_handler try_encoding) diff --git a/src/battlemap/src/Update.elm b/src/battlemap/src/Update.elm index b0930b8..d3786d6 100644 --- a/src/battlemap/src/Update.elm +++ b/src/battlemap/src/Update.elm @@ -35,7 +35,7 @@ update event model =           (              (Model.EndTurn.apply_to new_model),  --            Cmd.none -            (case (Send.CharacterTurn.try_sending model) of +            (case (Send.CharacterTurn.try model) of                 (Just cmd) -> cmd                 Nothing -> Cmd.none              ) @@ -67,7 +67,7 @@ update event model =        (Event.DebugLoadBattlemapRequest) ->           (              model, -            (case (Send.LoadBattlemap.try_sending model) of +            (case (Send.LoadBattlemap.try model) of                 (Just cmd) -> cmd                 Nothing -> Cmd.none              ) | 


