| summaryrefslogtreecommitdiff |
diff options
Diffstat (limited to 'elm/battlemap/src/Battlemap')
| -rw-r--r-- | elm/battlemap/src/Battlemap/Direction.elm | 17 | ||||
| -rw-r--r-- | elm/battlemap/src/Battlemap/Html.elm | 100 | ||||
| -rw-r--r-- | elm/battlemap/src/Battlemap/Location.elm | 44 | ||||
| -rw-r--r-- | elm/battlemap/src/Battlemap/Navigator.elm | 44 | ||||
| -rw-r--r-- | elm/battlemap/src/Battlemap/Navigator/Move.elm | 153 | ||||
| -rw-r--r-- | elm/battlemap/src/Battlemap/RangeIndicator.elm | 260 | ||||
| -rw-r--r-- | elm/battlemap/src/Battlemap/Tile.elm | 45 |
7 files changed, 663 insertions, 0 deletions
diff --git a/elm/battlemap/src/Battlemap/Direction.elm b/elm/battlemap/src/Battlemap/Direction.elm new file mode 100644 index 0000000..5aad141 --- /dev/null +++ b/elm/battlemap/src/Battlemap/Direction.elm @@ -0,0 +1,17 @@ +module Battlemap.Direction exposing (Type(..), opposite_of) + +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 diff --git a/elm/battlemap/src/Battlemap/Html.elm b/elm/battlemap/src/Battlemap/Html.elm new file mode 100644 index 0000000..6506c0f --- /dev/null +++ b/elm/battlemap/src/Battlemap/Html.elm @@ -0,0 +1,100 @@ +module Battlemap.Html exposing (view) + +import Array + +import Html +import Html.Events + +import Battlemap +import Battlemap.Tile +import Battlemap.Direction + +import Event + +type alias GridBuilder = + { + row : (List (Html.Html Event.Type)), + columns : (List (Html.Html Event.Type)), + row_size : Int, + bmap : Battlemap.Type + } + +nav_level_to_text : Battlemap.Tile.Type -> String +nav_level_to_text t = + case t.nav_level of + Battlemap.Direction.Right -> "R" + Battlemap.Direction.Left -> "L" + Battlemap.Direction.Up -> "U" + Battlemap.Direction.Down -> "D" + Battlemap.Direction.None -> (toString t.floor_level) + +view_battlemap_cell : Battlemap.Tile.Type -> (Html.Html Event.Type) +view_battlemap_cell t = + case t.char_level of + Nothing -> + (Html.td + [ (Html.Events.onClick (Event.SelectTile t.location)) ] + [ + (Html.text + (case t.mod_level of + Nothing -> "[_]" + (Just Battlemap.Tile.CanBeReached) -> "[M]" + (Just Battlemap.Tile.CanBeAttacked) -> "[A]" + ) + ), + (Html.text (nav_level_to_text t)) + ] + ) + (Just char_id) -> + (Html.td + [ (Html.Events.onClick (Event.SelectCharacter char_id)) ] + [ + (Html.text ("[" ++ char_id ++ "]")), + (Html.text (nav_level_to_text t)) + ] + ) + + +foldr_to_html : Battlemap.Tile.Type -> GridBuilder -> GridBuilder +foldr_to_html t gb = + if (gb.row_size == gb.bmap.width) + then + {gb | + row = [(view_battlemap_cell t)], + row_size = 1, + columns = + ( + (Html.tr [] gb.row) :: gb.columns + ) + } + else + {gb | + row = ((view_battlemap_cell t) :: gb.row), + row_size = (gb.row_size + 1) + } + +grid_builder_to_html : GridBuilder -> (List (Html.Html Event.Type)) +grid_builder_to_html gb = + if (gb.row_size == 0) + then + gb.columns + else + ((Html.tr [] gb.row) :: gb.columns) + +view : Battlemap.Type -> (Html.Html Event.Type) +view battlemap = + (Html.table + [] + (grid_builder_to_html + (Array.foldr + (foldr_to_html) + { + row = [], + columns = [], + row_size = 0, + bmap = battlemap + } + battlemap.content + ) + ) + ) diff --git a/elm/battlemap/src/Battlemap/Location.elm b/elm/battlemap/src/Battlemap/Location.elm new file mode 100644 index 0000000..36f0c4d --- /dev/null +++ b/elm/battlemap/src/Battlemap/Location.elm @@ -0,0 +1,44 @@ +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/elm/battlemap/src/Battlemap/Navigator.elm b/elm/battlemap/src/Battlemap/Navigator.elm new file mode 100644 index 0000000..b040013 --- /dev/null +++ b/elm/battlemap/src/Battlemap/Navigator.elm @@ -0,0 +1,44 @@ +module Battlemap.Navigator exposing + ( + Type, + new, + reset + ) + +import Set + +import Battlemap +import Battlemap.Direction +import Battlemap.Location +import Battlemap.Tile + + +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 + } + +new : Battlemap.Location.Type -> Int -> Type +new start points = + { + current_location = start, + visited_locations = Set.empty, + previous_directions = [], + remaining_points = points, + starting_location = start, + starting_points = points + } + +reset : Type -> Type +reset nav = + {nav | + current_location = nav.starting_location, + visited_locations = Set.empty, + previous_directions = [], + remaining_points = nav.starting_points + } diff --git a/elm/battlemap/src/Battlemap/Navigator/Move.elm b/elm/battlemap/src/Battlemap/Navigator/Move.elm new file mode 100644 index 0000000..924f715 --- /dev/null +++ b/elm/battlemap/src/Battlemap/Navigator/Move.elm @@ -0,0 +1,153 @@ +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 -> (c.location == 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/elm/battlemap/src/Battlemap/RangeIndicator.elm b/elm/battlemap/src/Battlemap/RangeIndicator.elm new file mode 100644 index 0000000..9276e49 --- /dev/null +++ b/elm/battlemap/src/Battlemap/RangeIndicator.elm @@ -0,0 +1,260 @@ +module Battlemap.RangeIndicator exposing (Type, generate) + +import Dict +import List +import Debug + +import Battlemap +import Battlemap.Direction +import Battlemap.Location + +import Util.List + +type alias Type = + { + distance: Int, + path: (List Battlemap.Direction.Type), + node_cost: Int + } + +generate_row : ( + Battlemap.Location.Type -> + Int -> + Int -> + Int -> + (List Battlemap.Location.Type) -> + (List Battlemap.Location.Type) + ) +generate_row src max_x_mod curr_y curr_x_mod curr_row = + if (curr_x_mod > max_x_mod) + then + curr_row + else + (generate_row + src + max_x_mod + curr_y + (curr_x_mod + 1) + ({x = (src.x + curr_x_mod), y = curr_y} :: curr_row) + ) + +generate_grid : ( + Battlemap.Location.Type -> + Int -> + Int -> + (List Battlemap.Location.Type) -> + (List Battlemap.Location.Type) + ) +generate_grid src dist curr_y_mod curr_list = + if (curr_y_mod > dist) + then + curr_list + else + let + new_limit = (dist - (abs curr_y_mod)) + in + (generate_grid + src + dist + (curr_y_mod + 1) + ( + (generate_row + src + new_limit + (src.y + curr_y_mod) + (-new_limit) + [] + ) + ++ curr_list + ) + ) + +get_closest : ( + Battlemap.Location.Ref -> + Type -> + (Battlemap.Location.Ref, Type) -> + (Battlemap.Location.Ref, Type) + ) +get_closest ref indicator (prev_ref, prev_indicator) = + if (indicator.distance < prev_indicator.distance) + then + (ref, indicator) + else + (prev_ref, prev_indicator) + +handle_neighbors : ( + Battlemap.Location.Type -> + Int -> + Int -> + Type -> + (Dict.Dict Battlemap.Location.Ref Type) -> + (List Battlemap.Direction.Type) -> + (Dict.Dict Battlemap.Location.Ref Type) + ) +handle_neighbors loc dist atk_dist indicator remaining directions = + case (Util.List.pop directions) of + Nothing -> remaining + (Just (head, tail)) -> + let + neighbor_loc = (Battlemap.Location.neighbor loc head) + neighbor_indicator = + (Dict.get + (Battlemap.Location.get_ref neighbor_loc) + remaining + ) + in + case neighbor_indicator of + Nothing -> + (handle_neighbors + loc + dist + atk_dist + indicator + remaining + tail + ) + (Just neighbor) -> + let + is_attack_range = (indicator.distance >= dist) + new_dist = + ( + if (is_attack_range) + then + (indicator.distance + 1) + else + (indicator.distance + neighbor.node_cost) + ) + in + (handle_neighbors + loc + dist + atk_dist + indicator + ( + if + ( + (new_dist < neighbor.distance) + && (new_dist <= atk_dist) + ) + then + (Dict.insert + (Battlemap.Location.get_ref neighbor_loc) + {neighbor | + distance = new_dist, + path = (head :: indicator.path) + } + remaining + ) + else + remaining + ) + tail + ) + +search : ( + (Dict.Dict Battlemap.Location.Ref Type) -> + (Dict.Dict Battlemap.Location.Ref Type) -> + Int -> + Int -> + (Dict.Dict Battlemap.Location.Ref Type) + ) +search result remaining dist atk_dist = + if (Dict.isEmpty remaining) + then + result + else + let + (min_loc_ref, min) = + (Dict.foldl + (get_closest) + ( + (-1,-1), + { + distance = (atk_dist + 1), + path = [], + node_cost = 99 + } + ) + remaining + ) + in + (search + (Dict.insert min_loc_ref min result) + (handle_neighbors + (Battlemap.Location.from_ref min_loc_ref) + dist + atk_dist + min + (Dict.remove min_loc_ref remaining) + [ + Battlemap.Direction.Left, + Battlemap.Direction.Right, + Battlemap.Direction.Up, + Battlemap.Direction.Down + ] + ) + dist + atk_dist + ) + +grid_to_range_indicators : ( + Battlemap.Type -> + 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 = + case (Util.List.pop grid) of + Nothing -> result + (Just (head, tail)) -> + if (Battlemap.has_location battlemap head) + then + -- TODO: test if the current char can cross that tile. + -- TODO: get tile cost. + (grid_to_range_indicators + battlemap + location + dist + tail + (Dict.insert + (Battlemap.Location.get_ref head) + { + distance = + ( + if ((location.x == head.x) && (location.y == head.y)) + then + 0 + else + (dist + 1) + ), + path = [], + node_cost = 1 + } + result + ) + ) + else + (grid_to_range_indicators battlemap location dist tail result) + +generate : ( + Battlemap.Type -> + Battlemap.Location.Type -> + Int -> + Int -> + (Dict.Dict Battlemap.Location.Ref Type) + ) +generate battlemap location dist atk_dist = + (search + Dict.empty + (grid_to_range_indicators + battlemap + location + atk_dist + (generate_grid location atk_dist (-atk_dist) []) + Dict.empty + ) + dist + atk_dist + ) diff --git a/elm/battlemap/src/Battlemap/Tile.elm b/elm/battlemap/src/Battlemap/Tile.elm new file mode 100644 index 0000000..986cb2a --- /dev/null +++ b/elm/battlemap/src/Battlemap/Tile.elm @@ -0,0 +1,45 @@ +module Battlemap.Tile exposing + ( + Type, + TileModifier(..), + set_direction, + set_navigation, + reset_tile + ) + +import Battlemap.Direction +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_navigation : Battlemap.Direction.Type -> Type -> Type +set_navigation dir t = + {t | + nav_level = dir + } + +reset_tile : Type -> Type +reset_tile t = + {t | + nav_level = Battlemap.Direction.None, + mod_level = Nothing + } |