| summaryrefslogtreecommitdiff |
diff options
Diffstat (limited to 'elm')
21 files changed, 627 insertions, 323 deletions
diff --git a/elm/battlemap/Makefile b/elm/battlemap/Makefile index 54b52d8..97d7b0b 100644 --- a/elm/battlemap/Makefile +++ b/elm/battlemap/Makefile @@ -1,4 +1,4 @@ -ELM_CC = elm-make +ELM_CC = elm-make --warn SRC_DIR = src MAIN_MODULE = $(SRC_DIR)/Main.elm diff --git a/elm/battlemap/src/Battlemap.elm b/elm/battlemap/src/Battlemap.elm index 309b538..e07ae2d 100644 --- a/elm/battlemap/src/Battlemap.elm +++ b/elm/battlemap/src/Battlemap.elm @@ -1,25 +1,36 @@ module Battlemap exposing ( Type, - apply_to_tile, - apply_to_tile_unsafe, - has_location, - apply_to_all_tiles + reset, + get_navigator_location, + get_navigator_remaining_points, + set_navigator, + add_step_to_navigator ) import Array +import Battlemap.Navigator +import Battlemap.Navigator.RangeIndicator import Battlemap.Tile import Battlemap.Direction import Battlemap.Location +import Util.Array +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- type alias Type = { - width : Int, - height : Int, - content : (Array.Array Battlemap.Tile.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) @@ -33,6 +44,102 @@ has_location bmap loc = && (loc.y < bmap.height) ) +add_marker_to_tiles : ( + Type -> + (Battlemap.Location.Ref, Battlemap.Navigator.RangeIndicator.Type) -> + (Array.Array Battlemap.Tile.Type) -> + (Array.Array Battlemap.Tile.Type) + ) +add_marker_to_tiles bmap (location, indicator) tiles = + (Util.Array.update_unsafe + (location_to_index bmap (Battlemap.Location.from_ref location)) + ( + (Battlemap.Tile.set_marker + (Just + (Battlemap.Navigator.RangeIndicator.get_marker indicator) + ) + ) + ) + tiles + ) +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +reset : Type -> Type +reset bmap = + {bmap | + content = (Array.map (Battlemap.Tile.reset) bmap.content), + navigator = Nothing + } + +get_navigator_location : Type -> (Maybe Battlemap.Location.Type) +get_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 -> + (Battlemap.Location.Type -> Bool) -> + Type -> + Type + ) +set_navigator start_loc movement_points attack_range can_cross bmap = + let + new_navigator = + (Battlemap.Navigator.new + start_loc + movement_points + attack_range + (\loc -> ((can_cross loc) && (has_location bmap loc))) + ) + new_range_markers = (Battlemap.Navigator.get_range_markers new_navigator) + in + {bmap | + content = + (List.foldr + (add_marker_to_tiles bmap) + bmap.content + new_range_markers + ), + navigator = (Just new_navigator) + } + +add_step_to_navigator : ( + Type -> + Battlemap.Direction.Type -> + (Battlemap.Location.Type -> Bool) -> + (Maybe Type) +add_step_to_navigator bmap dir can_cross = + case bmap.navigator of + (Just navigator) -> + let + new_navigator = + (Battlemap.Navigator.add_step + navigator + (\loc -> ((can_cross loc) && (has_location bmap loc))) + dir + ) + in + case new_navigator of + (Just _) -> {bmap | navigator = new_navigator} + Nothing -> Nothing + + _ -> Nothing +-------------------------------------------------------------------------------- + apply_to_all_tiles : ( Type -> (Battlemap.Tile.Type -> Battlemap.Tile.Type) -> Type ) diff --git a/elm/battlemap/src/Battlemap/Html.elm b/elm/battlemap/src/Battlemap/Html.elm index 6506c0f..d7cfc63 100644 --- a/elm/battlemap/src/Battlemap/Html.elm +++ b/elm/battlemap/src/Battlemap/Html.elm @@ -33,7 +33,7 @@ view_battlemap_cell t = case t.char_level of Nothing -> (Html.td - [ (Html.Events.onClick (Event.SelectTile t.location)) ] + [ (Html.Events.onClick (Event.TileSelected t.location)) ] [ (Html.text (case t.mod_level of @@ -47,7 +47,7 @@ view_battlemap_cell t = ) (Just char_id) -> (Html.td - [ (Html.Events.onClick (Event.SelectCharacter char_id)) ] + [ (Html.Events.onClick (Event.CharacterSelected char_id)) ] [ (Html.text ("[" ++ char_id ++ "]")), (Html.text (nav_level_to_text t)) diff --git a/elm/battlemap/src/Battlemap/Marker.elm b/elm/battlemap/src/Battlemap/Marker.elm new file mode 100644 index 0000000..ebefce6 --- /dev/null +++ b/elm/battlemap/src/Battlemap/Marker.elm @@ -0,0 +1,5 @@ +module Battlemap.Marker exposing (Type(..)) + +type Type = + CanAttack + | CanGoTo diff --git a/elm/battlemap/src/Battlemap/Navigator.elm b/elm/battlemap/src/Battlemap/Navigator.elm index b040013..9cdfc1f 100644 --- a/elm/battlemap/src/Battlemap/Navigator.elm +++ b/elm/battlemap/src/Battlemap/Navigator.elm @@ -2,43 +2,94 @@ module Battlemap.Navigator exposing ( Type, new, - reset + get_current_location, + get_remaining_points, + get_range_markers, + add_step ) -import Set +import Dict -import Battlemap -import Battlemap.Direction import Battlemap.Location -import Battlemap.Tile +import Battlemap.Navigator.Path +import Battlemap.Navigator.RangeIndicator +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- type alias Type = { - current_location : Battlemap.Location.Type, - visited_locations : (Set.Set Battlemap.Location.Ref), - previous_directions : (List Battlemap.Direction.Type), - remaining_points : Int, - starting_location : Battlemap.Location.Type, - starting_points : Int + 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 + ) } -new : Battlemap.Location.Type -> Int -> Type -new start points = +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +new : ( + Battlemap.Location.Type -> + Int -> + Int -> + (Battlemap.Location.Type -> Bool) -> Type + ) +new start_loc mov_dist atk_dist can_cross_fun = { - current_location = start, - visited_locations = Set.empty, - previous_directions = [], - remaining_points = points, - starting_location = start, - starting_points = points + 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 + (can_cross_fun) + ) } -reset : Type -> Type -reset nav = - {nav | - current_location = nav.starting_location, - visited_locations = Set.empty, - previous_directions = [], - remaining_points = nav.starting_points - } +get_current_location : Type -> Battlemap.Location.Type +get_current_location navigator = + (Battlemap.Navigator.Path.get_current_location navigator.path) + +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) + +add_step : ( + Type -> + Battlemap.Direction.Type -> + (Battlemap.Location.Type -> Bool) -> + (Maybe Type) + ) +add_step navigator dir can_cross = + case + (Battlemap.Navigator.Path.follow_direction + can_cross + (Just navigator.path) + dir + ) + of + (Just path) -> (Just {navigator | path = path} + Nothing -> Nothing diff --git a/elm/battlemap/src/Battlemap/Navigator/Path.elm b/elm/battlemap/src/Battlemap/Navigator/Path.elm new file mode 100644 index 0000000..5ce2d4c --- /dev/null +++ b/elm/battlemap/src/Battlemap/Navigator/Path.elm @@ -0,0 +1,170 @@ +module Battlemap.Navigator.Path exposing + ( + Type, + new, + get_current_location, + get_remaining_points, + follow_directions + ) + +import Set + +import Battlemap.Direction +import Battlemap.Location +import Battlemap.Tile + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + current_location : Battlemap.Location.Type, + visited_locations : (Set.Set Battlemap.Location.Ref), + previous_directions : (List Battlemap.Direction.Type), + remaining_points : Int + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +has_not_been_to : ( + Type -> + Battlemap.Location.Type -> + Bool + ) +has_not_been_to path location = + ( + (path.current_location /= location) + && + (not + (Set.member + (Battlemap.Location.get_ref location) + path.visited_locations + ) + ) + ) + +move_to : ( + Type -> + Battlemap.Direction.Type -> + Battlemap.Location.Type -> + Int -> + Type + ) +move_to path dir next_loc cost = + {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), + remaining_points = (path.remaining_points - cost) + } + +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 + ) +try_backtracking_to path location dir = + case (Util.List.pop nav.previous_directions) of + (Just (head, tail)) -> + if (head == (Battlemap.Direction.opposite_of dir)) + then + (backtrack_to + nav + next_location + tail + ) + ) + else + (battlemap, nav) + Nothing -> (battlemap, nav) + move_to path next_location + if (can_move_to_new_tile path next_location) + then + else + {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 : ( + Type -> + Battlemap.Direction.Type -> + (Battlemap.Type, Battlemap.Navigator.Type) + ) +to battlemap nav dir char_list = + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +new : Battlemap.Location.Type -> Int -> Type +new start points = + { + current_location = start, + visited_locations = Set.empty, + previous_directions = [], + 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 + +follow_direction : ( + (Battlemap.Location.Type -> Bool) -> + (Maybe Type) -> + Battlemap.Direction.Type -> + (Maybe Type) + ) +follow_direction can_cross cost_fun maybe_path dir = + case maybe_path of + (Just path) -> + let + next_location = + (Battlemap.Location.neighbor + nav.current_location + dir + ) + in + if (can_cross path next_location) + then + if (has_not_been_to path next_location) + then + (Just (move_to path next_location dir)) + else + (try_backtracking_to path next_location dir) + else + Nothing + else + (battlemap, nav) + + Nothing -> Nothing diff --git a/elm/battlemap/src/Battlemap/RangeIndicator.elm b/elm/battlemap/src/Battlemap/Navigator/RangeIndicator.elm index 9276e49..c370d03 100644 --- a/elm/battlemap/src/Battlemap/RangeIndicator.elm +++ b/elm/battlemap/src/Battlemap/Navigator/RangeIndicator.elm @@ -1,12 +1,17 @@ -module Battlemap.RangeIndicator exposing (Type, generate) +module Battlemap.Navigator.RangeIndicator exposing + ( + Type, + generate, + get_marker + ) import Dict import List import Debug -import Battlemap import Battlemap.Direction import Battlemap.Location +import Battlemap.Marker import Util.List @@ -14,7 +19,8 @@ type alias Type = { distance: Int, path: (List Battlemap.Direction.Type), - node_cost: Int + node_cost: Int, + marker: Battlemap.Marker.Type } generate_row : ( @@ -172,14 +178,28 @@ search result remaining dist atk_dist = { distance = (atk_dist + 1), path = [], - node_cost = 99 + node_cost = 99, + marker = Battlemap.Marker.CanAttack } ) remaining ) in (search - (Dict.insert min_loc_ref min result) + (Dict.insert + min_loc_ref + {min | + marker = + ( + if (min.distance > dist) + then + Battlemap.Marker.CanAttack + else + Battlemap.Marker.CanGoTo + ) + } + result + ) (handle_neighbors (Battlemap.Location.from_ref min_loc_ref) dist @@ -198,23 +218,23 @@ search result remaining dist atk_dist = ) grid_to_range_indicators : ( - Battlemap.Type -> + (Battlemap.Location.Type -> Bool) -> Battlemap.Location.Type -> Int -> (List Battlemap.Location.Type) -> (Dict.Dict Battlemap.Location.Ref Type) -> (Dict.Dict Battlemap.Location.Ref Type) ) -grid_to_range_indicators battlemap location dist grid result = +grid_to_range_indicators can_cross_fun location dist grid result = case (Util.List.pop grid) of Nothing -> result (Just (head, tail)) -> - if (Battlemap.has_location battlemap head) + if (can_cross_fun head) then -- TODO: test if the current char can cross that tile. -- TODO: get tile cost. (grid_to_range_indicators - battlemap + (can_cross_fun) location dist tail @@ -230,26 +250,27 @@ grid_to_range_indicators battlemap location dist grid result = (dist + 1) ), path = [], - node_cost = 1 + node_cost = 1, + marker = Battlemap.Marker.CanGoTo } result ) ) else - (grid_to_range_indicators battlemap location dist tail result) + (grid_to_range_indicators (can_cross_fun) location dist tail result) generate : ( - Battlemap.Type -> Battlemap.Location.Type -> Int -> Int -> + (Battlemap.Location.Type -> Bool) -> (Dict.Dict Battlemap.Location.Ref Type) ) -generate battlemap location dist atk_dist = +generate location dist atk_dist can_cross_fun = (search Dict.empty (grid_to_range_indicators - battlemap + (can_cross_fun) location atk_dist (generate_grid location atk_dist (-atk_dist) []) @@ -258,3 +279,6 @@ generate battlemap location dist atk_dist = dist atk_dist ) + +get_marker : Type -> Battlemap.Marker.Type +get_marker indicator = indicator.marker diff --git a/elm/battlemap/src/Battlemap/Tile.elm b/elm/battlemap/src/Battlemap/Tile.elm index 7e0ae68..d761225 100644 --- a/elm/battlemap/src/Battlemap/Tile.elm +++ b/elm/battlemap/src/Battlemap/Tile.elm @@ -1,38 +1,25 @@ module Battlemap.Tile exposing ( Type, - TileModifier(..), - set_direction, - reset + set_character, + get_character ) import Battlemap.Direction +import Battlemap.Marker import Battlemap.Location import Character -type TileModifier = - CanBeReached - | CanBeAttacked - type alias Type = { location : Battlemap.Location.Ref, floor_level : Int, - nav_level : Battlemap.Direction.Type, char_level : (Maybe Character.Ref), - mod_level : (Maybe TileModifier) } -set_direction : Battlemap.Direction.Type -> Type -> Type -set_direction d t = - {t | - nav_level = d - } +set_character : (Maybe Character.Ref) -> Type -> Type +set_character char_ref tile = {tile | char_level = char_ref} -reset: Type -> Type -reset t = - {t | - nav_level = Battlemap.Direction.None, - mod_level = Nothing - } +get_character : Type -> (Maybe Character.Ref) +get_character tile = tile.char_level diff --git a/elm/battlemap/src/Character.elm b/elm/battlemap/src/Character.elm index f98dfd9..b0be220 100644 --- a/elm/battlemap/src/Character.elm +++ b/elm/battlemap/src/Character.elm @@ -1,4 +1,13 @@ -module Character exposing (Type, Ref, get_ref, get_location) +module Character exposing + ( + Type, + Ref, + get_ref, + get_location, + set_location, + get_movement_points, + get_attack_range + ) import Battlemap.Location @@ -21,3 +30,12 @@ get_ref c = 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 diff --git a/elm/battlemap/src/Event.elm b/elm/battlemap/src/Event.elm index 2c46360..b591bf4 100644 --- a/elm/battlemap/src/Event.elm +++ b/elm/battlemap/src/Event.elm @@ -7,7 +7,7 @@ import Battlemap.Location import Character type Type = - DirectionRequest Battlemap.Direction.Type - | SelectTile Battlemap.Location.Ref - | SelectCharacter Character.Ref - | EndTurn + DirectionRequested Battlemap.Direction.Type + | TileSelected Battlemap.Location.Ref + | CharacterSelected Character.Ref + | TurnEnded diff --git a/elm/battlemap/src/Model.elm b/elm/battlemap/src/Model.elm index 437d118..80a4c2e 100644 --- a/elm/battlemap/src/Model.elm +++ b/elm/battlemap/src/Model.elm @@ -1,7 +1,7 @@ module Model exposing ( Type, - CharacterSelection, + Selection(..), State(..), get_state, invalidate, @@ -12,55 +12,44 @@ module Model exposing import Dict import Battlemap -import Battlemap.Navigator import Battlemap.Location import Battlemap.Tile -import Battlemap.RangeIndicator import Error import Character -type alias CharacterSelection = - { - character: Character.Ref, - navigator: Battlemap.Navigator.Type, - range_indicator: - (Dict.Dict - Battlemap.Location.Ref - Battlemap.RangeIndicator.Type - ) - } - type State = Default | MovingCharacterWithButtons | MovingCharacterWithClick | FocusingTile +type Selection = + None + | SelectedCharacter Character.Ref + | SelectedTile Battlemap.Location.Ref + type alias Type = { state: State, battlemap: Battlemap.Type, characters: (Dict.Dict Character.Ref Character.Type), error: (Maybe Error.Type), - selection: (Maybe CharacterSelection) + selection: Selection } get_state : Type -> State get_state model = model.state -reset : Type -> Type -reset model = +reset : Type -> (Dict.Dict Character.Ref Character.Type) -> Type +reset model characters = {model | state = Default, - selection = Nothing, + battlemap = (Battlemap.reset model.battlemap), + characters = characters, error = Nothing, - battlemap = - (Battlemap.apply_to_all_tiles - model.battlemap - (Battlemap.Tile.reset) - ) + selection = None } invalidate : Type -> Error.Type -> Type diff --git a/elm/battlemap/src/Model/EndTurn.elm b/elm/battlemap/src/Model/EndTurn.elm new file mode 100644 index 0000000..788c3a1 --- /dev/null +++ b/elm/battlemap/src/Model/EndTurn.elm @@ -0,0 +1,63 @@ +module Model.EndTurn exposing (apply_to) + +import Dict + +import Battlemap + +import Character + +import Error + +import Model + +make_it_so : Model.Type -> Model.Type +make_it_so model = + case model.selection of + (Model.SelectedCharacter char_id) -> + case (Battlemap.get_navigator_location model.battlemap) of + (Just location) -> + (Model.reset + model + (Dict.update + char_id + (\maybe_char -> + case maybe_char of + (Just char) -> + (Just + (Character.set_location location char) + ) + Nothing -> Nothing + ) + model.characters + ) + ) + Nothing -> + (Model.invalidate + model + (Error.new + Error.Programming + "EndTurn: model moving char, no navigator location." + ) + ) + _ -> + (Model.invalidate + model + (Error.new + Error.Programming + "EndTurn: model moving char, no char selected." + ) + ) + +apply_to : Model.Type -> Model.Type +apply_to model = + case (Model.get_state model) of + Model.MovingCharacterWithButtons -> (make_it_so model) + Model.MovingCharacterWithClick -> (make_it_so model) + _ -> + (Model.invalidate + model + (Error.new + Error.IllegalAction + "This can only be done while moving a character." + ) + ) diff --git a/elm/battlemap/src/Update/DirectionRequest.elm b/elm/battlemap/src/Model/RequestDirection.elm index e069439..f47a902 100644 --- a/elm/battlemap/src/Update/DirectionRequest.elm +++ b/elm/battlemap/src/Model/RequestDirection.elm @@ -1,9 +1,9 @@ -module Update.DirectionRequest exposing (apply_to) +module Model.RequestDirection exposing (apply_to) import Dict +import Battlemap import Battlemap.Direction -import Battlemap.Navigator.Move import Model import Error @@ -11,30 +11,39 @@ import Error make_it_so : Model.Type -> Battlemap.Direction.Type -> Model.Type make_it_so model dir = case model.selection of - Nothing -> - (Model.invalidate - model - (Error.new - Error.Programming - "DirectionRequest: model moving char, no selection." - ) - ) - (Just selection) -> + (Model.SelectedCharacter char_id) -> let - (new_bmap, new_nav) = - (Battlemap.Navigator.Move.to + new_bmap = + (Battlemap.add_step_to_navigator model.battlemap - selection.navigator dir (Dict.values model.characters) ) in - {model | - state = Model.MovingCharacterWithButtons, - battlemap = new_bmap, - selection = (Just {selection | navigator = new_nav}) - } + case new_bmap of + (Just bmap) -> + {model | + state = Model.MovingCharacterWithButtons, + battlemap = new_bmap + } + + Nothing -> + (Model.invalidate + model + (Error.new + Error.IllegalAction + "Unreachable/occupied tile." + ) + ) + _ -> + (Model.invalidate + model + (Error.new + Error.Programming + "DirectionRequest: model moving char, no char selected." + ) + ) apply_to : Model.Type -> Battlemap.Direction.Type -> Model.Type apply_to model dir = diff --git a/elm/battlemap/src/Model/SelectCharacter.elm b/elm/battlemap/src/Model/SelectCharacter.elm new file mode 100644 index 0000000..942e84d --- /dev/null +++ b/elm/battlemap/src/Model/SelectCharacter.elm @@ -0,0 +1,42 @@ +module Model.SelectCharacter exposing (apply_to) + +import Dict + +import Character + +import Battlemap + +import Model +import Event +import Error + +make_it_so : Model.Type -> Character.Ref -> Model.Type +make_it_so model char_id = + case (Dict.get char_id model.characters) of + (Just char) -> + {model | + state = Model.MovingCharacterWithClick, + selection = (Model.SelectedCharacter char_id), + battlemap = + (Battlemap.set_navigator + (Character.get_location char) + (Character.get_movement_points char) + (Character.get_attack_range char) + (\e -> True) -- TODO: check for characters. + model.battlemap + ) + } + + Nothing -> + (Model.invalidate + model + (Error.new + Error.Programming + "SelectCharacter: Unknown char selected." + ) + ) + +apply_to : Model.Type -> Character.Ref -> Model.Type +apply_to model char_id = + case (Model.get_state model) of + _ -> (make_it_so model char_id) diff --git a/elm/battlemap/src/Update/SelectTile.elm b/elm/battlemap/src/Model/SelectTile.elm index cc2af35..9a01e77 100644 --- a/elm/battlemap/src/Update/SelectTile.elm +++ b/elm/battlemap/src/Model/SelectTile.elm @@ -1,4 +1,4 @@ -module Update.SelectTile exposing (apply_to) +module Model.SelectTile exposing (apply_to) import Dict @@ -7,12 +7,10 @@ import Character import Battlemap import Battlemap.Direction import Battlemap.Location -import Battlemap.Navigator import Battlemap.Tile -import Battlemap.RangeIndicator -import Update.DirectionRequest -import Update.EndTurn +import Model.RequestDirection +import Model.EndTurn import Model import Error @@ -75,7 +73,7 @@ go_to_tile model loc_ref = ) ) then - (Update.EndTurn.apply_to new_model) + (Model.EndTurn.apply_to new_model) else {new_model | state = Model.MovingCharacterWithClick} diff --git a/elm/battlemap/src/Update.elm b/elm/battlemap/src/Update.elm index 0947e99..c6146e1 100644 --- a/elm/battlemap/src/Update.elm +++ b/elm/battlemap/src/Update.elm @@ -3,11 +3,10 @@ module Update exposing (update) import Event import Model - -import Update.DirectionRequest -import Update.SelectTile -import Update.SelectCharacter -import Update.EndTurn +import Model.RequestDirection +import Model.SelectTile +import Model.SelectCharacter +import Model.EndTurn update : Event.Type -> Model.Type -> Model.Type update event model = @@ -15,14 +14,14 @@ update event model = new_model = (Model.clear_error model) in case event of - (Event.DirectionRequest d) -> - (Update.DirectionRequest.apply_to new_model d) + (Event.DirectionRequested d) -> + (Model.DirectionRequest.apply_to new_model d) - (Event.SelectTile loc) -> - (Update.SelectTile.apply_to new_model loc) + (Event.TileSelected loc) -> + (Model.SelectTile.apply_to new_model loc) - (Event.SelectCharacter char_id) -> - (Update.SelectCharacter.apply_to new_model char_id) + (Event.CharacterSelected char_id) -> + (Model.SelectCharacter.apply_to new_model char_id) - Event.EndTurn -> - (Update.EndTurn.apply_to new_model) + Event.TurnEnded -> + (Model.EndTurn.apply_to new_model) diff --git a/elm/battlemap/src/Update/EndTurn.elm b/elm/battlemap/src/Update/EndTurn.elm deleted file mode 100644 index ce9da28..0000000 --- a/elm/battlemap/src/Update/EndTurn.elm +++ /dev/null @@ -1,81 +0,0 @@ -module Update.EndTurn exposing (apply_to) - -import Dict - -import Battlemap -import Battlemap.Direction -import Battlemap.Navigator -import Battlemap.Tile - -import Model - -import Error - -make_it_so : Model.Type -> Model.Type -make_it_so model = - case model.selection of - Nothing -> - (Model.invalidate - model - (Error.new - Error.Programming - "EndTurn: model moving char, no selection." - ) - ) - (Just selection) -> - case (Dict.get selection.character model.characters) of - Nothing -> - (Model.invalidate - model - (Error.new - Error.Programming - "EndTurn: model moving char, unknown char selected." - ) - ) - (Just char) -> - {model | - state = Model.Default, - selection = Nothing, - battlemap = - (Battlemap.apply_to_all_tiles - (Battlemap.apply_to_tile_unsafe - (Battlemap.apply_to_tile_unsafe - model.battlemap - char.location - (\t -> {t | char_level = Nothing}) - ) - selection.navigator.current_location - (\t -> {t | char_level = (Just selection.character)}) - ) - (Battlemap.Tile.reset) - ), - characters = - (Dict.update - selection.character - (\mc -> - case mc of - Nothing -> Nothing - (Just c) -> - (Just - {c | - location = selection.navigator.current_location - } - ) - ) - model.characters - ) - } - -apply_to : Model.Type -> Model.Type -apply_to model = - case (Model.get_state model) of - Model.MovingCharacterWithButtons -> (make_it_so model) - Model.MovingCharacterWithClick -> (make_it_so model) - _ -> - (Model.invalidate - model - (Error.new - Error.IllegalAction - "This can only be done while moving a character." - ) - ) diff --git a/elm/battlemap/src/Update/SelectCharacter.elm b/elm/battlemap/src/Update/SelectCharacter.elm deleted file mode 100644 index 570f82c..0000000 --- a/elm/battlemap/src/Update/SelectCharacter.elm +++ /dev/null @@ -1,95 +0,0 @@ -module Update.SelectCharacter exposing (apply_to) - -import Dict - -import Character - -import Battlemap -import Battlemap.Direction -import Battlemap.Location -import Battlemap.Navigator -import Battlemap.Tile -import Battlemap.RangeIndicator - -import Model -import Event -import Error - -display_range : ( - Int -> - Battlemap.Location.Ref -> - Battlemap.RangeIndicator.Type -> - Battlemap.Type -> - Battlemap.Type - ) -display_range dist loc_ref indicator bmap = - (Battlemap.apply_to_tile_unsafe - bmap - (Battlemap.Location.from_ref loc_ref) - (\e -> - {e | - mod_level = - ( - if (indicator.distance <= dist) - then - (Just Battlemap.Tile.CanBeReached) - else - (Just Battlemap.Tile.CanBeAttacked) - ) - } - ) - ) - - -make_it_so : Model.Type -> Character.Ref -> Model.Type -make_it_so model char_id = - case (Dict.get char_id model.characters) of - Nothing -> - (Model.invalidate - model - (Error.new - Error.Programming - "SelectCharacter: Unknown char selected." - ) - ) - (Just char) -> - let - new_range_indicator = - (Battlemap.RangeIndicator.generate - model.battlemap - char.location - char.movement_points - (char.movement_points + char.atk_dist) - ) - in - {model | - state = Model.MovingCharacterWithClick, - battlemap = - ( - (Dict.foldl - (display_range char.movement_points) - (Battlemap.apply_to_all_tiles - model.battlemap - (Battlemap.Tile.reset) - ) - new_range_indicator - ) - ), - selection = - (Just - { - character = char_id, - navigator = - (Battlemap.Navigator.new - char.location - char.movement_points - ), - range_indicator = new_range_indicator - } - ) - } - -apply_to : Model.Type -> Character.Ref -> Model.Type -apply_to model char_id = - case (Model.get_state model) of - _ -> (make_it_so model char_id) diff --git a/elm/battlemap/src/Util/Array.elm b/elm/battlemap/src/Util/Array.elm index 8088244..69d329c 100644 --- a/elm/battlemap/src/Util/Array.elm +++ b/elm/battlemap/src/Util/Array.elm @@ -1,14 +1,25 @@ -module Util.Array exposing (update) +module Util.Array exposing (update, update_unsafe) import Array update : ( Int -> ((Maybe t) -> (Maybe t)) -> - (Array t) -> - (Array t) + (Array.Array t) -> + (Array.Array t) ) update index fun array = case (fun (Array.get index array)) of Nothing -> array (Just e) -> (Array.set index e array) + +update_unsafe : ( + Int -> + (t -> t) -> + (Array.Array t) -> + (Array.Array t) + ) +update_unsafe index fun array = + case (Array.get index array) of + Nothing -> array + (Just e) -> (Array.set index (fun e) array) diff --git a/elm/battlemap/src/View/Controls.elm b/elm/battlemap/src/View/Controls.elm index be698bf..f5851a9 100644 --- a/elm/battlemap/src/View/Controls.elm +++ b/elm/battlemap/src/View/Controls.elm @@ -12,7 +12,7 @@ direction_button dir label = (Html.button [ (Html.Events.onClick - (Event.DirectionRequest dir) + (Event.DirectionRequested dir) ) ] [ (Html.text label) ] @@ -21,7 +21,7 @@ direction_button dir label = end_turn_button : (Html.Html Event.Type) end_turn_button = (Html.button - [ (Html.Events.onClick Event.EndTurn) ] + [ (Html.Events.onClick Event.TurnEnded) ] [ (Html.text "End Turn") ] ) diff --git a/elm/battlemap/src/View/Status.elm b/elm/battlemap/src/View/Status.elm index 5fcc663..de2a167 100644 --- a/elm/battlemap/src/View/Status.elm +++ b/elm/battlemap/src/View/Status.elm @@ -4,6 +4,9 @@ import Dict import Html +import Battlemap +import Character + import Error import Event import Model @@ -11,20 +14,24 @@ import Model moving_character_text : Model.Type -> String moving_character_text model = case model.selection of - Nothing -> "Error: no model.selection." - (Just selection) -> - case (Dict.get selection.character model.characters) of + (Model.SelectedCharacter char_id) -> + case (Dict.get char_id model.characters) of Nothing -> "Error: Unknown character selected." (Just char) -> ( "Controlling " ++ char.name ++ ": " - ++ (toString selection.navigator.remaining_points) + ++ (toString + (Battlemap.get_navigator_remaining_points + model.battlemap + ) + ) ++ "/" - ++ (toString char.movement_points) + ++ (toString (Character.get_movement_points char)) ++ " movement points remaining." ) + _ -> "Error: model.selection does not match its state." view : Model.Type -> (Html.Html Event.Type) view model = |