| summaryrefslogtreecommitdiff |
diff options
Diffstat (limited to 'src')
35 files changed, 1881 insertions, 0 deletions
diff --git a/src/battlemap/Makefile b/src/battlemap/Makefile new file mode 100644 index 0000000..02cae24 --- /dev/null +++ b/src/battlemap/Makefile @@ -0,0 +1,16 @@ +ELM_CC = elm-make --warn + +SRC_DIR = src +WWW_DIR = www +WWW_SCRIPT_DIR = $(WWW_DIR)/script + +MAIN_MODULE = $(SRC_DIR)/Main.elm +SUB_MODULES = $(shell find $(SRC_DIR) -type f | grep "elm$$") + +$(WWW_SCRIPT_DIR)/main.js: $(MAIN_MODULE) $(SUB_MODULES) + $(ELM_CC) $(MAIN_MODULE) --output $@ + +build: $(WWW_SCRIPT_DIR)/main.js + +clean: + rm -f $(WWW_SCRIPT_DIR)/main.js diff --git a/src/battlemap/elm-package.json b/src/battlemap/elm-package.json new file mode 100644 index 0000000..7c1672e --- /dev/null +++ b/src/battlemap/elm-package.json @@ -0,0 +1,15 @@ +{ + "version": "1.0.0", + "summary": "helpful summary of your project, less than 80 characters", + "repository": "https://github.com/nsensfel/tacticians-client.git", + "license": "Apache 2.0", + "source-directories": [ + "src" + ], + "exposed-modules": [], + "dependencies": { + "elm-lang/core": "5.1.1 <= v < 6.0.0", + "elm-lang/html": "2.0.0 <= v < 3.0.0" + }, + "elm-version": "0.18.0 <= v < 0.19.0" +} diff --git a/src/battlemap/src/Battlemap.elm b/src/battlemap/src/Battlemap.elm new file mode 100644 index 0000000..d2e4523 --- /dev/null +++ b/src/battlemap/src/Battlemap.elm @@ -0,0 +1,142 @@ +module Battlemap exposing + ( + Type, + reset, + get_navigator_remaining_points, + get_tiles, + set_navigator, + 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 + +-------------------------------------------------------------------------------- +-- 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) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_tiles : Type -> (Array.Array Battlemap.Tile.Type) +get_tiles bmap = bmap.content + +reset : Type -> Type +reset bmap = + {bmap | + 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 -> + (Battlemap.Location.Type -> Bool) -> + Type -> + Type + ) +set_navigator start_loc movement_points attack_range can_cross bmap = + {bmap | + navigator = + (Just + (Battlemap.Navigator.new + start_loc + movement_points + attack_range + (\loc -> ((can_cross loc) && (has_location bmap loc))) + ) + ) + } + +try_adding_step_to_navigator : ( + Type -> + (Battlemap.Location.Type -> Bool) -> + Battlemap.Direction.Type -> + (Maybe Type) + ) +try_adding_step_to_navigator bmap can_cross dir = + case bmap.navigator of + (Just navigator) -> + let + new_navigator = + (Battlemap.Navigator.try_adding_step + navigator + dir + (\loc -> ((can_cross loc) && (has_location bmap loc))) + (\loc -> + case + (Array.get (location_to_index bmap loc) bmap.content) + of + (Just tile) -> (Battlemap.Tile.get_cost tile) + Nothing -> 0 + ) + ) + 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 new file mode 100644 index 0000000..5aad141 --- /dev/null +++ b/src/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/src/battlemap/src/Battlemap/Location.elm b/src/battlemap/src/Battlemap/Location.elm new file mode 100644 index 0000000..36f0c4d --- /dev/null +++ b/src/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/src/battlemap/src/Battlemap/Marker.elm b/src/battlemap/src/Battlemap/Marker.elm new file mode 100644 index 0000000..ebefce6 --- /dev/null +++ b/src/battlemap/src/Battlemap/Marker.elm @@ -0,0 +1,5 @@ +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 new file mode 100644 index 0000000..6687b18 --- /dev/null +++ b/src/battlemap/src/Battlemap/Navigator.elm @@ -0,0 +1,141 @@ +module Battlemap.Navigator exposing + ( + Type, + Summary, + new, + get_current_location, + get_remaining_points, + get_range_markers, + get_summary, + 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 -> Bool) -> Type + ) +new start_loc mov_dist atk_dist can_cross_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 + (can_cross_fun) + ) + } + +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) + +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 + ) + ) + } + +try_adding_step : ( + Type -> + Battlemap.Direction.Type -> + (Battlemap.Location.Type -> Bool) -> + (Battlemap.Location.Type -> Int) -> + (Maybe Type) + ) +try_adding_step navigator dir can_cross cost_fun = + case + (Battlemap.Navigator.Path.try_following_direction + can_cross + 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 new file mode 100644 index 0000000..9d7a17b --- /dev/null +++ b/src/battlemap/src/Battlemap/Navigator/Move.elm @@ -0,0 +1,157 @@ +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 new file mode 100644 index 0000000..53e12c0 --- /dev/null +++ b/src/battlemap/src/Battlemap/Navigator/Path.elm @@ -0,0 +1,168 @@ +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 + +-------------------------------------------------------------------------------- +-- 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 -> Bool) -> + (Battlemap.Location.Type -> Int) -> + (Maybe Type) -> + Battlemap.Direction.Type -> + (Maybe Type) + ) +try_following_direction can_cross cost_fun maybe_path dir = + case maybe_path of + (Just path) -> + let + next_location = + (Battlemap.Location.neighbor + path.current_location + dir + ) + in + if (can_cross next_location) + then + if (has_been_to path next_location) + then + (try_backtracking_to path dir next_location) + else + (try_moving_to + path + dir + next_location + (cost_fun next_location) + ) + else + Nothing + Nothing -> Nothing diff --git a/src/battlemap/src/Battlemap/Navigator/RangeIndicator.elm b/src/battlemap/src/Battlemap/Navigator/RangeIndicator.elm new file mode 100644 index 0000000..a8cac8e --- /dev/null +++ b/src/battlemap/src/Battlemap/Navigator/RangeIndicator.elm @@ -0,0 +1,287 @@ +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 Util.List + +type alias Type = + { + distance: Int, + path: (List Battlemap.Direction.Type), + node_cost: Int, + marker: Battlemap.Marker.Type + } + +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, + marker = Battlemap.Marker.CanAttack + } + ) + remaining + ) + in + (search + (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 + 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.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 can_cross_fun location dist grid result = + case (Util.List.pop grid) of + Nothing -> result + (Just (head, tail)) -> + if (can_cross_fun head) + then + -- TODO: test if the current char can cross that tile. + -- TODO: get tile cost. + (grid_to_range_indicators + (can_cross_fun) + 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, + marker = Battlemap.Marker.CanGoTo + } + result + ) + ) + else + (grid_to_range_indicators (can_cross_fun) location dist tail result) + +generate : ( + Battlemap.Location.Type -> + Int -> + Int -> + (Battlemap.Location.Type -> Bool) -> + (Dict.Dict Battlemap.Location.Ref Type) + ) +generate location dist atk_dist can_cross_fun = + (search + Dict.empty + (grid_to_range_indicators + (can_cross_fun) + location + atk_dist + (generate_grid location atk_dist (-atk_dist) []) + Dict.empty + ) + dist + atk_dist + ) + +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 new file mode 100644 index 0000000..255310a --- /dev/null +++ b/src/battlemap/src/Battlemap/Tile.elm @@ -0,0 +1,25 @@ +module Battlemap.Tile exposing + ( + Type, + get_location, + get_icon_id, + get_cost + ) + +import Battlemap.Location + +type alias Type = + { + location : Battlemap.Location.Type, + icon_id : String, + crossing_cost : Int + } + +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 new file mode 100644 index 0000000..1b4d1a1 --- /dev/null +++ b/src/battlemap/src/Character.elm @@ -0,0 +1,44 @@ +module Character exposing + ( + Type, + Ref, + get_ref, + get_icon_id, + get_location, + set_location, + get_movement_points, + get_attack_range + ) + +import Battlemap.Location + +type alias Type = + { + id : String, + name : String, + icon : String, + portrait : String, + location : Battlemap.Location.Type, + movement_points : Int, + atk_dist : Int + } + +type alias Ref = String + +get_ref : Type -> Ref +get_ref c = c.id + +get_icon_id : Type -> String +get_icon_id c = c.icon + +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/src/battlemap/src/Error.elm b/src/battlemap/src/Error.elm new file mode 100644 index 0000000..581bb24 --- /dev/null +++ b/src/battlemap/src/Error.elm @@ -0,0 +1,29 @@ +module Error exposing (Type, Mode(..), new, to_string) + +type Mode = + IllegalAction + | Programming + +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): " + ) + ++ e.message + ) + diff --git a/src/battlemap/src/Event.elm b/src/battlemap/src/Event.elm new file mode 100644 index 0000000..5debff1 --- /dev/null +++ b/src/battlemap/src/Event.elm @@ -0,0 +1,12 @@ +module Event exposing (Type(..)) + +import Battlemap.Direction +import Battlemap.Location + +import Character + +type Type = + DirectionRequested Battlemap.Direction.Type + | TileSelected Battlemap.Location.Ref + | CharacterSelected Character.Ref + | TurnEnded diff --git a/src/battlemap/src/Init.elm b/src/battlemap/src/Init.elm new file mode 100644 index 0000000..25509d1 --- /dev/null +++ b/src/battlemap/src/Init.elm @@ -0,0 +1,9 @@ +module Init exposing (init) + +import Model +import Event + +import Shim.Model + +init : (Model.Type, (Cmd Event.Type)) +init = ((Shim.Model.generate), Cmd.none) diff --git a/src/battlemap/src/Main.elm b/src/battlemap/src/Main.elm new file mode 100644 index 0000000..5a9d843 --- /dev/null +++ b/src/battlemap/src/Main.elm @@ -0,0 +1,20 @@ +import Html + +import Model +import Event + +import Init +import Subscriptions +import View +import Update + +main : (Program Never Model.Type Event.Type) +main = + (Html.program + { + init = Init.init, + view = View.view, + update = Update.update, + subscriptions = Subscriptions.subscriptions + } + ) diff --git a/src/battlemap/src/Model.elm b/src/battlemap/src/Model.elm new file mode 100644 index 0000000..ed067d3 --- /dev/null +++ b/src/battlemap/src/Model.elm @@ -0,0 +1,58 @@ +module Model exposing + ( + Type, + Selection(..), + State(..), + get_state, + invalidate, + reset, + clear_error + ) + +import Dict + +import Battlemap +import Battlemap.Location + +import Error + +import Character + +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: Selection + } + +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, + selection = None + } + +invalidate : Type -> Error.Type -> Type +invalidate model err = {model | error = (Just err)} + +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 new file mode 100644 index 0000000..441f3b7 --- /dev/null +++ b/src/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.try_getting_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/src/battlemap/src/Model/RequestDirection.elm b/src/battlemap/src/Model/RequestDirection.elm new file mode 100644 index 0000000..cf600e6 --- /dev/null +++ b/src/battlemap/src/Model/RequestDirection.elm @@ -0,0 +1,81 @@ +module Model.RequestDirection exposing (apply_to) + +import Dict + +import Battlemap +import Battlemap.Direction +import Battlemap.Location + + +import Character + +import Model +import Error + +make_it_so : Model.Type -> Battlemap.Direction.Type -> Model.Type +make_it_so model dir = + case model.selection of + (Model.SelectedCharacter char_id) -> + let + new_bmap = + (Battlemap.try_adding_step_to_navigator + model.battlemap + (\loc -> + (List.all + (\char -> + ( + ((Character.get_ref char) == char_id) + || + ( + (Battlemap.Location.get_ref + (Character.get_location char) + ) + /= + (Battlemap.Location.get_ref loc) + ) + ) + ) + (Dict.values model.characters) + ) + ) + dir + ) + in + case new_bmap of + (Just bmap) -> + {model | + state = Model.MovingCharacterWithButtons, + battlemap = 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 = + case (Model.get_state model) of + Model.MovingCharacterWithButtons -> (make_it_so model dir) + Model.MovingCharacterWithClick -> (make_it_so model 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 new file mode 100644 index 0000000..7cc2102 --- /dev/null +++ b/src/battlemap/src/Model/SelectCharacter.elm @@ -0,0 +1,41 @@ +module Model.SelectCharacter exposing (apply_to) + +import Dict + +import Character + +import Battlemap + +import Model +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/src/battlemap/src/Model/SelectTile.elm b/src/battlemap/src/Model/SelectTile.elm new file mode 100644 index 0000000..0fe30fa --- /dev/null +++ b/src/battlemap/src/Model/SelectTile.elm @@ -0,0 +1,62 @@ +module Model.SelectTile exposing (apply_to) + +import Battlemap +import Battlemap.Direction +import Battlemap.Location + +import Model.RequestDirection +import Model.EndTurn + +import Model +import Error + +autopilot : Battlemap.Direction.Type -> Model.Type -> Model.Type +autopilot dir model = + (Model.RequestDirection.apply_to model dir) + +go_to_tile : Model.Type -> Battlemap.Location.Ref -> Model.Type +go_to_tile model 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 (model.state == Model.MovingCharacterWithClick) + then + -- And we just clicked on that tile. + (Model.EndTurn.apply_to model) + else + -- And we didn't just click on that tile. + {model | state = Model.MovingCharacterWithClick} + 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 path) + in + {new_model | state = Model.MovingCharacterWithClick} + + Nothing -> -- Clicked outside of the range indicator + (Model.reset model model.characters) + Nothing -> -- Clicked outside of the range indicator + (Model.reset model model.characters) + +apply_to : Model.Type -> Battlemap.Location.Ref -> Model.Type +apply_to model loc_ref = + case (Model.get_state model) of + Model.MovingCharacterWithButtons -> (go_to_tile model loc_ref) + Model.MovingCharacterWithClick -> (go_to_tile model loc_ref) + _ -> + (Model.invalidate + model + (Error.new + Error.IllegalAction + "This can only be done while moving a character." + ) + ) diff --git a/src/battlemap/src/Shim/Battlemap.elm b/src/battlemap/src/Shim/Battlemap.elm new file mode 100644 index 0000000..5a2e29b --- /dev/null +++ b/src/battlemap/src/Shim/Battlemap.elm @@ -0,0 +1,12 @@ +module Shim.Battlemap exposing (generate) + +import Shim.Battlemap.Tile + +--generate : Battlemap.Type +generate = + { + width = 16, + height = 16, + content = (Shim.Battlemap.Tile.generate 16), + navigator = Nothing + } diff --git a/src/battlemap/src/Shim/Battlemap/Tile.elm b/src/battlemap/src/Shim/Battlemap/Tile.elm new file mode 100644 index 0000000..1e11cb5 --- /dev/null +++ b/src/battlemap/src/Shim/Battlemap/Tile.elm @@ -0,0 +1,44 @@ +module Shim.Battlemap.Tile exposing (generate) + +import Array +import List + +import Battlemap.Tile + +from_int : Int -> Int -> (Int, Int) -> Battlemap.Tile.Type +from_int map_width index (icon_id, cost) = + { + location = + { + x = (index % map_width), + y = (index // map_width) + }, + icon_id = (toString icon_id), + crossing_cost = cost + } + +generate : Int -> (Array.Array Battlemap.Tile.Type) +generate map_width = + let + as_int_list = + [ + (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (1, 2), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (1, 2), (1, 2), (1, 2), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (1, 2), (1, 2), (1, 2), (1, 2), (1, 2), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (1, 2), (1, 2), (1, 2), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (1, 2), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), + (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1), (2, 99), (0, 1), (0, 1), (0, 1), (0, 1), (0, 1) + ] + as_list = (List.indexedMap (from_int map_width) as_int_list) + in + (Array.fromList as_list) diff --git a/src/battlemap/src/Shim/Model.elm b/src/battlemap/src/Shim/Model.elm new file mode 100644 index 0000000..f82a0d3 --- /dev/null +++ b/src/battlemap/src/Shim/Model.elm @@ -0,0 +1,54 @@ +module Shim.Model exposing (generate) + +import Dict + +import Model + +import Shim.Battlemap + +--generate : Model.Type +generate = + { + state = Model.Default, + selection = Model.None, + error = Nothing, + battlemap = (Shim.Battlemap.generate), + characters = + (Dict.insert + "2" + { + id = "2", + name = "Char2", + icon = "Icon2", + portrait = "Portrait2", + location = {x = 0, y = 1}, + movement_points = 5, + atk_dist = 1 + } + (Dict.insert + "1" + { + id = "1", + name = "Char1", + icon = "Icon1", + portrait = "Portrait1", + location = {x = 1, y = 0}, + movement_points = 4, + atk_dist = 2 + } + (Dict.insert + "0" + { + id = "0", + name = "Char0", + icon = "Icon0", + portrait = "Portrait0", + location = {x = 0, y = 0}, + movement_points = 3, + atk_dist = 1 + } + Dict.empty + ) + ) + ) + } diff --git a/src/battlemap/src/Subscriptions.elm b/src/battlemap/src/Subscriptions.elm new file mode 100644 index 0000000..83df587 --- /dev/null +++ b/src/battlemap/src/Subscriptions.elm @@ -0,0 +1,7 @@ +module Subscriptions exposing (..) + +import Model +import Event + +subscriptions : Model.Type -> (Sub Event.Type) +subscriptions model = Sub.none diff --git a/src/battlemap/src/Update.elm b/src/battlemap/src/Update.elm new file mode 100644 index 0000000..7ee61a3 --- /dev/null +++ b/src/battlemap/src/Update.elm @@ -0,0 +1,27 @@ +module Update exposing (update) + +import Event + +import Model +import Model.RequestDirection +import Model.SelectTile +import Model.SelectCharacter +import Model.EndTurn + +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), Cmd.none) + + (Event.CharacterSelected char_id) -> + ((Model.SelectCharacter.apply_to new_model char_id), Cmd.none) + + Event.TurnEnded -> + ((Model.EndTurn.apply_to new_model), Cmd.none) diff --git a/src/battlemap/src/Util/Array.elm b/src/battlemap/src/Util/Array.elm new file mode 100644 index 0000000..69d329c --- /dev/null +++ b/src/battlemap/src/Util/Array.elm @@ -0,0 +1,25 @@ +module Util.Array exposing (update, update_unsafe) + +import Array + +update : ( + Int -> + ((Maybe t) -> (Maybe 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/src/battlemap/src/Util/List.elm b/src/battlemap/src/Util/List.elm new file mode 100644 index 0000000..c4db397 --- /dev/null +++ b/src/battlemap/src/Util/List.elm @@ -0,0 +1,12 @@ +module Util.List exposing (pop) + +import List + +pop : List a -> (Maybe (a, List a)) +pop l = + case + ((List.head l), (List.tail l)) + of + (Nothing, _) -> Nothing + (_ , Nothing) -> Nothing + ((Just head), (Just tail)) -> (Just (head, tail)) diff --git a/src/battlemap/src/View.elm b/src/battlemap/src/View.elm new file mode 100644 index 0000000..8a956d1 --- /dev/null +++ b/src/battlemap/src/View.elm @@ -0,0 +1,33 @@ +module View exposing (view) + +import Dict +import Html + +import View.Battlemap + +import View.Controls +import View.Status + +import Event +import Model + +view : Model.Type -> (Html.Html Event.Type) +view model = + (Html.div + [] + [ + (Html.div + [] + (View.Controls.view) + ), + (View.Battlemap.get_html + model.battlemap + 32 + (Dict.values model.characters) + ), + (Html.div + [] + [ (View.Status.view model) ] + ) + ] + ) diff --git a/src/battlemap/src/View/Battlemap.elm b/src/battlemap/src/View/Battlemap.elm new file mode 100644 index 0000000..efe4d1e --- /dev/null +++ b/src/battlemap/src/View/Battlemap.elm @@ -0,0 +1,78 @@ +module View.Battlemap exposing (get_html) + +import Array + +import List + +import Html +import Html.Attributes +import Html.Events + +import Battlemap + +import Character + +import View.Battlemap.Tile +import View.Battlemap.Navigator + +import Event +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +char_on_map : Int -> Character.Type -> (Html.Html Event.Type) +char_on_map tile_size char = + let + char_loc = (Character.get_location char) + in + (Html.div + [ + (Html.Attributes.class "battlemap-character-icon"), + (Html.Attributes.class + ("asset-character-icon-" ++ (Character.get_icon_id char)) + ), + (Html.Events.onClick + (Event.CharacterSelected (Character.get_ref char)) + ), + (Html.Attributes.style + [ + ("top", ((toString (char_loc.y * tile_size)) ++ "px")), + ("left", ((toString (char_loc.x * tile_size)) ++ "px")) + ] + ) + ] + [ + ] + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_html : ( + Battlemap.Type -> + Int -> + (List Character.Type) -> + (Html.Html Event.Type) + ) +get_html battlemap tile_size characters = + (Html.div + [ + (Html.Attributes.class "battlemap-container") + ] + ( + (List.map + (View.Battlemap.Tile.get_html tile_size) + (Array.toList (Battlemap.get_tiles battlemap)) + ) + ++ + (List.map + (char_on_map tile_size) + characters + ) + ++ + case (Battlemap.try_getting_navigator_summary battlemap) of + (Just nav_summary) -> + (View.Battlemap.Navigator.get_html tile_size nav_summary) + + Nothing -> [(Html.text "")] + ) + ) diff --git a/src/battlemap/src/View/Battlemap/Navigator.elm b/src/battlemap/src/View/Battlemap/Navigator.elm new file mode 100644 index 0000000..4180e6d --- /dev/null +++ b/src/battlemap/src/View/Battlemap/Navigator.elm @@ -0,0 +1,17 @@ +module View.Battlemap.Navigator exposing (get_html) + +import Html +--import Html.Attributes +--import Html.Events + +--import Battlemap.Location +import Battlemap.Navigator + +import Event + +get_html : ( + Int -> + Battlemap.Navigator.Summary -> + (List (Html.Html Event.Type)) + ) +get_html tile_size nav_summary = [] diff --git a/src/battlemap/src/View/Battlemap/Tile.elm b/src/battlemap/src/View/Battlemap/Tile.elm new file mode 100644 index 0000000..d38d84e --- /dev/null +++ b/src/battlemap/src/View/Battlemap/Tile.elm @@ -0,0 +1,39 @@ +module View.Battlemap.Tile exposing (get_html) + +import Html +import Html.Attributes +import Html.Events + +import Battlemap.Tile +import Battlemap.Location + +import Event + +get_html : ( + Int -> + Battlemap.Tile.Type -> + (Html.Html Event.Type) + ) +get_html tile_size tile = + let + tile_loc = (Battlemap.Tile.get_location tile) + in + (Html.div + [ + (Html.Attributes.class "battlemap-tile-icon"), + (Html.Attributes.class + ("asset-tile-" ++ (toString (Battlemap.Tile.get_icon_id tile))) + ), + (Html.Events.onClick + (Event.TileSelected (Battlemap.Location.get_ref tile_loc)) + ), + (Html.Attributes.style + [ + ("top", ((toString (tile_loc.y * tile_size)) ++ "px")), + ("left", ((toString (tile_loc.x * tile_size)) ++ "px")) + ] + ) + ] + [ + ] + ) diff --git a/src/battlemap/src/View/Controls.elm b/src/battlemap/src/View/Controls.elm new file mode 100644 index 0000000..f5851a9 --- /dev/null +++ b/src/battlemap/src/View/Controls.elm @@ -0,0 +1,36 @@ +module View.Controls exposing (view) + +import Html +import Html.Events + +import Battlemap.Direction + +import Event + +direction_button : Battlemap.Direction.Type -> String -> (Html.Html Event.Type) +direction_button dir label = + (Html.button + [ + (Html.Events.onClick + (Event.DirectionRequested dir) + ) + ] + [ (Html.text label) ] + ) + +end_turn_button : (Html.Html Event.Type) +end_turn_button = + (Html.button + [ (Html.Events.onClick Event.TurnEnded) ] + [ (Html.text "End Turn") ] + ) + +view : (List (Html.Html Event.Type)) +view = + [ + (direction_button Battlemap.Direction.Left "Left"), + (direction_button Battlemap.Direction.Down "Down"), + (direction_button Battlemap.Direction.Up "Up"), + (direction_button Battlemap.Direction.Right "Right"), + (end_turn_button) + ] diff --git a/src/battlemap/src/View/Status.elm b/src/battlemap/src/View/Status.elm new file mode 100644 index 0000000..de2a167 --- /dev/null +++ b/src/battlemap/src/View/Status.elm @@ -0,0 +1,52 @@ +module View.Status exposing (view) + +import Dict + +import Html + +import Battlemap +import Character + +import Error +import Event +import Model + +moving_character_text : Model.Type -> String +moving_character_text model = + case model.selection of + (Model.SelectedCharacter char_id) -> + case (Dict.get char_id model.characters) of + Nothing -> "Error: Unknown character selected." + (Just char) -> + ( + "Controlling " + ++ char.name + ++ ": " + ++ (toString + (Battlemap.get_navigator_remaining_points + model.battlemap + ) + ) + ++ "/" + ++ (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 = + (Html.text + ( + (case model.state of + Model.Default -> "Click on a character to control it." + Model.MovingCharacterWithButtons -> (moving_character_text model) + Model.MovingCharacterWithClick -> (moving_character_text model) + Model.FocusingTile -> "Error: Unimplemented." + ) + ++ " " ++ + (case model.error of + Nothing -> "" + (Just error) -> (Error.to_string error) + ) + ) + ) diff --git a/src/battlemap/www/index.html b/src/battlemap/www/index.html new file mode 100644 index 0000000..f630b80 --- /dev/null +++ b/src/battlemap/www/index.html @@ -0,0 +1,9 @@ +<!DOCTYPE html> +<html> + <head> + </head> + <body> + <script src="script/main.js"></script> + <script>Elm.Main.fullscreen();</script> + </body> +</html> |