From dc0d49ee836f89161412bc0939f2fbc1e68a7588 Mon Sep 17 00:00:00 2001 From: nsensfel Date: Tue, 5 Dec 2017 15:30:20 +0100 Subject: Trying to figure out how to organize the code... --- src/battlemap/src/Battlemap.elm | 237 -------------------- src/battlemap/src/Battlemap/Direction.elm | 27 --- src/battlemap/src/Battlemap/Location.elm | 45 ---- src/battlemap/src/Battlemap/Marker.elm | 5 - src/battlemap/src/Battlemap/Navigator.elm | 159 -------------- src/battlemap/src/Battlemap/Navigator/Move.elm | 157 -------------- src/battlemap/src/Battlemap/Navigator/Path.elm | 171 --------------- .../src/Battlemap/Navigator/RangeIndicator.elm | 238 -------------------- src/battlemap/src/Battlemap/Tile.elm | 54 ----- src/battlemap/src/Character.elm | 118 ---------- src/battlemap/src/ElmModule/Init.elm | 29 +++ src/battlemap/src/ElmModule/Subscriptions.elm | 7 + src/battlemap/src/ElmModule/Update.elm | 55 +++++ src/battlemap/src/ElmModule/View.elm | 61 ++++++ src/battlemap/src/Error.elm | 33 --- src/battlemap/src/Event.elm | 21 -- src/battlemap/src/Init.elm | 29 --- src/battlemap/src/Model.elm | 86 -------- src/battlemap/src/Model/EndTurn.elm | 82 ------- src/battlemap/src/Model/HandleServerReply.elm | 46 ---- .../src/Model/HandleServerReply/AddChar.elm | 90 -------- .../src/Model/HandleServerReply/SetMap.elm | 71 ------ src/battlemap/src/Model/RequestDirection.elm | 71 ------ src/battlemap/src/Model/SelectCharacter.elm | 110 ---------- src/battlemap/src/Model/SelectTile.elm | 110 ---------- src/battlemap/src/Move.elm | 160 ++++++++++++++ src/battlemap/src/Query/CharacterTurn.elm | 115 ---------- src/battlemap/src/Send.elm | 50 ----- src/battlemap/src/Send/Query/CharacterTurn.elm | 115 ++++++++++ src/battlemap/src/Send/Send.elm | 50 +++++ src/battlemap/src/Struct/Battlemap.elm | 122 +++++++++++ src/battlemap/src/Struct/Character.elm | 118 ++++++++++ src/battlemap/src/Struct/Direction.elm | 37 ++++ src/battlemap/src/Struct/Error.elm | 43 ++++ src/battlemap/src/Struct/Event.elm | 24 +++ src/battlemap/src/Struct/Location.elm | 49 +++++ src/battlemap/src/Struct/Marker.elm | 8 + src/battlemap/src/Struct/Model.elm | 85 ++++++++ src/battlemap/src/Struct/Navigator.elm | 159 ++++++++++++++ src/battlemap/src/Struct/Path.elm | 173 +++++++++++++++ src/battlemap/src/Struct/RangeIndicator.elm | 240 +++++++++++++++++++++ src/battlemap/src/Struct/Tile.elm | 54 +++++ src/battlemap/src/Struct/UI.elm | 122 +++++++++++ src/battlemap/src/Subscriptions.elm | 7 - src/battlemap/src/UI.elm | 122 ----------- src/battlemap/src/Update.elm | 90 -------- src/battlemap/src/Update/ChangeScale.elm | 26 +++ src/battlemap/src/Update/EndTurn.elm | 82 +++++++ src/battlemap/src/Update/HandleServerReply.elm | 57 +++++ .../src/Update/HandleServerReply/AddChar.elm | 90 ++++++++ .../src/Update/HandleServerReply/SetMap.elm | 71 ++++++ src/battlemap/src/Update/RequestDirection.elm | 78 +++++++ src/battlemap/src/Update/SelectCharacter.elm | 124 +++++++++++ src/battlemap/src/Update/SelectTab.elm | 25 +++ src/battlemap/src/Update/SelectTile.elm | 110 ++++++++++ .../src/Update/SendLoadBattlemapRequest.elm | 28 +++ src/battlemap/src/Update/SwitchTeam.elm | 42 ++++ src/battlemap/src/View.elm | 58 ----- 58 files changed, 2444 insertions(+), 2402 deletions(-) delete mode 100644 src/battlemap/src/Battlemap.elm delete mode 100644 src/battlemap/src/Battlemap/Direction.elm delete mode 100644 src/battlemap/src/Battlemap/Location.elm delete mode 100644 src/battlemap/src/Battlemap/Marker.elm delete mode 100644 src/battlemap/src/Battlemap/Navigator.elm delete mode 100644 src/battlemap/src/Battlemap/Navigator/Move.elm delete mode 100644 src/battlemap/src/Battlemap/Navigator/Path.elm delete mode 100644 src/battlemap/src/Battlemap/Navigator/RangeIndicator.elm delete mode 100644 src/battlemap/src/Battlemap/Tile.elm delete mode 100644 src/battlemap/src/Character.elm create mode 100644 src/battlemap/src/ElmModule/Init.elm create mode 100644 src/battlemap/src/ElmModule/Subscriptions.elm create mode 100644 src/battlemap/src/ElmModule/Update.elm create mode 100644 src/battlemap/src/ElmModule/View.elm delete mode 100644 src/battlemap/src/Error.elm delete mode 100644 src/battlemap/src/Event.elm delete mode 100644 src/battlemap/src/Init.elm delete mode 100644 src/battlemap/src/Model.elm delete mode 100644 src/battlemap/src/Model/EndTurn.elm delete mode 100644 src/battlemap/src/Model/HandleServerReply.elm delete mode 100644 src/battlemap/src/Model/HandleServerReply/AddChar.elm delete mode 100644 src/battlemap/src/Model/HandleServerReply/SetMap.elm delete mode 100644 src/battlemap/src/Model/RequestDirection.elm delete mode 100644 src/battlemap/src/Model/SelectCharacter.elm delete mode 100644 src/battlemap/src/Model/SelectTile.elm create mode 100644 src/battlemap/src/Move.elm delete mode 100644 src/battlemap/src/Query/CharacterTurn.elm delete mode 100644 src/battlemap/src/Send.elm create mode 100644 src/battlemap/src/Send/Query/CharacterTurn.elm create mode 100644 src/battlemap/src/Send/Send.elm create mode 100644 src/battlemap/src/Struct/Battlemap.elm create mode 100644 src/battlemap/src/Struct/Character.elm create mode 100644 src/battlemap/src/Struct/Direction.elm create mode 100644 src/battlemap/src/Struct/Error.elm create mode 100644 src/battlemap/src/Struct/Event.elm create mode 100644 src/battlemap/src/Struct/Location.elm create mode 100644 src/battlemap/src/Struct/Marker.elm create mode 100644 src/battlemap/src/Struct/Model.elm create mode 100644 src/battlemap/src/Struct/Navigator.elm create mode 100644 src/battlemap/src/Struct/Path.elm create mode 100644 src/battlemap/src/Struct/RangeIndicator.elm create mode 100644 src/battlemap/src/Struct/Tile.elm create mode 100644 src/battlemap/src/Struct/UI.elm delete mode 100644 src/battlemap/src/Subscriptions.elm delete mode 100644 src/battlemap/src/UI.elm delete mode 100644 src/battlemap/src/Update.elm create mode 100644 src/battlemap/src/Update/ChangeScale.elm create mode 100644 src/battlemap/src/Update/EndTurn.elm create mode 100644 src/battlemap/src/Update/HandleServerReply.elm create mode 100644 src/battlemap/src/Update/HandleServerReply/AddChar.elm create mode 100644 src/battlemap/src/Update/HandleServerReply/SetMap.elm create mode 100644 src/battlemap/src/Update/RequestDirection.elm create mode 100644 src/battlemap/src/Update/SelectCharacter.elm create mode 100644 src/battlemap/src/Update/SelectTab.elm create mode 100644 src/battlemap/src/Update/SelectTile.elm create mode 100644 src/battlemap/src/Update/SendLoadBattlemapRequest.elm create mode 100644 src/battlemap/src/Update/SwitchTeam.elm delete mode 100644 src/battlemap/src/View.elm (limited to 'src/battlemap') diff --git a/src/battlemap/src/Battlemap.elm b/src/battlemap/src/Battlemap.elm deleted file mode 100644 index 5b289d0..0000000 --- a/src/battlemap/src/Battlemap.elm +++ /dev/null @@ -1,237 +0,0 @@ -module Battlemap exposing - ( - Type, - empty, - new, - reset, - get_width, - get_height, - get_navigator_remaining_points, - get_tiles, - set_navigator, - clear_navigator_path, - get_navigator_path, - try_getting_tile_at, - try_getting_navigator_location, - try_getting_navigator_path_to, - try_getting_navigator_summary, - try_adding_step_to_navigator - ) - -import Array - -import Battlemap.Navigator -import Battlemap.Tile -import Battlemap.Direction -import Battlemap.Location - -import Character - -import Constants.Movement - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Type = - { - width: Int, - height: Int, - content: (Array.Array Battlemap.Tile.Type), - navigator: (Maybe Battlemap.Navigator.Type) - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -location_to_index : Type -> Battlemap.Location.Type -> Int -location_to_index bmap loc = - ((loc.y * bmap.width) + loc.x) - -has_location : Type -> Battlemap.Location.Type -> Bool -has_location bmap loc = - ( - (loc.x >= 0) - && (loc.y >= 0) - && (loc.x < bmap.width) - && (loc.y < bmap.height) - ) - -tile_cost_function : ( - Type -> - Battlemap.Location.Type -> - (List Character.Type) -> - Battlemap.Location.Type -> - Int - ) -tile_cost_function bmap start_loc char_list loc = - if - ( - (Battlemap.Location.get_ref start_loc) - == - (Battlemap.Location.get_ref loc) - ) - then - 0 - else - if (has_location bmap loc) - then - case - (Array.get (location_to_index bmap loc) bmap.content) - of - (Just tile) -> - if - (List.any - (\c -> ((Character.get_location c) == loc)) - char_list - ) - then - Constants.Movement.cost_when_occupied_tile - else - (Battlemap.Tile.get_cost tile) - - Nothing -> Constants.Movement.cost_when_out_of_bounds - else - Constants.Movement.cost_when_out_of_bounds - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -get_width : Type -> Int -get_width bmap = bmap.width - -get_height : Type -> Int -get_height bmap = bmap.height - -get_tiles : Type -> (Array.Array Battlemap.Tile.Type) -get_tiles bmap = bmap.content - -empty : Type -empty = - { - width = 0, - height = 0, - content = (Array.empty), - navigator = Nothing - } - -new : Int -> Int -> (List Battlemap.Tile.Type) -> Type -new width height tiles = - { - width = width, - height = height, - content = (Array.fromList tiles), - navigator = Nothing - } - -reset : Type -> Type -reset bmap = - {bmap | - navigator = Nothing - } - -clear_navigator_path : Type -> Type -clear_navigator_path bmap = - case bmap.navigator of - (Just navigator) -> - {bmap | navigator = (Just (Battlemap.Navigator.clear_path navigator))} - - Nothing -> bmap - -get_navigator_path : Type -> (List Battlemap.Direction.Type) -get_navigator_path bmap = - case bmap.navigator of - (Just navigator) -> (Battlemap.Navigator.get_path navigator) - Nothing -> [] - -try_getting_navigator_location : Type -> (Maybe Battlemap.Location.Type) -try_getting_navigator_location bmap = - case bmap.navigator of - (Just navigator) -> - (Just (Battlemap.Navigator.get_current_location navigator)) - - Nothing -> Nothing - -get_navigator_remaining_points : Type -> Int -get_navigator_remaining_points bmap = - case bmap.navigator of - (Just navigator) -> (Battlemap.Navigator.get_remaining_points navigator) - Nothing -> -1 - -set_navigator : ( - Battlemap.Location.Type -> - Int -> - Int -> - (List Character.Type) -> - Type -> - Type - ) -set_navigator start_loc movement_points attack_range character_list bmap = - {bmap | - navigator = - (Just - (Battlemap.Navigator.new - start_loc - movement_points - attack_range - (tile_cost_function - bmap - start_loc - character_list - ) - ) - ) - } - -try_getting_tile_at : ( - Type -> - Battlemap.Location.Type -> - (Maybe Battlemap.Tile.Type) - ) -try_getting_tile_at bmap loc = - (Array.get (location_to_index bmap loc) bmap.content) - -try_adding_step_to_navigator : ( - Type -> - (List Character.Type) -> - Battlemap.Direction.Type -> - (Maybe Type) - ) -try_adding_step_to_navigator bmap character_list dir = - case bmap.navigator of - (Just navigator) -> - let - new_navigator = - (Battlemap.Navigator.try_adding_step - navigator - dir - (tile_cost_function - bmap - (Battlemap.Navigator.get_starting_location navigator) - character_list - ) - ) - in - case new_navigator of - (Just _) -> (Just {bmap | navigator = new_navigator}) - Nothing -> Nothing - - _ -> Nothing - -try_getting_navigator_summary : Type -> (Maybe Battlemap.Navigator.Summary) -try_getting_navigator_summary bmap = - case bmap.navigator of - (Just navigator) -> (Just (Battlemap.Navigator.get_summary navigator)) - Nothing -> Nothing - -try_getting_navigator_path_to : ( - Type -> - Battlemap.Location.Ref -> - (Maybe (List Battlemap.Direction.Type)) - ) -try_getting_navigator_path_to bmap loc_ref = - case bmap.navigator of - (Just navigator) -> - (Battlemap.Navigator.try_getting_path_to navigator loc_ref) - - Nothing -> Nothing - diff --git a/src/battlemap/src/Battlemap/Direction.elm b/src/battlemap/src/Battlemap/Direction.elm deleted file mode 100644 index cebe765..0000000 --- a/src/battlemap/src/Battlemap/Direction.elm +++ /dev/null @@ -1,27 +0,0 @@ -module Battlemap.Direction exposing (Type(..), opposite_of, to_string) - -type Type = - None - | Left - | Right - | Up - | Down - -opposite_of : Type -> Type -opposite_of d = - case d of - Left -> Right - Right -> Left - Up -> Down - Down -> Up - None -> None - -to_string : Type -> String -to_string dir = - case dir of - Right -> "R" - Left -> "L" - Up -> "U" - Down -> "D" - None -> "N" - diff --git a/src/battlemap/src/Battlemap/Location.elm b/src/battlemap/src/Battlemap/Location.elm deleted file mode 100644 index 8c23e9d..0000000 --- a/src/battlemap/src/Battlemap/Location.elm +++ /dev/null @@ -1,45 +0,0 @@ -module Battlemap.Location exposing (..) - -import Battlemap.Direction - -type alias Type = - { - x : Int, - y : Int - } - -type alias Ref = (Int, Int) - -neighbor : Type -> Battlemap.Direction.Type -> Type -neighbor loc dir = - case dir of - Battlemap.Direction.Right -> {loc | x = (loc.x + 1)} - Battlemap.Direction.Left -> {loc | x = (loc.x - 1)} - Battlemap.Direction.Up -> {loc | y = (loc.y - 1)} - Battlemap.Direction.Down -> {loc | y = (loc.y + 1)} - Battlemap.Direction.None -> loc - - -get_ref : Type -> Ref -get_ref l = - (l.x, l.y) - -from_ref : Ref -> Type -from_ref (x, y) = - {x = x, y = y} - -dist : Type -> Type -> Int -dist loc_a loc_b = - if (loc_a.x > loc_b.x) - then - if (loc_a.y > loc_b.y) - then - ((loc_a.x - loc_b.x) + (loc_a.y - loc_b.y)) - else - ((loc_a.x - loc_b.x) + (loc_b.y - loc_a.y)) - else - if (loc_a.y > loc_b.y) - then - ((loc_b.x - loc_a.x) + (loc_a.y - loc_b.y)) - else - ((loc_b.x - loc_a.x) + (loc_b.y - loc_a.y)) diff --git a/src/battlemap/src/Battlemap/Marker.elm b/src/battlemap/src/Battlemap/Marker.elm deleted file mode 100644 index ebefce6..0000000 --- a/src/battlemap/src/Battlemap/Marker.elm +++ /dev/null @@ -1,5 +0,0 @@ -module Battlemap.Marker exposing (Type(..)) - -type Type = - CanAttack - | CanGoTo diff --git a/src/battlemap/src/Battlemap/Navigator.elm b/src/battlemap/src/Battlemap/Navigator.elm deleted file mode 100644 index b535dd6..0000000 --- a/src/battlemap/src/Battlemap/Navigator.elm +++ /dev/null @@ -1,159 +0,0 @@ -module Battlemap.Navigator exposing - ( - Type, - Summary, - new, - get_current_location, - get_starting_location, - get_remaining_points, - get_range_markers, - get_path, - get_summary, - clear_path, - try_adding_step, - try_getting_path_to - ) - -import Dict - -import Battlemap.Location -import Battlemap.Direction -import Battlemap.Marker - -import Battlemap.Navigator.Path -import Battlemap.Navigator.RangeIndicator - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Type = - { - starting_location: Battlemap.Location.Type, - movement_dist: Int, - attack_dist: Int, - path: Battlemap.Navigator.Path.Type, - range_indicators: - (Dict.Dict - Battlemap.Location.Ref - Battlemap.Navigator.RangeIndicator.Type - ) - } - -type alias Summary = - { - starting_location: Battlemap.Location.Type, - path: (List Battlemap.Direction.Type), - markers: (List (Battlemap.Location.Ref, Battlemap.Marker.Type)) - } --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- - -new : ( - Battlemap.Location.Type -> - Int -> - Int -> - (Battlemap.Location.Type -> Int) -> - Type - ) -new start_loc mov_dist atk_dist cost_fun = - { - starting_location = start_loc, - movement_dist = mov_dist, - attack_dist = atk_dist, - path = (Battlemap.Navigator.Path.new start_loc mov_dist), - range_indicators = - (Battlemap.Navigator.RangeIndicator.generate - start_loc - mov_dist - atk_dist - (cost_fun) - ) - } - -get_current_location : Type -> Battlemap.Location.Type -get_current_location navigator = - (Battlemap.Navigator.Path.get_current_location navigator.path) - -get_starting_location : Type -> Battlemap.Location.Type -get_starting_location navigator = navigator.starting_location - -get_remaining_points : Type -> Int -get_remaining_points navigator = - (Battlemap.Navigator.Path.get_remaining_points navigator.path) - -get_range_markers : ( - Type -> - (List - (Battlemap.Location.Ref, Battlemap.Navigator.RangeIndicator.Type) - ) - ) -get_range_markers navigator = (Dict.toList navigator.range_indicators) - -get_path : Type -> (List Battlemap.Direction.Type) -get_path navigator = (Battlemap.Navigator.Path.get_summary navigator.path) - -get_summary : Type -> Summary -get_summary navigator = - { - starting_location = navigator.starting_location, - path = (Battlemap.Navigator.Path.get_summary navigator.path), - markers = - (List.map - (\(loc, range_indicator) -> - ( - loc, - (Battlemap.Navigator.RangeIndicator.get_marker - range_indicator - ) - ) - ) - (Dict.toList - navigator.range_indicators - ) - ) - } - -clear_path : Type -> Type -clear_path navigator = - {navigator | - path = - (Battlemap.Navigator.Path.new - navigator.starting_location - navigator.movement_dist - ) - } - -try_adding_step : ( - Type -> - Battlemap.Direction.Type -> - (Battlemap.Location.Type -> Int) -> - (Maybe Type) - ) -try_adding_step navigator dir cost_fun = - case - (Battlemap.Navigator.Path.try_following_direction - cost_fun - (Just navigator.path) - dir - ) - of - (Just path) -> (Just {navigator | path = path}) - Nothing -> Nothing - -try_getting_path_to : ( - Type -> - Battlemap.Location.Ref -> - (Maybe (List Battlemap.Direction.Type)) - ) -try_getting_path_to navigator loc_ref = - case (Dict.get loc_ref navigator.range_indicators) of - (Just target) -> - (Just (Battlemap.Navigator.RangeIndicator.get_path target)) - Nothing -> Nothing - diff --git a/src/battlemap/src/Battlemap/Navigator/Move.elm b/src/battlemap/src/Battlemap/Navigator/Move.elm deleted file mode 100644 index 9d7a17b..0000000 --- a/src/battlemap/src/Battlemap/Navigator/Move.elm +++ /dev/null @@ -1,157 +0,0 @@ -module Battlemap.Navigator.Move exposing (to) - -import Set -import List - -import Battlemap -import Battlemap.Direction -import Battlemap.Location -import Battlemap.Tile -import Battlemap.Navigator - -import Character - -import Util.List - -can_move_to_new_tile : ( - Battlemap.Navigator.Type -> - Battlemap.Type -> - Battlemap.Location.Type -> - Bool - ) -can_move_to_new_tile nav battlemap next_location = - ( - (nav.remaining_points > 0) - && (Battlemap.has_location battlemap next_location) - && (nav.current_location /= next_location) - && - (not - (Set.member - (Battlemap.Location.get_ref next_location) - nav.visited_locations - ) - ) - ) - -battlemap_move_to : ( - Battlemap.Type -> - Battlemap.Location.Type -> - Battlemap.Direction.Type -> - Battlemap.Location.Type -> - Battlemap.Type - ) -battlemap_move_to battlemap current_loc dir next_loc = - (Battlemap.apply_to_tile_unsafe - (Battlemap.apply_to_tile_unsafe - battlemap - current_loc - (Battlemap.Tile.set_direction dir) - ) - next_loc - (Battlemap.Tile.set_direction dir) - ) - -navigator_move_to : ( - Battlemap.Navigator.Type -> - Battlemap.Direction.Type -> - Battlemap.Location.Type -> - Battlemap.Navigator.Type - ) -navigator_move_to nav dir next_loc = - {nav | - current_location = next_loc, - visited_locations = - (Set.insert - (Battlemap.Location.get_ref nav.current_location) - nav.visited_locations - ), - previous_directions = (dir :: nav.previous_directions), - remaining_points = (nav.remaining_points - 1) - } - -battlemap_backtrack : ( - Battlemap.Type -> - Battlemap.Location.Type -> - Battlemap.Type - ) -battlemap_backtrack battlemap current_loc = - (Battlemap.apply_to_tile_unsafe - battlemap - current_loc - (Battlemap.Tile.set_direction - Battlemap.Direction.None - ) - ) - -navigator_backtrack : ( - Battlemap.Navigator.Type -> - Battlemap.Location.Type -> - (List Battlemap.Direction.Type) -> - Battlemap.Navigator.Type - ) -navigator_backtrack nav next_loc prev_dir_tail = - {nav | - current_location = next_loc, - visited_locations = - (Set.remove - (Battlemap.Location.get_ref next_loc) - nav.visited_locations - ), - previous_directions = prev_dir_tail, - remaining_points = (nav.remaining_points + 1) - } - -to : ( - Battlemap.Type -> - Battlemap.Navigator.Type -> - Battlemap.Direction.Type -> - (List Character.Type) -> - (Battlemap.Type, Battlemap.Navigator.Type) - ) -to battlemap nav dir char_list = - let - next_location = (Battlemap.Location.neighbor nav.current_location dir) - is_occupied = - (List.any - (\c -> ((Character.get_location c) == next_location)) - char_list - ) - in - if (not is_occupied) - then - if (can_move_to_new_tile nav battlemap next_location) - then - ( - (battlemap_move_to - battlemap - nav.current_location - dir - next_location - ), - (navigator_move_to - nav - dir - next_location - ) - ) - else - case (Util.List.pop nav.previous_directions) of - Nothing -> (battlemap, nav) - (Just (head, tail)) -> - if (head == (Battlemap.Direction.opposite_of dir)) - then - ( - (battlemap_backtrack - battlemap - nav.current_location - ), - (navigator_backtrack - nav - next_location - tail - ) - ) - else - (battlemap, nav) - else - (battlemap, nav) diff --git a/src/battlemap/src/Battlemap/Navigator/Path.elm b/src/battlemap/src/Battlemap/Navigator/Path.elm deleted file mode 100644 index d0a430f..0000000 --- a/src/battlemap/src/Battlemap/Navigator/Path.elm +++ /dev/null @@ -1,171 +0,0 @@ -module Battlemap.Navigator.Path exposing - ( - Type, - new, - get_current_location, - get_remaining_points, - get_summary, - try_following_direction - ) - -import Set - -import Util.List - -import Battlemap.Direction -import Battlemap.Location - -import Constants.Movement - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Type = - { - current_location : Battlemap.Location.Type, - visited_locations : (Set.Set Battlemap.Location.Ref), - previous_directions : (List Battlemap.Direction.Type), - previous_points : (List Int), - remaining_points : Int - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -has_been_to : ( - Type -> - Battlemap.Location.Type -> - Bool - ) -has_been_to path location = - ( - (path.current_location == location) - || - (Set.member - (Battlemap.Location.get_ref location) - path.visited_locations - ) - ) - -try_moving_to : ( - Type -> - Battlemap.Direction.Type -> - Battlemap.Location.Type -> - Int -> - (Maybe Type) - ) -try_moving_to path dir next_loc cost = - let - remaining_points = (path.remaining_points - cost) - in - if (remaining_points >= 0) - then - (Just - {path | - current_location = next_loc, - visited_locations = - (Set.insert - (Battlemap.Location.get_ref path.current_location) - path.visited_locations - ), - previous_directions = (dir :: path.previous_directions), - previous_points = - (path.remaining_points :: path.previous_points), - remaining_points = remaining_points - } - ) - else - Nothing - -try_backtracking_to : ( - Type -> - Battlemap.Direction.Type -> - Battlemap.Location.Type -> - (Maybe Type) - ) -try_backtracking_to path dir location = - case - ( - (Util.List.pop path.previous_directions), - (Util.List.pop path.previous_points) - ) - of - ( - (Just (prev_dir_head, prev_dir_tail)), - (Just (prev_pts_head, prev_pts_tail)) - ) -> - if (prev_dir_head == (Battlemap.Direction.opposite_of dir)) - then - (Just - {path | - current_location = location, - visited_locations = - (Set.remove - (Battlemap.Location.get_ref location) - path.visited_locations - ), - previous_directions = prev_dir_tail, - previous_points = prev_pts_tail, - remaining_points = prev_pts_head - } - ) - else - Nothing - (_, _) -> - Nothing - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- - -new : Battlemap.Location.Type -> Int -> Type -new start points = - { - current_location = start, - visited_locations = Set.empty, - previous_directions = [], - previous_points = [], - remaining_points = points - } - -get_current_location : Type -> Battlemap.Location.Type -get_current_location path = path.current_location - -get_remaining_points : Type -> Int -get_remaining_points path = path.remaining_points - -get_summary : Type -> (List Battlemap.Direction.Type) -get_summary path = path.previous_directions - -try_following_direction : ( - (Battlemap.Location.Type -> Int) -> - (Maybe Type) -> - Battlemap.Direction.Type -> - (Maybe Type) - ) -try_following_direction cost_fun maybe_path dir = - case maybe_path of - (Just path) -> - let - next_location = - (Battlemap.Location.neighbor - path.current_location - dir - ) - next_location_cost = (cost_fun next_location) - in - if (next_location_cost <= Constants.Movement.max_points) - then - if (has_been_to path next_location) - then - (try_backtracking_to path dir next_location) - else - (try_moving_to - path - dir - next_location - next_location_cost - ) - else - Nothing - Nothing -> Nothing diff --git a/src/battlemap/src/Battlemap/Navigator/RangeIndicator.elm b/src/battlemap/src/Battlemap/Navigator/RangeIndicator.elm deleted file mode 100644 index b0283e0..0000000 --- a/src/battlemap/src/Battlemap/Navigator/RangeIndicator.elm +++ /dev/null @@ -1,238 +0,0 @@ -module Battlemap.Navigator.RangeIndicator exposing - ( - Type, - generate, - get_marker, - get_path - ) - -import Dict -import List - -import Battlemap.Direction -import Battlemap.Location -import Battlemap.Marker - -import Constants.Movement - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Type = - { - distance: Int, - range: Int, - path: (List Battlemap.Direction.Type), - marker: Battlemap.Marker.Type - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -get_closest : ( - Int -> - Battlemap.Location.Ref -> - Type -> - (Battlemap.Location.Ref, Type) -> - (Battlemap.Location.Ref, Type) - ) -get_closest dist ref indicator (prev_ref, prev_indicator) = - if - ( - (indicator.distance < prev_indicator.distance) - || - ( - (indicator.distance > dist) - && (prev_indicator.distance > dist) - && (indicator.range < prev_indicator.range) - ) - ) - then - (ref, indicator) - else - (prev_ref, prev_indicator) - -is_closer : Int -> Int -> Type -> Bool -is_closer new_dist new_range neighbor = - ( - (new_dist < neighbor.distance) - || - ( - (neighbor.distance > new_dist) - && (new_range < neighbor.range) - ) - ) - - -handle_neighbors : ( - Type -> - Battlemap.Location.Type -> - Int -> - Int -> - (Dict.Dict Battlemap.Location.Ref Type) -> - (Battlemap.Location.Type -> Int) -> - Battlemap.Direction.Type -> - (Dict.Dict Battlemap.Location.Ref Type) -> - (Dict.Dict Battlemap.Location.Ref Type) - ) -handle_neighbors src_indicator src_loc dist range results cost_fun dir rem = - let - neighbor_loc = (Battlemap.Location.neighbor src_loc dir) - in - case (Dict.get (Battlemap.Location.get_ref neighbor_loc) results) of - (Just _) -> rem - - Nothing -> - let - node_cost = (cost_fun neighbor_loc) - new_dist = (src_indicator.distance + node_cost) - new_range = (src_indicator.range + 1) - in - if - ( - ( - case - (Dict.get - (Battlemap.Location.get_ref neighbor_loc) - rem - ) - of - (Just neighbor) -> - (is_closer new_dist new_range neighbor) - - Nothing -> - True - ) - && - (node_cost /= Constants.Movement.cost_when_out_of_bounds) - && - ( - (new_dist <= dist) - || - (new_range <= range) - ) - ) - then - (Dict.insert - (Battlemap.Location.get_ref neighbor_loc) - ( - if (new_dist > dist) - then - { - distance = (dist + 1), - range = new_range, - path = (dir :: src_indicator.path), - marker = Battlemap.Marker.CanAttack - } - else - { - distance = new_dist, - range = 0, - path = (dir :: src_indicator.path), - marker = Battlemap.Marker.CanGoTo - } - ) - rem - ) - else - rem - -search : ( - (Dict.Dict Battlemap.Location.Ref Type) -> - (Dict.Dict Battlemap.Location.Ref Type) -> - Int -> - Int -> - (Battlemap.Location.Type -> Int) -> - (Dict.Dict Battlemap.Location.Ref Type) - ) -search result remaining dist range cost_fun = - if (Dict.isEmpty remaining) - then - result - else - let - (min_loc_ref, min) = - (Dict.foldl - (get_closest dist) - ( - (-1,-1), - { - distance = Constants.Movement.cost_when_out_of_bounds, - path = [], - range = Constants.Movement.cost_when_out_of_bounds, - marker = Battlemap.Marker.CanAttack - } - ) - remaining - ) - in - (search - (Dict.insert - min_loc_ref - {min | - marker = - ( - if (min.range > 0) - then - Battlemap.Marker.CanAttack - else - Battlemap.Marker.CanGoTo - ) - } - result - ) - (List.foldl - (handle_neighbors - min - (Battlemap.Location.from_ref min_loc_ref) - dist - range - result - (cost_fun) - ) - (Dict.remove min_loc_ref remaining) - [ - Battlemap.Direction.Left, - Battlemap.Direction.Right, - Battlemap.Direction.Up, - Battlemap.Direction.Down - ] - ) - dist - range - (cost_fun) - ) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -generate : ( - Battlemap.Location.Type -> - Int -> - Int -> - (Battlemap.Location.Type -> Int) -> - (Dict.Dict Battlemap.Location.Ref Type) - ) -generate location dist range cost_fun = - (search - Dict.empty - (Dict.insert - (Battlemap.Location.get_ref location) - { - distance = 0, - path = [], - range = 0, - marker = Battlemap.Marker.CanGoTo - } - Dict.empty - ) - dist - range - (cost_fun) - ) - -get_marker : Type -> Battlemap.Marker.Type -get_marker indicator = indicator.marker - -get_path : Type -> (List Battlemap.Direction.Type) -get_path indicator = indicator.path diff --git a/src/battlemap/src/Battlemap/Tile.elm b/src/battlemap/src/Battlemap/Tile.elm deleted file mode 100644 index 23ee2a8..0000000 --- a/src/battlemap/src/Battlemap/Tile.elm +++ /dev/null @@ -1,54 +0,0 @@ -module Battlemap.Tile exposing - ( - Type, - new, - error_tile, - get_location, - get_icon_id, - get_cost - ) - --- Battlemap ------------------------------------------------------------------- -import Battlemap.Location - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Type = - { - location : Battlemap.Location.Type, - icon_id : String, - crossing_cost : Int - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -new : Int -> Int -> String -> Int -> Type -new x y icon_id crossing_cost = - { - location = {x = x, y = y}, - icon_id = icon_id, - crossing_cost = crossing_cost - } - -error_tile : Int -> Int -> Type -error_tile x y = - { - location = {x = x, y = y}, - icon_id = "error", - crossing_cost = 1 - } - -get_location : Type -> Battlemap.Location.Type -get_location tile = tile.location - -get_icon_id : Type -> String -get_icon_id tile = tile.icon_id - -get_cost : Type -> Int -get_cost tile = tile.crossing_cost diff --git a/src/battlemap/src/Character.elm b/src/battlemap/src/Character.elm deleted file mode 100644 index 31337f7..0000000 --- a/src/battlemap/src/Character.elm +++ /dev/null @@ -1,118 +0,0 @@ -module Character exposing - ( - Type, - Ref, - new, - get_ref, - get_team, - get_icon_id, - get_portrait_id, - get_current_health, - get_max_health, - get_location, - set_location, - get_movement_points, - get_attack_range, - is_enabled, - set_enabled - ) - --- Battlemap ------------------------------------------------------------------- -import Battlemap.Location - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Type = - { - id : String, - name : String, - icon : String, - portrait : String, - location : Battlemap.Location.Type, - health : Int, - max_health : Int, - team : Int, - movement_points : Int, - atk_dist : Int, - enabled : Bool - } - -type alias Ref = String - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -new : ( - String -> -- id - String -> -- name - String -> -- icon - String -> -- portrait - Int -> -- health - Int -> -- max_health - Battlemap.Location.Type -> -- location - Int -> -- team - Int -> -- movement_points - Int -> -- atk_dist - Bool -> -- enabled - Type - ) -new - id name icon portrait - health max_health - location - team movement_points atk_dist - enabled = - { - id = id, - name = name, - icon = icon, - portrait = portrait, - health = health, - max_health = max_health, - location = location, - team = team, - movement_points = movement_points, - atk_dist = atk_dist, - enabled = enabled - } - -get_ref : Type -> Ref -get_ref c = c.id - -get_team : Type -> Int -get_team c = c.team - -get_icon_id : Type -> String -get_icon_id c = c.icon - -get_portrait_id : Type -> String -get_portrait_id c = c.portrait - -get_current_health : Type -> Int -get_current_health c = c.health - -get_max_health : Type -> Int -get_max_health c = c.max_health - -get_location : Type -> Battlemap.Location.Type -get_location t = t.location - -set_location : Battlemap.Location.Type -> Type -> Type -set_location location char = {char | location = location} - -get_movement_points : Type -> Int -get_movement_points char = char.movement_points - -get_attack_range : Type -> Int -get_attack_range char = char.atk_dist - -is_enabled : Type -> Bool -is_enabled char = char.enabled - -set_enabled : Type -> Bool -> Type -set_enabled char enabled = {char | enabled = enabled} diff --git a/src/battlemap/src/ElmModule/Init.elm b/src/battlemap/src/ElmModule/Init.elm new file mode 100644 index 0000000..2b62933 --- /dev/null +++ b/src/battlemap/src/ElmModule/Init.elm @@ -0,0 +1,29 @@ +module ElmModule.Init exposing (init) +-- Battlemap ------------------------------------------------------------------- + +import Struct.Model +import Struct.Event + +import Shim.Model + +import Send.LoadBattlemap + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +init : (Struct.Model.Type, (Cmd Event.Type)) +init = + let + model = (Shim.Model.generate) + in + ( + model, + (case (Send.LoadBattlemap.try model) of + (Just cmd) -> cmd + Nothing -> Cmd.none + ) + ) diff --git a/src/battlemap/src/ElmModule/Subscriptions.elm b/src/battlemap/src/ElmModule/Subscriptions.elm new file mode 100644 index 0000000..c8126b1 --- /dev/null +++ b/src/battlemap/src/ElmModule/Subscriptions.elm @@ -0,0 +1,7 @@ +module ElmModule.Subscriptions exposing (..) + +import Struct.Model +import Struct.Event + +subscriptions : Struct.Model.Type -> (Sub Struct.Event.Type) +subscriptions model = Sub.none diff --git a/src/battlemap/src/ElmModule/Update.elm b/src/battlemap/src/ElmModule/Update.elm new file mode 100644 index 0000000..947b232 --- /dev/null +++ b/src/battlemap/src/ElmModule/Update.elm @@ -0,0 +1,55 @@ +module ElmModule.Update exposing (update) + +-- Elm ------------------------------------------------------------------------- + +-- Battlemap ------------------------------------------------------------------- +import Struct.Event +import Struct.Error +import Struct.UI +import Struct.Model + +import Update.RequestDirection +import Update.SelectTile +import Update.SelectCharacter +import Update.EndTurn +import Update.HandleServerReply + +import Send.LoadBattlemap + +update : ( + Struct.Event.Type -> + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +update event model = + let + new_model = (Struct.Model.clear_error model) + in + case event of + (Struct.Event.DirectionRequested d) -> + (Update.RequestDirection.apply_to new_model d) + + (Struct.Event.TileSelected loc) -> + (Update.SelectTile.apply_to new_model loc) + + (Struct.Event.CharacterSelected char_id) -> + (Update.SelectCharacter.apply_to new_model char_id) + + Struct.Event.TurnEnded -> + (Update.EndTurn.apply_to new_model) + + (Struct.Event.ScaleChangeRequested mod) -> + (Update.ChangeScale.apply_to new_model mod) + + (Struct.Event.TabSelected tab) -> + (Update.SelectTab.apply_to new_model mod) + + Struct.Event.DebugTeamSwitchRequest -> + (Update.SwitchTeam.apply_to new_model) + + (Event.DebugLoadBattlemapRequest) -> + (Update.SendLoadBattlemapRequest.apply_to new_model) + + (Event.ServerReplied result) -> + (Model.HandleServerReply.apply_to model result) + diff --git a/src/battlemap/src/ElmModule/View.elm b/src/battlemap/src/ElmModule/View.elm new file mode 100644 index 0000000..e6e0295 --- /dev/null +++ b/src/battlemap/src/ElmModule/View.elm @@ -0,0 +1,61 @@ +module ElmModule.View exposing (view) + +-- Elm ------------------------------------------------------------------------- +import Dict + +import Html +import Html.Attributes + +-- Battlemap ------------------------------------------------------------------- +import Struct.UI +import Struct.Event +import Struct.Model + +import View.Battlemap +import View.SideBar +import View.Footer + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +view : Struct.Model.Type -> (Html.Html Struct.Event.Type) +view model = + (Html.div + [ + (Html.Attributes.class "fullscreen-module") + ] + [ + (Html.div + [ + (Html.Attributes.class "battlemap-left-panel") + ] + [ + (Html.div + [ + (Html.Attributes.class "battlemap-container") + ] + [ + (View.Battlemap.get_html + model.battlemap + (Struct.UI.get_zoom_level model.ui) + (Dict.values model.characters) + ) + ] + ), + (View.Footer.get_html model) + ] + ), + (Html.div + [ + (Html.Attributes.class "battlemap-right-panel") + ] + [ + (View.SideBar.get_html model) + ] + ) + ] + ) diff --git a/src/battlemap/src/Error.elm b/src/battlemap/src/Error.elm deleted file mode 100644 index 206088e..0000000 --- a/src/battlemap/src/Error.elm +++ /dev/null @@ -1,33 +0,0 @@ -module Error exposing (Type, Mode(..), new, to_string) - -type Mode = - IllegalAction - | Programming - | Unimplemented - | Networking - -type alias Type = - { - mode: Mode, - message: String - } - -new : Mode -> String -> Type -new mode str = - { - mode = mode, - message = str - } - -to_string : Type -> String -to_string e = - ( - (case e.mode of - IllegalAction -> "Request discarded: " - Programming -> "Error in the program (please report): " - Unimplemented -> "Update discarded due to unimplemented feature: " - Networking -> "Error while conversing with the server: " - ) - ++ e.message - ) - diff --git a/src/battlemap/src/Event.elm b/src/battlemap/src/Event.elm deleted file mode 100644 index 1a6f2e5..0000000 --- a/src/battlemap/src/Event.elm +++ /dev/null @@ -1,21 +0,0 @@ -module Event exposing (Type(..)) - -import Http - -import Battlemap.Direction -import Battlemap.Location - -import Character - -import UI - -type Type = - DirectionRequested Battlemap.Direction.Type - | TileSelected Battlemap.Location.Ref - | CharacterSelected Character.Ref - | TurnEnded - | ScaleChangeRequested Float - | TabSelected UI.Tab - | ServerReplied (Result Http.Error (List (List String))) - | DebugTeamSwitchRequest - | DebugLoadBattlemapRequest diff --git a/src/battlemap/src/Init.elm b/src/battlemap/src/Init.elm deleted file mode 100644 index e8b797a..0000000 --- a/src/battlemap/src/Init.elm +++ /dev/null @@ -1,29 +0,0 @@ -module Init exposing (init) --- Battlemap ------------------------------------------------------------------- - -import Model -import Event - -import Shim.Model - -import Send.LoadBattlemap - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -init : (Model.Type, (Cmd Event.Type)) -init = - let - model = (Shim.Model.generate) - in - ( - model, - (case (Send.LoadBattlemap.try model) of - (Just cmd) -> cmd - Nothing -> Cmd.none - ) - ) diff --git a/src/battlemap/src/Model.elm b/src/battlemap/src/Model.elm deleted file mode 100644 index 9798149..0000000 --- a/src/battlemap/src/Model.elm +++ /dev/null @@ -1,86 +0,0 @@ -module Model exposing - ( - Type, - State(..), - add_character, - get_state, - invalidate, - reset, - clear_error - ) - --- Elm ------------------------------------------------------------------------- -import Dict - --- Battlemap ------------------------------------------------------------------- -import Battlemap -import Battlemap.Location - -import UI - -import Error - -import Character - -import Query.CharacterTurn --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type State = - Default - | InspectingTile Battlemap.Location.Ref - | InspectingCharacter Character.Ref - -type alias Type = - { - state: State, - battlemap: Battlemap.Type, - characters: (Dict.Dict Character.Ref Character.Type), - error: (Maybe Error.Type), - controlled_team: Int, - player_id: String, - ui: UI.Type, - char_turn: Query.CharacterTurn - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -add_character : Type -> Character.Type -> Type -add_character model char = - {model | - characters = - (Dict.insert - (Character.get_ref char) - char - model.characters - ) - } - -get_state : Type -> State -get_state model = model.state - -reset : Type -> (Dict.Dict Character.Ref Character.Type) -> Type -reset model characters = - {model | - state = Default, - battlemap = (Battlemap.reset model.battlemap), - characters = characters, - error = Nothing, - ui = (UI.set_previous_action model.ui Nothing), - char_turn = (Query.CharacterTurn.new) - } - -invalidate : Type -> Error.Type -> Type -invalidate model err = - {model | - error = (Just err), - ui = (UI.set_displayed_tab model.ui UI.StatusTab) - } - -clear_error : Type -> Type -clear_error model = {model | error = Nothing} diff --git a/src/battlemap/src/Model/EndTurn.elm b/src/battlemap/src/Model/EndTurn.elm deleted file mode 100644 index fd0ec83..0000000 --- a/src/battlemap/src/Model/EndTurn.elm +++ /dev/null @@ -1,82 +0,0 @@ -module Model.EndTurn exposing (apply_to) - --- Elm ------------------------------------------------------------------------- -import Dict - --- Battlemap ------------------------------------------------------------------- -import Battlemap - -import Character - -import Error -import Event - -import Model - -import Send.CharacterTurn --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -make_it_so : Model.Type -> (Model.Type, (Cmd Event.Type)) -make_it_so model = - case (Battlemap.try_getting_navigator_location model.battlemap) of - (Just location) -> - case (Send.CharacterTurn.try model) of - (Just cmd) -> - ( - (Model.reset - model - (Dict.update - char_ref - (\maybe_char -> - case maybe_char of - (Just char) -> - (Just - (Character.set_enabled - (Character.set_location location char) - False - ) - ) - Nothing -> Nothing - ) - model.characters - ) - ), - cmd - ) - - Nothing -> - (model, Cmd.none) - - Nothing -> - ( - (Model.invalidate - model - (Error.new - Error.Programming - "EndTurn: model moving char, no navigator location." - ) - ), - Cmd.none - ) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -apply_to : Model.Type -> (Model.Type, (Cmd Event.Type)) -apply_to model = - case (Query.CharacterTurn.get_state model.char_turn) of - Query.CharacterTurn.MovedCharacter -> (make_it_so model) - Query.CharacterTurn.ChoseTarget -> (make_it_so model) - - _ -> - ( - (Model.invalidate - model - (Error.new - Error.IllegalAction - "This can only be done while moving a character." - ) - ), - Cmd.none - ) diff --git a/src/battlemap/src/Model/HandleServerReply.elm b/src/battlemap/src/Model/HandleServerReply.elm deleted file mode 100644 index 572fa0c..0000000 --- a/src/battlemap/src/Model/HandleServerReply.elm +++ /dev/null @@ -1,46 +0,0 @@ -module Model.HandleServerReply exposing (apply_to) - --- Battlemap ------------------------------------------------------------------- -import Model -import Error -import Event - -import Model.HandleServerReply.SetMap -import Model.HandleServerReply.AddChar - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -apply_command: (List String) -> Model.Type -> Model.Type -apply_command cmd model = - case - cmd - of - ["set_map", data] -> - (Model.HandleServerReply.SetMap.apply_to model data) - - ["add_char", data] -> - (Model.HandleServerReply.AddChar.apply_to model data) - - _ -> - (Model.invalidate - model - (Error.new - Error.Programming - ( - "Received invalid command from server:" - ++ (toString cmd) - ) - ) - ) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -apply_to : ( - Model.Type -> - (List (List String)) -> - (Model.Type, (Cmd Event.Type)) - ) -apply_to model serialized_commands = - ((List.foldl (apply_command) model serialized_commands), Cmd.none) diff --git a/src/battlemap/src/Model/HandleServerReply/AddChar.elm b/src/battlemap/src/Model/HandleServerReply/AddChar.elm deleted file mode 100644 index f5f30ba..0000000 --- a/src/battlemap/src/Model/HandleServerReply/AddChar.elm +++ /dev/null @@ -1,90 +0,0 @@ -module Model.HandleServerReply.AddChar exposing (apply_to) - --- Elm ------------------------------------------------------------------------- -import Json.Decode -import Json.Decode.Pipeline - --- Battlemap ------------------------------------------------------------------- -import Character - -import Error - -import Model - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias CharData = - { - id : String, - name : String, - icon : String, - portrait : String, - health : Int, - max_health : Int, - loc_x : Int, - loc_y : Int, - team : Int, - mov_pts : Int, - atk_rg : Int, - enabled : Bool - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -char_decoder : (Json.Decode.Decoder CharData) -char_decoder = - (Json.Decode.Pipeline.decode - CharData - |> (Json.Decode.Pipeline.required "id" Json.Decode.string) - |> (Json.Decode.Pipeline.required "name" Json.Decode.string) - |> (Json.Decode.Pipeline.required "icon" Json.Decode.string) - |> (Json.Decode.Pipeline.required "portrait" Json.Decode.string) - |> (Json.Decode.Pipeline.required "health" Json.Decode.int) - |> (Json.Decode.Pipeline.required "max_health" Json.Decode.int) - |> (Json.Decode.Pipeline.required "loc_x" Json.Decode.int) - |> (Json.Decode.Pipeline.required "loc_y" Json.Decode.int) - |> (Json.Decode.Pipeline.required "team" Json.Decode.int) - |> (Json.Decode.Pipeline.required "mov_pts" Json.Decode.int) - |> (Json.Decode.Pipeline.required "atk_rg" Json.Decode.int) - |> (Json.Decode.Pipeline.required "enabled" Json.Decode.bool) - ) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -apply_to : Model.Type -> String -> Model.Type -apply_to model serialized_char = - case - (Json.Decode.decodeString - char_decoder - serialized_char - ) - of - (Result.Ok char_data) -> - (Model.add_character - model - (Character.new - char_data.id - char_data.name - char_data.icon - char_data.portrait - char_data.health - char_data.max_health - {x = char_data.loc_x, y = char_data.loc_y} - char_data.team - char_data.mov_pts - char_data.atk_rg - char_data.enabled - ) - ) - - (Result.Err msg) -> - (Model.invalidate - model - (Error.new - Error.Programming - ("Could not deserialize character: " ++ msg) - ) - ) diff --git a/src/battlemap/src/Model/HandleServerReply/SetMap.elm b/src/battlemap/src/Model/HandleServerReply/SetMap.elm deleted file mode 100644 index e815093..0000000 --- a/src/battlemap/src/Model/HandleServerReply/SetMap.elm +++ /dev/null @@ -1,71 +0,0 @@ -module Model.HandleServerReply.SetMap exposing (apply_to) - --- Elm ------------------------------------------------------------------------- -import Dict -import Json.Decode - --- Battlemap ------------------------------------------------------------------- -import Battlemap -import Battlemap.Tile - -import Data.Tile - -import Model - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias MapData = - { - width : Int, - height : Int, - content : (List Int) - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -deserialize_tile : Int -> Int -> Int -> Battlemap.Tile.Type -deserialize_tile map_width index id = - (Battlemap.Tile.new - (index % map_width) - (index // map_width) - (Data.Tile.get_icon id) - (Data.Tile.get_cost id) - ) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -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.int) - ) - ) - serialized_map - ) - of - (Result.Ok map_data) -> - (Model.reset - {model | - battlemap = - (Battlemap.new - map_data.width - map_data.height - (List.indexedMap - (deserialize_tile map_data.width) - map_data.content - ) - ) - } - (Dict.empty) - ) - - _ -> model diff --git a/src/battlemap/src/Model/RequestDirection.elm b/src/battlemap/src/Model/RequestDirection.elm deleted file mode 100644 index 4e52897..0000000 --- a/src/battlemap/src/Model/RequestDirection.elm +++ /dev/null @@ -1,71 +0,0 @@ -module Model.RequestDirection exposing (apply_to) - --- Elm ------------------------------------------------------------------------- -import Dict - --- Battlemap ------------------------------------------------------------------- -import Battlemap -import Battlemap.Direction - -import Character - -import UI - -import Model -import Error - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -make_it_so : ( - Model.Type -> - Character.Ref -> - Battlemap.Direction.Type -> - Model.Type - ) -make_it_so model char_ref dir = - let - new_bmap = - (Battlemap.try_adding_step_to_navigator - model.battlemap - (Dict.values model.characters) - dir - ) - in - case new_bmap of - (Just bmap) -> - {model | - battlemap = bmap, - ui = - (UI.set_previous_action - model.ui - (Just UI.UsedManualControls) - ) - } - - Nothing -> - (Model.invalidate - model - (Error.new - Error.IllegalAction - "Unreachable/occupied tile." - ) - ) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -apply_to : Model.Type -> Battlemap.Direction.Type -> Model.Type -apply_to model dir = - case model.controlled_character of - (Just char_ref) -> - (make_it_so model char_ref dir) - - _ -> - (Model.invalidate - model - (Error.new - Error.IllegalAction - "This can only be done while moving a character." - ) - ) diff --git a/src/battlemap/src/Model/SelectCharacter.elm b/src/battlemap/src/Model/SelectCharacter.elm deleted file mode 100644 index 619a729..0000000 --- a/src/battlemap/src/Model/SelectCharacter.elm +++ /dev/null @@ -1,110 +0,0 @@ -module Model.SelectCharacter exposing (apply_to) - --- Elm ------------------------------------------------------------------------- -import Dict - --- Battlemap ------------------------------------------------------------------- -import Battlemap -import Battlemap.Direction - -import Character - -import UI - -import Model -import Model.RequestDirection - -import Error - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -autopilot : Battlemap.Direction.Type -> Model.Type -> Model.Type -autopilot dir model = - (Model.RequestDirection.apply_to model dir) - -attack_character : ( - Model.Type -> - Character.Ref -> - Character.Ref -> - Character.Type -> - Model.Type - ) -attack_character model main_char_id target_char_id target_char = - {model | - targets = [target_char_id], - ui = (UI.set_previous_action model.ui Nothing) - } - -select_character : ( - Model.Type -> - Character.Ref -> - Character.Type -> - Model.Type - ) -select_character model target_char_id target_char = - if ((Character.is_enabled target_char)) - then - {model | - state = Model.Default, - controlled_character = (Just target_char_id), - ui = (UI.set_previous_action model.ui Nothing), - battlemap = - (Battlemap.set_navigator - (Character.get_location target_char) - (Character.get_movement_points target_char) - (Character.get_attack_range target_char) - (Dict.values model.characters) - model.battlemap - ) - } - else - {model | - ui = - (UI.set_previous_action - model.ui - (Just (UI.SelectedCharacter target_char_id)) - ) - } - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -apply_to : Model.Type -> Character.Ref -> Model.Type -apply_to model target_char_id = - if - ( - (UI.get_previous_action model.ui) - == - (Just (UI.SelectedCharacter target_char_id)) - ) - then - case (Dict.get target_char_id model.characters) of - (Just target_char) -> - case model.controlled_character of - (Just main_char_id) -> - (attack_character - model - main_char_id - target_char_id - target_char - ) - - _ -> (select_character model target_char_id target_char) - - Nothing -> - (Model.invalidate - model - (Error.new - Error.Programming - "SelectCharacter: Unknown char selected." - ) - ) - else - {model | - ui = - (UI.set_previous_action - model.ui - (Just (UI.SelectedCharacter target_char_id)) - ) - } diff --git a/src/battlemap/src/Model/SelectTile.elm b/src/battlemap/src/Model/SelectTile.elm deleted file mode 100644 index 5ce3c3c..0000000 --- a/src/battlemap/src/Model/SelectTile.elm +++ /dev/null @@ -1,110 +0,0 @@ -module Model.SelectTile exposing (apply_to) - --- Battlemap ------------------------------------------------------------------- -import Battlemap -import Battlemap.Direction -import Battlemap.Location - -import Character - -import Event - -import Model.RequestDirection -import Model.EndTurn - -import UI -import Model - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -autopilot : Battlemap.Direction.Type -> Model.Type -> Model.Type -autopilot dir model = - (Model.RequestDirection.apply_to model dir) - -go_to_tile : ( - Model.Type -> - Character.Ref -> - Battlemap.Location.Ref -> - (Model.Type, (Cmd Event.Type)) - ) -go_to_tile model char_ref loc_ref = - case (Battlemap.try_getting_navigator_location model.battlemap) of - (Just nav_loc) -> - if (loc_ref == (Battlemap.Location.get_ref nav_loc)) - then - -- We are already there. - if - ( - (UI.get_previous_action model.ui) - == - (Just (UI.SelectedLocation loc_ref)) - ) - then - -- And we just clicked on that tile. - (Model.EndTurn.apply_to model) - else - -- And we didn't just click on that tile. - ( - {model | - ui = - (UI.set_previous_action - model.ui - (Just (UI.SelectedLocation loc_ref)) - ) - }, - Cmd.none - ) - else - -- We have to try getting there. - case - (Battlemap.try_getting_navigator_path_to - model.battlemap - loc_ref - ) - of - (Just path) -> - let - new_model = - (List.foldr - (autopilot) - {model | - battlemap = - (Battlemap.clear_navigator_path - model.battlemap - ) - } - path - ) - in - ( - {new_model | - ui = - (UI.set_previous_action - new_model.ui - (Just (UI.SelectedLocation loc_ref)) - ) - }, - Cmd.none - ) - - Nothing -> -- Clicked outside of the range indicator - ((Model.reset model model.characters), Cmd.none) - - Nothing -> -- Clicked outside of the range indicator - ((Model.reset model model.characters), Cmd.none) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -apply_to : ( - Model.Type -> - Battlemap.Location.Ref -> - (Model.Type, (Cmd Event.Type)) - ) -apply_to model loc_ref = - case model.controlled_character of - (Just char_ref) -> - (go_to_tile model char_ref loc_ref) - - _ -> ({model | state = (Model.InspectingTile loc_ref)}, Cmd.none) diff --git a/src/battlemap/src/Move.elm b/src/battlemap/src/Move.elm new file mode 100644 index 0000000..945d29f --- /dev/null +++ b/src/battlemap/src/Move.elm @@ -0,0 +1,160 @@ +module ???.MoveNavigator exposing (to) + +-- TODO: This should not belong to the Struct.Navigator module, as it's actually +-- a module used to manipulate an existing navigator in a certain way. + +import Set +import List + +import Struct.Battlemap +import Struct.Direction +import Struct.Location +import Struct.Tile +import Struct.Navigator + +import Character + +import Util.List + +can_move_to_new_tile : ( + Struct.Navigator.Type -> + Struct.Battlemap.Type -> + Struct.Location.Type -> + Bool + ) +can_move_to_new_tile nav battlemap next_location = + ( + (nav.remaining_points > 0) + && (Struct.Battlemap.has_location battlemap next_location) + && (nav.current_location /= next_location) + && + (not + (Set.member + (Struct.Location.get_ref next_location) + nav.visited_locations + ) + ) + ) + +battlemap_move_to : ( + Struct.Battlemap.Type -> + Struct.Location.Type -> + Struct.Direction.Type -> + Struct.Location.Type -> + Struct.Battlemap.Type + ) +battlemap_move_to battlemap current_loc dir next_loc = + (Struct.Battlemap.apply_to_tile_unsafe + (Struct.Battlemap.apply_to_tile_unsafe + battlemap + current_loc + (Struct.Tile.set_direction dir) + ) + next_loc + (Struct.Tile.set_direction dir) + ) + +navigator_move_to : ( + Struct.Navigator.Type -> + Struct.Direction.Type -> + Struct.Location.Type -> + Struct.Navigator.Type + ) +navigator_move_to nav dir next_loc = + {nav | + current_location = next_loc, + visited_locations = + (Set.insert + (Struct.Location.get_ref nav.current_location) + nav.visited_locations + ), + previous_directions = (dir :: nav.previous_directions), + remaining_points = (nav.remaining_points - 1) + } + +battlemap_backtrack : ( + Struct.Battlemap.Type -> + Struct.Location.Type -> + Struct.Battlemap.Type + ) +battlemap_backtrack battlemap current_loc = + (Struct.Battlemap.apply_to_tile_unsafe + battlemap + current_loc + (Struct.Tile.set_direction + Struct.Direction.None + ) + ) + +navigator_backtrack : ( + Struct.Navigator.Type -> + Struct.Location.Type -> + (List Struct.Direction.Type) -> + Struct.Navigator.Type + ) +navigator_backtrack nav next_loc prev_dir_tail = + {nav | + current_location = next_loc, + visited_locations = + (Set.remove + (Struct.Location.get_ref next_loc) + nav.visited_locations + ), + previous_directions = prev_dir_tail, + remaining_points = (nav.remaining_points + 1) + } + +to : ( + Struct.Battlemap.Type -> + Struct.Navigator.Type -> + Struct.Direction.Type -> + (List Character.Type) -> + (Struct.Battlemap.Type, Struct.Navigator.Type) + ) +to battlemap nav dir char_list = + let + next_location = (Struct.Location.neighbor nav.current_location dir) + is_occupied = + (List.any + (\c -> ((Character.get_location c) == next_location)) + char_list + ) + in + if (not is_occupied) + then + if (can_move_to_new_tile nav battlemap next_location) + then + ( + (battlemap_move_to + battlemap + nav.current_location + dir + next_location + ), + (navigator_move_to + nav + dir + next_location + ) + ) + else + case (Util.List.pop nav.previous_directions) of + Nothing -> (battlemap, nav) + (Just (head, tail)) -> + if (head == (Struct.Direction.opposite_of dir)) + then + ( + (battlemap_backtrack + battlemap + nav.current_location + ), + (navigator_backtrack + nav + next_location + tail + ) + ) + else + (battlemap, nav) + else + (battlemap, nav) diff --git a/src/battlemap/src/Query/CharacterTurn.elm b/src/battlemap/src/Query/CharacterTurn.elm deleted file mode 100644 index ec7efa0..0000000 --- a/src/battlemap/src/Query/CharacterTurn.elm +++ /dev/null @@ -1,115 +0,0 @@ -module Query.CharacterTurn exposing - ( - Type, - State(..), - new, - try_getting_controlled_character, - set_controlled_character, - get_state, - get_path, - set_path, - add_target, - remove_target, - get_targets - ) - --- Elm ------------------------------------------------------------------------- -import List - --- Battlemap ------------------------------------------------------------------- -import Battlemap -import Battlemap.Direction - -import UI - -import Error - -import Character - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type State = - Default - | SelectedCharacter - | MovedCharacter - | ChoseTarget - -type alias Type = - { - state : State, - controlled_character : (Maybe Character.Ref), - path : (List Battlemap.Direction.Type), - targets : (List Character.Ref) - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -new : Type -new = - { - state = Default, - controlled_character = Nothing, - path = [], - targets = [] - } - -try_getting_controlled_character : Type -> (Maybe Character.Ref) -try_getting_controlled_character ct = ct.controlled_character - -set_controlled_character : Type -> Character.Ref -> Type -set_controlled_character ct char_ref = - { - state = SelectedCharacter, - controlled_character = (Just char_ref), - path = [], - targets = [] - } - -get_state : Type -> State -get_state ct = ct.state - -get_path : Type -> (List Battlemap.Direction.Type) -get_path ct = ct.path - -set_path : Type -> (List Battlemap.Direction.Type) -> Type -set_path ct path = - {ct | - state = MovedCharacter, - path = path, - targets = [] - } - -add_target : Type -> Character.Ref -> Type -add_target ct target_ref = - {ct | - state = ChoseTarget, - targets = (List.append ct.targets [target_ref]) - } - -remove_target : Type -> Int -> Type -remove_target ct i = - let - new_targets = (List.drop i ct.list) - in - case new_targets of - [] -> - {ct | - state = MovedCharacter, - path = path, - targets = [] - } - - _ -> - {ct | - state = ChoseTarget, - targets = new_targets - } - -get_targets : Type -> (List Character.Ref) -get_targets ct = ct.targets diff --git a/src/battlemap/src/Send.elm b/src/battlemap/src/Send.elm deleted file mode 100644 index 3288050..0000000 --- a/src/battlemap/src/Send.elm +++ /dev/null @@ -1,50 +0,0 @@ -module Send exposing (Reply, try_sending) - --- 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/Query/CharacterTurn.elm b/src/battlemap/src/Send/Query/CharacterTurn.elm new file mode 100644 index 0000000..ec7efa0 --- /dev/null +++ b/src/battlemap/src/Send/Query/CharacterTurn.elm @@ -0,0 +1,115 @@ +module Query.CharacterTurn exposing + ( + Type, + State(..), + new, + try_getting_controlled_character, + set_controlled_character, + get_state, + get_path, + set_path, + add_target, + remove_target, + get_targets + ) + +-- Elm ------------------------------------------------------------------------- +import List + +-- Battlemap ------------------------------------------------------------------- +import Battlemap +import Battlemap.Direction + +import UI + +import Error + +import Character + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type State = + Default + | SelectedCharacter + | MovedCharacter + | ChoseTarget + +type alias Type = + { + state : State, + controlled_character : (Maybe Character.Ref), + path : (List Battlemap.Direction.Type), + targets : (List Character.Ref) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Type +new = + { + state = Default, + controlled_character = Nothing, + path = [], + targets = [] + } + +try_getting_controlled_character : Type -> (Maybe Character.Ref) +try_getting_controlled_character ct = ct.controlled_character + +set_controlled_character : Type -> Character.Ref -> Type +set_controlled_character ct char_ref = + { + state = SelectedCharacter, + controlled_character = (Just char_ref), + path = [], + targets = [] + } + +get_state : Type -> State +get_state ct = ct.state + +get_path : Type -> (List Battlemap.Direction.Type) +get_path ct = ct.path + +set_path : Type -> (List Battlemap.Direction.Type) -> Type +set_path ct path = + {ct | + state = MovedCharacter, + path = path, + targets = [] + } + +add_target : Type -> Character.Ref -> Type +add_target ct target_ref = + {ct | + state = ChoseTarget, + targets = (List.append ct.targets [target_ref]) + } + +remove_target : Type -> Int -> Type +remove_target ct i = + let + new_targets = (List.drop i ct.list) + in + case new_targets of + [] -> + {ct | + state = MovedCharacter, + path = path, + targets = [] + } + + _ -> + {ct | + state = ChoseTarget, + targets = new_targets + } + +get_targets : Type -> (List Character.Ref) +get_targets ct = ct.targets diff --git a/src/battlemap/src/Send/Send.elm b/src/battlemap/src/Send/Send.elm new file mode 100644 index 0000000..3288050 --- /dev/null +++ b/src/battlemap/src/Send/Send.elm @@ -0,0 +1,50 @@ +module Send exposing (Reply, try_sending) + +-- 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/Struct/Battlemap.elm b/src/battlemap/src/Struct/Battlemap.elm new file mode 100644 index 0000000..bd1f3b0 --- /dev/null +++ b/src/battlemap/src/Struct/Battlemap.elm @@ -0,0 +1,122 @@ +module Struct.Battlemap exposing + ( + Type, + empty, + new, + get_width, + get_height, + get_tiles, + try_getting_tile_at + ) + +-- Elm ------------------------------------------------------------------------- +import Array + +-- Battlemap ------------------------------------------------------------------- +import Struct.Character +import Struct.Navigator +import Struct.Tile +import Struct.Direction +import Struct.Location + +import Constants.Movement + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + width: Int, + height: Int, + content: (Array.Array Struct.Tile.Type) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +location_to_index : Type -> Struct.Location.Type -> Int +location_to_index bmap loc = + ((loc.y * bmap.width) + loc.x) + +has_location : Type -> Struct.Location.Type -> Bool +has_location bmap loc = + ( + (loc.x >= 0) + && (loc.y >= 0) + && (loc.x < bmap.width) + && (loc.y < bmap.height) + ) + +tile_cost_function : ( + Type -> + Struct.Location.Type -> + (List Struct.Character.Type) -> + Struct.Location.Type -> + Int + ) +tile_cost_function bmap start_loc char_list loc = + if + ( + (Struct.Location.get_ref start_loc) + == + (Struct.Location.get_ref loc) + ) + then + 0 + else + if (has_location bmap loc) + then + case + (Array.get (location_to_index bmap loc) bmap.content) + of + (Just tile) -> + if + (List.any + (\c -> ((Struct.Character.get_location c) == loc)) + char_list + ) + then + Constants.Movement.cost_when_occupied_tile + else + (Struct.Tile.get_cost tile) + + Nothing -> Constants.Movement.cost_when_out_of_bounds + else + Constants.Movement.cost_when_out_of_bounds + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_width : Type -> Int +get_width bmap = bmap.width + +get_height : Type -> Int +get_height bmap = bmap.height + +get_tiles : Type -> (Array.Array Struct.Tile.Type) +get_tiles bmap = bmap.content + +empty : Type +empty = + { + width = 0, + height = 0, + content = (Array.empty), + navigator = Nothing + } + +new : Int -> Int -> (List Struct.Tile.Type) -> Type +new width height tiles = + { + width = width, + height = height, + content = (Array.fromList tiles) + } + +try_getting_tile_at : ( + Type -> + Struct.Location.Type -> + (Maybe Struct.Tile.Type) + ) +try_getting_tile_at bmap loc = + (Array.get (location_to_index bmap loc) bmap.content) diff --git a/src/battlemap/src/Struct/Character.elm b/src/battlemap/src/Struct/Character.elm new file mode 100644 index 0000000..1d5b269 --- /dev/null +++ b/src/battlemap/src/Struct/Character.elm @@ -0,0 +1,118 @@ +module Struct.Character exposing + ( + Type, + Ref, + new, + get_ref, + get_team, + get_icon_id, + get_portrait_id, + get_current_health, + get_max_health, + get_location, + set_location, + get_movement_points, + get_attack_range, + is_enabled, + set_enabled + ) + +-- Battlemap ------------------------------------------------------------------- +import Struct.Location + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + id : String, + name : String, + icon : String, + portrait : String, + location : Struct.Location.Type, + health : Int, + max_health : Int, + team : Int, + movement_points : Int, + atk_dist : Int, + enabled : Bool + } + +type alias Ref = String + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : ( + String -> -- id + String -> -- name + String -> -- icon + String -> -- portrait + Int -> -- health + Int -> -- max_health + Struct.Location.Type -> -- location + Int -> -- team + Int -> -- movement_points + Int -> -- atk_dist + Bool -> -- enabled + Type + ) +new + id name icon portrait + health max_health + location + team movement_points atk_dist + enabled = + { + id = id, + name = name, + icon = icon, + portrait = portrait, + health = health, + max_health = max_health, + location = location, + team = team, + movement_points = movement_points, + atk_dist = atk_dist, + enabled = enabled + } + +get_ref : Type -> Ref +get_ref c = c.id + +get_team : Type -> Int +get_team c = c.team + +get_icon_id : Type -> String +get_icon_id c = c.icon + +get_portrait_id : Type -> String +get_portrait_id c = c.portrait + +get_current_health : Type -> Int +get_current_health c = c.health + +get_max_health : Type -> Int +get_max_health c = c.max_health + +get_location : Type -> Struct.Location.Type +get_location t = t.location + +set_location : Struct.Location.Type -> Type -> Type +set_location location char = {char | location = location} + +get_movement_points : Type -> Int +get_movement_points char = char.movement_points + +get_attack_range : Type -> Int +get_attack_range char = char.atk_dist + +is_enabled : Type -> Bool +is_enabled char = char.enabled + +set_enabled : Type -> Bool -> Type +set_enabled char enabled = {char | enabled = enabled} diff --git a/src/battlemap/src/Struct/Direction.elm b/src/battlemap/src/Struct/Direction.elm new file mode 100644 index 0000000..c8eb28e --- /dev/null +++ b/src/battlemap/src/Struct/Direction.elm @@ -0,0 +1,37 @@ +module Struct.Direction exposing (Type(..), opposite_of, to_string) + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Type = + None + | Left + | Right + | Up + | Down + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +opposite_of : Type -> Type +opposite_of d = + case d of + Left -> Right + Right -> Left + Up -> Down + Down -> Up + None -> None + +to_string : Type -> String +to_string dir = + case dir of + Right -> "R" + Left -> "L" + Up -> "U" + Down -> "D" + None -> "N" + diff --git a/src/battlemap/src/Struct/Error.elm b/src/battlemap/src/Struct/Error.elm new file mode 100644 index 0000000..3607d1d --- /dev/null +++ b/src/battlemap/src/Struct/Error.elm @@ -0,0 +1,43 @@ +module Struct.Error exposing (Type, Mode(..), new, to_string) + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Mode = + IllegalAction + | Programming + | Unimplemented + | Networking + +type alias Type = + { + mode: Mode, + message: String + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Mode -> String -> Type +new mode str = + { + mode = mode, + message = str + } + +to_string : Type -> String +to_string e = + ( + (case e.mode of + IllegalAction -> "Request discarded: " + Programming -> "Error in the program (please report): " + Unimplemented -> "Update discarded due to unimplemented feature: " + Networking -> "Error while conversing with the server: " + ) + ++ e.message + ) + diff --git a/src/battlemap/src/Struct/Event.elm b/src/battlemap/src/Struct/Event.elm new file mode 100644 index 0000000..dadc11d --- /dev/null +++ b/src/battlemap/src/Struct/Event.elm @@ -0,0 +1,24 @@ +module Struct.Event exposing (Type(..)) + +-- Elm ------------------------------------------------------------------------- +import Http + +-- Battlemap ------------------------------------------------------------------- +import Struct.Direction +import Struct.Location +import Struct.Character +import Struct.UI + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Type = + DirectionRequested Struct.Direction.Type + | TileSelected Struct.Location.Ref + | CharacterSelected Struct.Character.Ref + | TurnEnded + | ScaleChangeRequested Float + | TabSelected Struct.UI.Tab + | ServerReplied (Result Http.Error (List (List String))) + | DebugTeamSwitchRequest + | DebugLoadBattlemapRequest diff --git a/src/battlemap/src/Struct/Location.elm b/src/battlemap/src/Struct/Location.elm new file mode 100644 index 0000000..ad9a811 --- /dev/null +++ b/src/battlemap/src/Struct/Location.elm @@ -0,0 +1,49 @@ +module Struct.Location exposing (..) + +-- Elm ------------------------------------------------------------------------- + +-- Battlemap ------------------------------------------------------------------- +import Struct.Direction + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + x : Int, + y : Int + } + +type alias Ref = (Int, Int) + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +neighbor : Type -> Struct.Direction.Type -> Type +neighbor loc dir = + case dir of + Struct.Direction.Right -> {loc | x = (loc.x + 1)} + Struct.Direction.Left -> {loc | x = (loc.x - 1)} + Struct.Direction.Up -> {loc | y = (loc.y - 1)} + Struct.Direction.Down -> {loc | y = (loc.y + 1)} + Struct.Direction.None -> loc + +get_ref : Type -> Ref +get_ref l = + (l.x, l.y) + +from_ref : Ref -> Type +from_ref (x, y) = + {x = x, y = y} + +dist : Type -> Type -> Int +dist loc_a loc_b = + ( + (abs (loc_a.x - loc_b.x)) + + + (abs (loc_a.y - loc_b.y)) + ) diff --git a/src/battlemap/src/Struct/Marker.elm b/src/battlemap/src/Struct/Marker.elm new file mode 100644 index 0000000..dd884e2 --- /dev/null +++ b/src/battlemap/src/Struct/Marker.elm @@ -0,0 +1,8 @@ +module Struct.Marker exposing (Type(..)) + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Type = + CanAttack + | CanGoTo diff --git a/src/battlemap/src/Struct/Model.elm b/src/battlemap/src/Struct/Model.elm new file mode 100644 index 0000000..dc1a13d --- /dev/null +++ b/src/battlemap/src/Struct/Model.elm @@ -0,0 +1,85 @@ +module Struct.Model exposing + ( + Type, + State(..), + add_character, + get_state, + invalidate, + reset, + clear_error + ) + +-- Elm ------------------------------------------------------------------------- +import Dict + +-- Battlemap ------------------------------------------------------------------- +import Struct.Battlemap +import Struct.Location + +import Struct.UI + +import Struct.Error + +import Struct.Character + +import Query.CharacterTurn +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type State = + Default + | InspectingTile Struct.Location.Ref + | InspectingCharacter Struct.Character.Ref + +type alias Type = + { + state: State, + battlemap: Struct.Battlemap.Type, + characters: (Dict.Dict Struct.Character.Ref Struct.Character.Type), + error: (Maybe Struct.Error.Type), + controlled_team: Int, + player_id: String, + ui: Struct.UI.Type, + char_turn: Query.CharacterTurn + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +add_character : Type -> Struct.Character.Type -> Type +add_character model char = + {model | + characters = + (Dict.insert + (Struct.Character.get_ref char) + char + model.characters + ) + } + +get_state : Type -> State +get_state model = model.state + +reset : Type -> (Dict.Dict Struct.Character.Ref Struct.Character.Type) -> Type +reset model characters = + {model | + state = Default, + characters = characters, + error = Nothing, + ui = (Struct.UI.set_previous_action model.ui Nothing), + char_turn = (Query.CharacterTurn.new) + } + +invalidate : Type -> Struct.Error.Type -> Type +invalidate model err = + {model | + error = (Just err), + ui = (Struct.UI.set_displayed_tab model.ui Struct.UI.StatusTab) + } + +clear_error : Type -> Type +clear_error model = {model | error = Nothing} diff --git a/src/battlemap/src/Struct/Navigator.elm b/src/battlemap/src/Struct/Navigator.elm new file mode 100644 index 0000000..56ef255 --- /dev/null +++ b/src/battlemap/src/Struct/Navigator.elm @@ -0,0 +1,159 @@ +module Struct.Navigator exposing + ( + Type, + Summary, + new, + get_current_location, + get_starting_location, + get_remaining_points, + get_range_markers, + get_path, + get_summary, + clear_path, + try_adding_step, + try_getting_path_to + ) +-- Elm ------------------------------------------------------------------------- +import Dict + +-- Battlemap ------------------------------------------------------------------- +import Struct.Location +import Struct.Direction +import Struct.Marker +import Struct.Path +import Struct.RangeIndicator + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + starting_location: Struct.Location.Type, + movement_dist: Int, + attack_dist: Int, + path: Struct.Path.Type, + range_indicators: + (Dict.Dict + Struct.Location.Ref + Struct.RangeIndicator.Type + ) + } + +type alias Summary = + { + starting_location: Struct.Location.Type, + path: (List Struct.Direction.Type), + markers: (List (Struct.Location.Ref, Struct.Marker.Type)) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : ( + Struct.Location.Type -> + Int -> + Int -> + (Struct.Location.Type -> Int) -> + Type + ) +new start_loc mov_dist atk_dist cost_fun = + { + starting_location = start_loc, + movement_dist = mov_dist, + attack_dist = atk_dist, + path = (Struct.Path.new start_loc mov_dist), + range_indicators = + (Struct.RangeIndicator.generate + start_loc + mov_dist + atk_dist + (cost_fun) + ) + } + +get_current_location : Type -> Struct.Location.Type +get_current_location navigator = + (Struct.Path.get_current_location navigator.path) + +get_starting_location : Type -> Struct.Location.Type +get_starting_location navigator = navigator.starting_location + +get_remaining_points : Type -> Int +get_remaining_points navigator = + (Struct.Path.get_remaining_points navigator.path) + +get_range_markers : ( + Type -> + (List + (Struct.Location.Ref, Struct.RangeIndicator.Type) + ) + ) +get_range_markers navigator = (Dict.toList navigator.range_indicators) + +get_path : Type -> (List Struct.Direction.Type) +get_path navigator = (Struct.Path.get_summary navigator.path) + +get_summary : Type -> Summary +get_summary navigator = + { + starting_location = navigator.starting_location, + path = (Struct.Path.get_summary navigator.path), + markers = + (List.map + (\(loc, range_indicator) -> + ( + loc, + (Struct.RangeIndicator.get_marker + range_indicator + ) + ) + ) + (Dict.toList + navigator.range_indicators + ) + ) + } + +clear_path : Type -> Type +clear_path navigator = + {navigator | + path = + (Struct.Path.new + navigator.starting_location + navigator.movement_dist + ) + } + +try_adding_step : ( + Type -> + Struct.Direction.Type -> + (Struct.Location.Type -> Int) -> + (Maybe Type) + ) +try_adding_step navigator dir cost_fun = + case + (Struct.Path.try_following_direction + cost_fun + (Just navigator.path) + dir + ) + of + (Just path) -> (Just {navigator | path = path}) + Nothing -> Nothing + +try_getting_path_to : ( + Type -> + Struct.Location.Ref -> + (Maybe (List Struct.Direction.Type)) + ) +try_getting_path_to navigator loc_ref = + case (Dict.get loc_ref navigator.range_indicators) of + (Just target) -> + (Just (Struct.RangeIndicator.get_path target)) + + Nothing -> Nothing + diff --git a/src/battlemap/src/Struct/Path.elm b/src/battlemap/src/Struct/Path.elm new file mode 100644 index 0000000..ba568c3 --- /dev/null +++ b/src/battlemap/src/Struct/Path.elm @@ -0,0 +1,173 @@ +module Struct.Path exposing + ( + Type, + new, + get_current_location, + get_remaining_points, + get_summary, + try_following_direction + ) + +-- Elm ------------------------------------------------------------------------- +import Set + +-- Battlemap ------------------------------------------------------------------- +import Struct.Direction +import Struct.Location + +import Util.List + +import Constants.Movement + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + current_location : Struct.Location.Type, + visited_locations : (Set.Set Struct.Location.Ref), + previous_directions : (List Struct.Direction.Type), + previous_points : (List Int), + remaining_points : Int + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +has_been_to : ( + Type -> + Struct.Location.Type -> + Bool + ) +has_been_to path location = + ( + (path.current_location == location) + || + (Set.member + (Struct.Location.get_ref location) + path.visited_locations + ) + ) + +try_moving_to : ( + Type -> + Struct.Direction.Type -> + Struct.Location.Type -> + Int -> + (Maybe Type) + ) +try_moving_to path dir next_loc cost = + let + remaining_points = (path.remaining_points - cost) + in + if (remaining_points >= 0) + then + (Just + {path | + current_location = next_loc, + visited_locations = + (Set.insert + (Struct.Location.get_ref path.current_location) + path.visited_locations + ), + previous_directions = (dir :: path.previous_directions), + previous_points = + (path.remaining_points :: path.previous_points), + remaining_points = remaining_points + } + ) + else + Nothing + +try_backtracking_to : ( + Type -> + Struct.Direction.Type -> + Struct.Location.Type -> + (Maybe Type) + ) +try_backtracking_to path dir location = + case + ( + (Util.List.pop path.previous_directions), + (Util.List.pop path.previous_points) + ) + of + ( + (Just (prev_dir_head, prev_dir_tail)), + (Just (prev_pts_head, prev_pts_tail)) + ) -> + if (prev_dir_head == (Struct.Direction.opposite_of dir)) + then + (Just + {path | + current_location = location, + visited_locations = + (Set.remove + (Struct.Location.get_ref location) + path.visited_locations + ), + previous_directions = prev_dir_tail, + previous_points = prev_pts_tail, + remaining_points = prev_pts_head + } + ) + else + Nothing + (_, _) -> + Nothing + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +new : Struct.Location.Type -> Int -> Type +new start points = + { + current_location = start, + visited_locations = Set.empty, + previous_directions = [], + previous_points = [], + remaining_points = points + } + +get_current_location : Type -> Struct.Location.Type +get_current_location path = path.current_location + +get_remaining_points : Type -> Int +get_remaining_points path = path.remaining_points + +get_summary : Type -> (List Struct.Direction.Type) +get_summary path = path.previous_directions + +try_following_direction : ( + (Struct.Location.Type -> Int) -> + (Maybe Type) -> + Struct.Direction.Type -> + (Maybe Type) + ) +try_following_direction cost_fun maybe_path dir = + case maybe_path of + (Just path) -> + let + next_location = + (Struct.Location.neighbor + path.current_location + dir + ) + next_location_cost = (cost_fun next_location) + in + if (next_location_cost <= Constants.Movement.max_points) + then + if (has_been_to path next_location) + then + (try_backtracking_to path dir next_location) + else + (try_moving_to + path + dir + next_location + next_location_cost + ) + else + Nothing + Nothing -> Nothing diff --git a/src/battlemap/src/Struct/RangeIndicator.elm b/src/battlemap/src/Struct/RangeIndicator.elm new file mode 100644 index 0000000..90328a3 --- /dev/null +++ b/src/battlemap/src/Struct/RangeIndicator.elm @@ -0,0 +1,240 @@ +module Struct.RangeIndicator exposing + ( + Type, + generate, + get_marker, + get_path + ) + +-- Elm ------------------------------------------------------------------------- +import Dict +import List + +-- Battlemap ------------------------------------------------------------------- +import Struct.Direction +import Struct.Location +import Struct.Marker + +import Constants.Movement + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + distance: Int, + range: Int, + path: (List Struct.Direction.Type), + marker: Struct.Marker.Type + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_closest : ( + Int -> + Struct.Location.Ref -> + Type -> + (Struct.Location.Ref, Type) -> + (Struct.Location.Ref, Type) + ) +get_closest dist ref indicator (prev_ref, prev_indicator) = + if + ( + (indicator.distance < prev_indicator.distance) + || + ( + (indicator.distance > dist) + && (prev_indicator.distance > dist) + && (indicator.range < prev_indicator.range) + ) + ) + then + (ref, indicator) + else + (prev_ref, prev_indicator) + +is_closer : Int -> Int -> Type -> Bool +is_closer new_dist new_range neighbor = + ( + (new_dist < neighbor.distance) + || + ( + (neighbor.distance > new_dist) + && (new_range < neighbor.range) + ) + ) + + +handle_neighbors : ( + Type -> + Struct.Location.Type -> + Int -> + Int -> + (Dict.Dict Struct.Location.Ref Type) -> + (Struct.Location.Type -> Int) -> + Struct.Direction.Type -> + (Dict.Dict Struct.Location.Ref Type) -> + (Dict.Dict Struct.Location.Ref Type) + ) +handle_neighbors src_indicator src_loc dist range results cost_fun dir rem = + let + neighbor_loc = (Struct.Location.neighbor src_loc dir) + in + case (Dict.get (Struct.Location.get_ref neighbor_loc) results) of + (Just _) -> rem + + Nothing -> + let + node_cost = (cost_fun neighbor_loc) + new_dist = (src_indicator.distance + node_cost) + new_range = (src_indicator.range + 1) + in + if + ( + ( + case + (Dict.get + (Struct.Location.get_ref neighbor_loc) + rem + ) + of + (Just neighbor) -> + (is_closer new_dist new_range neighbor) + + Nothing -> + True + ) + && + (node_cost /= Constants.Movement.cost_when_out_of_bounds) + && + ( + (new_dist <= dist) + || + (new_range <= range) + ) + ) + then + (Dict.insert + (Struct.Location.get_ref neighbor_loc) + ( + if (new_dist > dist) + then + { + distance = (dist + 1), + range = new_range, + path = (dir :: src_indicator.path), + marker = Struct.Marker.CanAttack + } + else + { + distance = new_dist, + range = 0, + path = (dir :: src_indicator.path), + marker = Struct.Marker.CanGoTo + } + ) + rem + ) + else + rem + +search : ( + (Dict.Dict Struct.Location.Ref Type) -> + (Dict.Dict Struct.Location.Ref Type) -> + Int -> + Int -> + (Struct.Location.Type -> Int) -> + (Dict.Dict Struct.Location.Ref Type) + ) +search result remaining dist range cost_fun = + if (Dict.isEmpty remaining) + then + result + else + let + (min_loc_ref, min) = + (Dict.foldl + (get_closest dist) + ( + (-1,-1), + { + distance = Constants.Movement.cost_when_out_of_bounds, + path = [], + range = Constants.Movement.cost_when_out_of_bounds, + marker = Struct.Marker.CanAttack + } + ) + remaining + ) + in + (search + (Dict.insert + min_loc_ref + {min | + marker = + ( + if (min.range > 0) + then + Struct.Marker.CanAttack + else + Struct.Marker.CanGoTo + ) + } + result + ) + (List.foldl + (handle_neighbors + min + (Struct.Location.from_ref min_loc_ref) + dist + range + result + (cost_fun) + ) + (Dict.remove min_loc_ref remaining) + [ + Struct.Direction.Left, + Struct.Direction.Right, + Struct.Direction.Up, + Struct.Direction.Down + ] + ) + dist + range + (cost_fun) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +generate : ( + Struct.Location.Type -> + Int -> + Int -> + (Struct.Location.Type -> Int) -> + (Dict.Dict Struct.Location.Ref Type) + ) +generate location dist range cost_fun = + (search + Dict.empty + (Dict.insert + (Struct.Location.get_ref location) + { + distance = 0, + path = [], + range = 0, + marker = Struct.Marker.CanGoTo + } + Dict.empty + ) + dist + range + (cost_fun) + ) + +get_marker : Type -> Struct.Marker.Type +get_marker indicator = indicator.marker + +get_path : Type -> (List Struct.Direction.Type) +get_path indicator = indicator.path diff --git a/src/battlemap/src/Struct/Tile.elm b/src/battlemap/src/Struct/Tile.elm new file mode 100644 index 0000000..d75e74e --- /dev/null +++ b/src/battlemap/src/Struct/Tile.elm @@ -0,0 +1,54 @@ +module Struct.Tile exposing + ( + Type, + new, + error_tile, + get_location, + get_icon_id, + get_cost + ) + +-- Battlemap ------------------------------------------------------------------- +import Struct.Location + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + location : Struct.Location.Type, + icon_id : String, + crossing_cost : Int + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Int -> Int -> String -> Int -> Type +new x y icon_id crossing_cost = + { + location = {x = x, y = y}, + icon_id = icon_id, + crossing_cost = crossing_cost + } + +error_tile : Int -> Int -> Type +error_tile x y = + { + location = {x = x, y = y}, + icon_id = "error", + crossing_cost = 1 + } + +get_location : Type -> Struct.Location.Type +get_location tile = tile.location + +get_icon_id : Type -> String +get_icon_id tile = tile.icon_id + +get_cost : Type -> Int +get_cost tile = tile.crossing_cost diff --git a/src/battlemap/src/Struct/UI.elm b/src/battlemap/src/Struct/UI.elm new file mode 100644 index 0000000..3ef895d --- /dev/null +++ b/src/battlemap/src/Struct/UI.elm @@ -0,0 +1,122 @@ +module Struct.UI exposing + ( + Type, + Tab(..), + Action(..), + default, + -- Zoom + get_zoom_level, + reset_zoom_level, + mod_zoom_level, + -- Tab + try_getting_displayed_tab, + set_displayed_tab, + reset_displayed_tab, + to_string, + get_all_tabs, + -- Manual Controls + has_manual_controls_enabled, + -- Previous Action + has_focus, + get_previous_action, + set_previous_action + ) + +-- Battlemap ------------------------------------------------------------------- +import Struct.Location + +import Struct.Character + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Tab = + StatusTab + | Struct.CharactersTab + | SettingsTab + +type Action = + UsedManualControls + | SelectedLocation Struct.Location.Ref + | SelectedCharacter Struct.Character.Ref + | AttackedCharacter Struct.Character.Ref + +type alias Type = + { + zoom_level : Float, + show_manual_controls : Bool, + displayed_tab : (Maybe Tab), + previous_action : (Maybe Action) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +default : Type +default = + { + zoom_level = 1.0, + show_manual_controls = True, + displayed_tab = (Just StatusTab), + previous_action = Nothing + } + +-- Zoom ------------------------------------------------------------------------ +get_zoom_level : Type -> Float +get_zoom_level ui = ui.zoom_level + +reset_zoom_level : Type -> Type +reset_zoom_level ui = {ui | zoom_level = 1.0} + +mod_zoom_level : Type -> Float -> Type +mod_zoom_level ui mod = {ui | zoom_level = (mod * ui.zoom_level)} + +-- Tab ------------------------------------------------------------------------- +try_getting_displayed_tab : Type -> (Maybe Tab) +try_getting_displayed_tab ui = ui.displayed_tab + +set_displayed_tab : Type -> Tab -> Type +set_displayed_tab ui tab = {ui | displayed_tab = (Just tab)} + +reset_displayed_tab : Type -> Type +reset_displayed_tab ui = {ui | displayed_tab = Nothing} + +to_string : Tab -> String +to_string tab = + case tab of + StatusTab -> "Status" + Struct.CharactersTab -> "Characters" + SettingsTab -> "Settings" + +get_all_tabs : (List Tab) +get_all_tabs = + [StatusTab, Struct.CharactersTab, SettingsTab] + +-- ManualControls -------------------------------------------------------------- +has_manual_controls_enabled : Type -> Bool +has_manual_controls_enabled ui = ui.show_manual_controls + +toggle_manual_controls : Type -> Type +toggle_manual_controls ui = + if (ui.show_manual_controls) + then + {ui | show_manual_controls = False} + else + {ui | show_manual_controls = True} + +set_enable_manual_controls : Type -> Bool -> Type +set_enable_manual_controls ui val = {ui | show_manual_controls = val} + +-- Previous Action ------------------------------------------------------------- +has_focus : Type -> Bool +has_focus ui = True + +set_previous_action : Type -> (Maybe Action) -> Type +set_previous_action ui act = {ui | previous_action = act} + +get_previous_action : Type -> (Maybe Action) +get_previous_action ui = ui.previous_action diff --git a/src/battlemap/src/Subscriptions.elm b/src/battlemap/src/Subscriptions.elm deleted file mode 100644 index 83df587..0000000 --- a/src/battlemap/src/Subscriptions.elm +++ /dev/null @@ -1,7 +0,0 @@ -module Subscriptions exposing (..) - -import Model -import Event - -subscriptions : Model.Type -> (Sub Event.Type) -subscriptions model = Sub.none diff --git a/src/battlemap/src/UI.elm b/src/battlemap/src/UI.elm deleted file mode 100644 index 978ed00..0000000 --- a/src/battlemap/src/UI.elm +++ /dev/null @@ -1,122 +0,0 @@ -module UI exposing - ( - Type, - Tab(..), - Action(..), - default, - -- Zoom - get_zoom_level, - reset_zoom_level, - mod_zoom_level, - -- Tab - try_getting_displayed_tab, - set_displayed_tab, - reset_displayed_tab, - to_string, - get_all_tabs, - -- Manual Controls - has_manual_controls_enabled, - -- Previous Action - has_focus, - get_previous_action, - set_previous_action - ) - --- Battlemap ------------------------------------------------------------------- -import Battlemap.Location - -import Character - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type Tab = - StatusTab - | CharactersTab - | SettingsTab - -type Action = - UsedManualControls - | SelectedLocation Battlemap.Location.Ref - | SelectedCharacter Character.Ref - | AttackedCharacter Character.Ref - -type alias Type = - { - zoom_level : Float, - show_manual_controls : Bool, - displayed_tab : (Maybe Tab), - previous_action : (Maybe Action) - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -default : Type -default = - { - zoom_level = 1.0, - show_manual_controls = True, - displayed_tab = (Just StatusTab), - previous_action = Nothing - } - --- Zoom ------------------------------------------------------------------------ -get_zoom_level : Type -> Float -get_zoom_level ui = ui.zoom_level - -reset_zoom_level : Type -> Type -reset_zoom_level ui = {ui | zoom_level = 1.0} - -mod_zoom_level : Type -> Float -> Type -mod_zoom_level ui mod = {ui | zoom_level = (mod * ui.zoom_level)} - --- Tab ------------------------------------------------------------------------- -try_getting_displayed_tab : Type -> (Maybe Tab) -try_getting_displayed_tab ui = ui.displayed_tab - -set_displayed_tab : Type -> Tab -> Type -set_displayed_tab ui tab = {ui | displayed_tab = (Just tab)} - -reset_displayed_tab : Type -> Type -reset_displayed_tab ui = {ui | displayed_tab = Nothing} - -to_string : Tab -> String -to_string tab = - case tab of - StatusTab -> "Status" - CharactersTab -> "Characters" - SettingsTab -> "Settings" - -get_all_tabs : (List Tab) -get_all_tabs = - [StatusTab, CharactersTab, SettingsTab] - --- ManualControls -------------------------------------------------------------- -has_manual_controls_enabled : Type -> Bool -has_manual_controls_enabled ui = ui.show_manual_controls - -toggle_manual_controls : Type -> Type -toggle_manual_controls ui = - if (ui.show_manual_controls) - then - {ui | show_manual_controls = False} - else - {ui | show_manual_controls = True} - -set_enable_manual_controls : Type -> Bool -> Type -set_enable_manual_controls ui val = {ui | show_manual_controls = val} - --- Previous Action ------------------------------------------------------------- -has_focus : Type -> Bool -has_focus ui = True - -set_previous_action : Type -> (Maybe Action) -> Type -set_previous_action ui act = {ui | previous_action = act} - -get_previous_action : Type -> (Maybe Action) -get_previous_action ui = ui.previous_action diff --git a/src/battlemap/src/Update.elm b/src/battlemap/src/Update.elm deleted file mode 100644 index 787fc8e..0000000 --- a/src/battlemap/src/Update.elm +++ /dev/null @@ -1,90 +0,0 @@ -module Update exposing (update) - -import Event - -import Error - -import UI - -import Model -import Model.RequestDirection -import Model.SelectTile -import Model.SelectCharacter -import Model.EndTurn -import Model.HandleServerReply - -import Send.LoadBattlemap - -update : Event.Type -> Model.Type -> (Model.Type, (Cmd Event.Type)) -update event model = - let - new_model = (Model.clear_error model) - in - case event of - (Event.DirectionRequested d) -> - ((Model.RequestDirection.apply_to new_model d), Cmd.none) - - (Event.TileSelected loc) -> - (Model.SelectTile.apply_to new_model loc) - - (Event.CharacterSelected char_id) -> - ((Model.SelectCharacter.apply_to new_model char_id), Cmd.none) - - Event.TurnEnded -> - (Model.EndTurn.apply_to new_model) - - (Event.ScaleChangeRequested mod) -> - if (mod == 0.0) - then - ({model | ui = (UI.reset_zoom_level model.ui)}, Cmd.none) - else - ({model | ui = (UI.mod_zoom_level model.ui mod)}, Cmd.none) - - (Event.TabSelected tab) -> - ({model | ui = (UI.set_displayed_tab model.ui tab)}, Cmd.none) - - (Event.DebugTeamSwitchRequest) -> - if (model.controlled_team == 0) - then - ( - (Model.reset - {model | - controlled_team = 1, - player_id = "1" - } - model.characters - ), - Cmd.none - ) - else - ( - (Model.reset - {model | - controlled_team = 0, - player_id = "0" - } - model.characters - ), - Cmd.none - ) - - (Event.DebugLoadBattlemapRequest) -> - ( - model, - (case (Send.LoadBattlemap.try model) of - (Just cmd) -> cmd - Nothing -> Cmd.none - ) - ) - - (Event.ServerReplied (Result.Err error)) -> - ( - (Model.invalidate - model - (Error.new Error.Networking (toString error)) - ), - Cmd.none - ) - - (Event.ServerReplied (Result.Ok commands)) -> - (Model.HandleServerReply.apply_to model commands) diff --git a/src/battlemap/src/Update/ChangeScale.elm b/src/battlemap/src/Update/ChangeScale.elm new file mode 100644 index 0000000..139c662 --- /dev/null +++ b/src/battlemap/src/Update/ChangeScale.elm @@ -0,0 +1,26 @@ +module Update.ChangeScale exposing (apply_to) +-- Elm ------------------------------------------------------------------------- + +-- Battlemap ------------------------------------------------------------------- +import Struct.Model +import Struct.Event +import Struct.UI + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + Float -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model mod = + if (mod == 0.0) + then + ({model | ui = (Struct.UI.reset_zoom_level model.ui)}, Cmd.none) + else + ({model | ui = (Struct.UI.mod_zoom_level model.ui mod)}, Cmd.none) diff --git a/src/battlemap/src/Update/EndTurn.elm b/src/battlemap/src/Update/EndTurn.elm new file mode 100644 index 0000000..fd0ec83 --- /dev/null +++ b/src/battlemap/src/Update/EndTurn.elm @@ -0,0 +1,82 @@ +module Model.EndTurn exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Dict + +-- Battlemap ------------------------------------------------------------------- +import Battlemap + +import Character + +import Error +import Event + +import Model + +import Send.CharacterTurn +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +make_it_so : Model.Type -> (Model.Type, (Cmd Event.Type)) +make_it_so model = + case (Battlemap.try_getting_navigator_location model.battlemap) of + (Just location) -> + case (Send.CharacterTurn.try model) of + (Just cmd) -> + ( + (Model.reset + model + (Dict.update + char_ref + (\maybe_char -> + case maybe_char of + (Just char) -> + (Just + (Character.set_enabled + (Character.set_location location char) + False + ) + ) + Nothing -> Nothing + ) + model.characters + ) + ), + cmd + ) + + Nothing -> + (model, Cmd.none) + + Nothing -> + ( + (Model.invalidate + model + (Error.new + Error.Programming + "EndTurn: model moving char, no navigator location." + ) + ), + Cmd.none + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : Model.Type -> (Model.Type, (Cmd Event.Type)) +apply_to model = + case (Query.CharacterTurn.get_state model.char_turn) of + Query.CharacterTurn.MovedCharacter -> (make_it_so model) + Query.CharacterTurn.ChoseTarget -> (make_it_so model) + + _ -> + ( + (Model.invalidate + model + (Error.new + Error.IllegalAction + "This can only be done while moving a character." + ) + ), + Cmd.none + ) diff --git a/src/battlemap/src/Update/HandleServerReply.elm b/src/battlemap/src/Update/HandleServerReply.elm new file mode 100644 index 0000000..13c493c --- /dev/null +++ b/src/battlemap/src/Update/HandleServerReply.elm @@ -0,0 +1,57 @@ +module Model.HandleServerReply exposing (apply_to) + +-- Battlemap ------------------------------------------------------------------- +import Model +import Error +import Event + +import Model.HandleServerReply.SetMap +import Model.HandleServerReply.AddChar + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_command: (List String) -> Model.Type -> Model.Type +apply_command cmd model = + case + cmd + of + ["set_map", data] -> + (Model.HandleServerReply.SetMap.apply_to model data) + + ["add_char", data] -> + (Model.HandleServerReply.AddChar.apply_to model data) + + _ -> + (Model.invalidate + model + (Error.new + Error.Programming + ( + "Received invalid command from server:" + ++ (toString cmd) + ) + ) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Model.Type -> + (Result Http.Error (List (List String)) -> + (Model.Type, (Cmd Event.Type)) + ) +apply_to model query_result = + case query_result of + (Result.Err error) -> + ( + (Model.invalidate + model + (Error.new Error.Networking (toString error)) + ), + Cmd.none + ) + + (Result.Ok commands) -> + ((List.foldl (apply_command) model serialized_commands), Cmd.none) diff --git a/src/battlemap/src/Update/HandleServerReply/AddChar.elm b/src/battlemap/src/Update/HandleServerReply/AddChar.elm new file mode 100644 index 0000000..f5f30ba --- /dev/null +++ b/src/battlemap/src/Update/HandleServerReply/AddChar.elm @@ -0,0 +1,90 @@ +module Model.HandleServerReply.AddChar exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode +import Json.Decode.Pipeline + +-- Battlemap ------------------------------------------------------------------- +import Character + +import Error + +import Model + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias CharData = + { + id : String, + name : String, + icon : String, + portrait : String, + health : Int, + max_health : Int, + loc_x : Int, + loc_y : Int, + team : Int, + mov_pts : Int, + atk_rg : Int, + enabled : Bool + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +char_decoder : (Json.Decode.Decoder CharData) +char_decoder = + (Json.Decode.Pipeline.decode + CharData + |> (Json.Decode.Pipeline.required "id" Json.Decode.string) + |> (Json.Decode.Pipeline.required "name" Json.Decode.string) + |> (Json.Decode.Pipeline.required "icon" Json.Decode.string) + |> (Json.Decode.Pipeline.required "portrait" Json.Decode.string) + |> (Json.Decode.Pipeline.required "health" Json.Decode.int) + |> (Json.Decode.Pipeline.required "max_health" Json.Decode.int) + |> (Json.Decode.Pipeline.required "loc_x" Json.Decode.int) + |> (Json.Decode.Pipeline.required "loc_y" Json.Decode.int) + |> (Json.Decode.Pipeline.required "team" Json.Decode.int) + |> (Json.Decode.Pipeline.required "mov_pts" Json.Decode.int) + |> (Json.Decode.Pipeline.required "atk_rg" Json.Decode.int) + |> (Json.Decode.Pipeline.required "enabled" Json.Decode.bool) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : Model.Type -> String -> Model.Type +apply_to model serialized_char = + case + (Json.Decode.decodeString + char_decoder + serialized_char + ) + of + (Result.Ok char_data) -> + (Model.add_character + model + (Character.new + char_data.id + char_data.name + char_data.icon + char_data.portrait + char_data.health + char_data.max_health + {x = char_data.loc_x, y = char_data.loc_y} + char_data.team + char_data.mov_pts + char_data.atk_rg + char_data.enabled + ) + ) + + (Result.Err msg) -> + (Model.invalidate + model + (Error.new + Error.Programming + ("Could not deserialize character: " ++ msg) + ) + ) diff --git a/src/battlemap/src/Update/HandleServerReply/SetMap.elm b/src/battlemap/src/Update/HandleServerReply/SetMap.elm new file mode 100644 index 0000000..e815093 --- /dev/null +++ b/src/battlemap/src/Update/HandleServerReply/SetMap.elm @@ -0,0 +1,71 @@ +module Model.HandleServerReply.SetMap exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Dict +import Json.Decode + +-- Battlemap ------------------------------------------------------------------- +import Battlemap +import Battlemap.Tile + +import Data.Tile + +import Model + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias MapData = + { + width : Int, + height : Int, + content : (List Int) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +deserialize_tile : Int -> Int -> Int -> Battlemap.Tile.Type +deserialize_tile map_width index id = + (Battlemap.Tile.new + (index % map_width) + (index // map_width) + (Data.Tile.get_icon id) + (Data.Tile.get_cost id) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +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.int) + ) + ) + serialized_map + ) + of + (Result.Ok map_data) -> + (Model.reset + {model | + battlemap = + (Battlemap.new + map_data.width + map_data.height + (List.indexedMap + (deserialize_tile map_data.width) + map_data.content + ) + ) + } + (Dict.empty) + ) + + _ -> model diff --git a/src/battlemap/src/Update/RequestDirection.elm b/src/battlemap/src/Update/RequestDirection.elm new file mode 100644 index 0000000..3d6dfbe --- /dev/null +++ b/src/battlemap/src/Update/RequestDirection.elm @@ -0,0 +1,78 @@ +module Update.RequestDirection exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Dict + +-- Battlemap ------------------------------------------------------------------- +import Struct.Battlemap +import Struct.Direction +import Struct.Character +import Struct.UI +import Struct.Model +import Struct.Error + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +make_it_so : ( + Struct.Model.Type -> + Struct.Character.Ref -> + Struct.Direction.Type -> + Struct.Model.Type + ) +make_it_so model char_ref dir = + let + new_bmap = + (Struct.Battlemap.try_adding_step_to_navigator + model.battlemap + (Dict.values model.characters) + dir + ) + in + case new_bmap of + (Just bmap) -> + {model | + battlemap = bmap, + ui = + (Struct.UI.set_previous_action + model.ui + (Just Struct.UI.UsedManualControls) + ) + } + + Nothing -> + (Struct.Model.invalidate + model + (Struct.Error.new + Struct.Error.IllegalAction + "Unreachable/occupied tile." + ) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + Struct.Direction.Type -> + Struct.Model.Type + ) +apply_to model dir = + case model.controlled_character of + (Just char_ref) -> + ( + (make_it_so model char_ref dir), + Cmd.none + ) + + _ -> + ( + (Struct.Model.invalidate + model + (Struct.Error.new + Struct.Error.IllegalAction + "This can only be done while moving a character." + ) + ), + Cmd.none + ) diff --git a/src/battlemap/src/Update/SelectCharacter.elm b/src/battlemap/src/Update/SelectCharacter.elm new file mode 100644 index 0000000..1535c8c --- /dev/null +++ b/src/battlemap/src/Update/SelectCharacter.elm @@ -0,0 +1,124 @@ +module Update.SelectCharacter exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Dict + +-- Battlemap ------------------------------------------------------------------- +import Struct.Battlemap +import Struct.Character +import Struct.Direction +import Struct.Error +import Struct.UI +import Struct.Model + +import Update.RequestDirection + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +autopilot : Struct.Direction.Type -> Struct.Model.Type -> Struct.Model.Type +autopilot dir model = + (Model.RequestDirection.apply_to model dir) + +attack_character : ( + Struct.Model.Type -> + Struct.Character.Ref -> + Struct.Character.Ref -> + Struct.Character.Type -> + Struct.Model.Type + ) +attack_character model main_char_id target_char_id target_char = + {model | + targets = [target_char_id], + ui = (Struct.UI.set_previous_action model.ui Nothing) + } + +select_character : ( + Struct.Model.Type -> + Struct.Character.Ref -> + Struct.Character.Type -> + Struct.Model.Type + ) +select_character model target_char_id target_char = + if ((Struct.Character.is_enabled target_char)) + then + {model | + state = Struct.Model.Default, + controlled_character = (Just target_char_id), + ui = (Struct.UI.set_previous_action model.ui Nothing), + battlemap = + (Struct.Battlemap.set_navigator + (Struct.Character.get_location target_char) + (Struct.Character.get_movement_points target_char) + (Struct.Character.get_attack_range target_char) + (Dict.values model.characters) + model.battlemap + ) + } + else + {model | + ui = + (Struct.UI.set_previous_action + model.ui + (Just (Struct.UI.SelectedCharacter target_char_id)) + ) + } + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + Struct.Character.Ref -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model target_char_id = + if + ( + (Struct.UI.get_previous_action model.ui) + == + (Just (Struct.UI.SelectedCharacter target_char_id)) + ) + then + case (Dict.get target_char_id model.characters) of + (Just target_char) -> + case model.controlled_character of + (Just main_char_id) -> + ( + (attack_character + model + main_char_id + target_char_id + target_char + ), + Cmd.none + ) + + _ -> + ( + (select_character model target_char_id target_char), + Cmd.none + ) + + Nothing -> + ( + (Struct.Model.invalidate + model + (Struct.Error.new + Struct.Error.Programming + "SelectCharacter: Unknown char selected." + ) + ), + Cmd.none + ) + else + ( + {model | + ui = + (Struct.UI.set_previous_action + model.ui + (Just (Struct.UI.SelectedCharacter target_char_id)) + ) + }, + Cmd.none + ) diff --git a/src/battlemap/src/Update/SelectTab.elm b/src/battlemap/src/Update/SelectTab.elm new file mode 100644 index 0000000..c48b0fc --- /dev/null +++ b/src/battlemap/src/Update/SelectTab.elm @@ -0,0 +1,25 @@ +module Update.SelectTab exposing (apply_to) +-- Elm ------------------------------------------------------------------------- + +-- Battlemap ------------------------------------------------------------------- +import Struct.Model +import Struct.Event +import Struct.UI + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + Struct.UI.Tab -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model tab = + ( + {model | ui = (Struct.UI.set_displayed_tab model.ui tab)}, + Cmd.none + ) diff --git a/src/battlemap/src/Update/SelectTile.elm b/src/battlemap/src/Update/SelectTile.elm new file mode 100644 index 0000000..5ce3c3c --- /dev/null +++ b/src/battlemap/src/Update/SelectTile.elm @@ -0,0 +1,110 @@ +module Model.SelectTile exposing (apply_to) + +-- Battlemap ------------------------------------------------------------------- +import Battlemap +import Battlemap.Direction +import Battlemap.Location + +import Character + +import Event + +import Model.RequestDirection +import Model.EndTurn + +import UI +import Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +autopilot : Battlemap.Direction.Type -> Model.Type -> Model.Type +autopilot dir model = + (Model.RequestDirection.apply_to model dir) + +go_to_tile : ( + Model.Type -> + Character.Ref -> + Battlemap.Location.Ref -> + (Model.Type, (Cmd Event.Type)) + ) +go_to_tile model char_ref loc_ref = + case (Battlemap.try_getting_navigator_location model.battlemap) of + (Just nav_loc) -> + if (loc_ref == (Battlemap.Location.get_ref nav_loc)) + then + -- We are already there. + if + ( + (UI.get_previous_action model.ui) + == + (Just (UI.SelectedLocation loc_ref)) + ) + then + -- And we just clicked on that tile. + (Model.EndTurn.apply_to model) + else + -- And we didn't just click on that tile. + ( + {model | + ui = + (UI.set_previous_action + model.ui + (Just (UI.SelectedLocation loc_ref)) + ) + }, + Cmd.none + ) + else + -- We have to try getting there. + case + (Battlemap.try_getting_navigator_path_to + model.battlemap + loc_ref + ) + of + (Just path) -> + let + new_model = + (List.foldr + (autopilot) + {model | + battlemap = + (Battlemap.clear_navigator_path + model.battlemap + ) + } + path + ) + in + ( + {new_model | + ui = + (UI.set_previous_action + new_model.ui + (Just (UI.SelectedLocation loc_ref)) + ) + }, + Cmd.none + ) + + Nothing -> -- Clicked outside of the range indicator + ((Model.reset model model.characters), Cmd.none) + + Nothing -> -- Clicked outside of the range indicator + ((Model.reset model model.characters), Cmd.none) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Model.Type -> + Battlemap.Location.Ref -> + (Model.Type, (Cmd Event.Type)) + ) +apply_to model loc_ref = + case model.controlled_character of + (Just char_ref) -> + (go_to_tile model char_ref loc_ref) + + _ -> ({model | state = (Model.InspectingTile loc_ref)}, Cmd.none) diff --git a/src/battlemap/src/Update/SendLoadBattlemapRequest.elm b/src/battlemap/src/Update/SendLoadBattlemapRequest.elm new file mode 100644 index 0000000..2ed248d --- /dev/null +++ b/src/battlemap/src/Update/SendLoadBattlemapRequest.elm @@ -0,0 +1,28 @@ +module Update.SendLoadBattlemapRequest exposing (apply_to) +-- Elm ------------------------------------------------------------------------- + +-- Battlemap ------------------------------------------------------------------- +import Struct.Model +import Struct.Event +import Struct.UI + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model = + ( + model, + (case (Send.LoadBattlemap.try model) of + (Just cmd) -> cmd + Nothing -> Cmd.none + ) + ) + diff --git a/src/battlemap/src/Update/SwitchTeam.elm b/src/battlemap/src/Update/SwitchTeam.elm new file mode 100644 index 0000000..f85dd87 --- /dev/null +++ b/src/battlemap/src/Update/SwitchTeam.elm @@ -0,0 +1,42 @@ +module Update.SwitchTeam exposing (apply_to) +-- Elm ------------------------------------------------------------------------- + +-- Battlemap ------------------------------------------------------------------- +import Struct.Model +import Struct.Event + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model = + if (model.controlled_team == 0) + then + ( + (Model.reset + {model | + controlled_team = 1, + player_id = "1" + } + model.characters + ), + Cmd.none + ) + else + ( + (Model.reset + {model | + controlled_team = 0, + player_id = "0" + } + model.characters + ), + Cmd.none + ) diff --git a/src/battlemap/src/View.elm b/src/battlemap/src/View.elm deleted file mode 100644 index 9073d93..0000000 --- a/src/battlemap/src/View.elm +++ /dev/null @@ -1,58 +0,0 @@ -module View exposing (view) - --- Elm ------------------------------------------------------------------------- -import Dict - -import Html -import Html.Attributes - --- Battlemap ------------------------------------------------------------------- -import UI - -import View.Battlemap -import View.SideBar -import View.Footer - -import Event -import Model - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -view : Model.Type -> (Html.Html Event.Type) -view model = - (Html.div - [ - (Html.Attributes.class "fullscreen-module") - ] - [ - (Html.div - [ - (Html.Attributes.class "battlemap-left-panel") - ] - [ - (Html.div - [ - (Html.Attributes.class "battlemap-container") - ] - [ - (View.Battlemap.get_html - model.battlemap - (UI.get_zoom_level model.ui) - (Dict.values model.characters) - ) - ] - ), - (View.Footer.get_html model) - ] - ), - (Html.div - [ - (Html.Attributes.class "battlemap-right-panel") - ] - [ - (View.SideBar.get_html model) - ] - ) - ] - ) -- cgit v1.2.3-70-g09d2