| summaryrefslogtreecommitdiff |
diff options
Diffstat (limited to 'elm')
28 files changed, 1503 insertions, 0 deletions
diff --git a/elm/battlemap/Makefile b/elm/battlemap/Makefile new file mode 100644 index 0000000..54b52d8 --- /dev/null +++ b/elm/battlemap/Makefile @@ -0,0 +1,11 @@ +ELM_CC = elm-make +SRC_DIR = src + +MAIN_MODULE = $(SRC_DIR)/Main.elm +SUB_MODULES = $(shell find $(SRC_DIR) -type f | grep "elm$$") + +index.html: $(MAIN_MODULE) $(SUB_MODULES) + $(ELM_CC) $(MAIN_MODULE) + +clean: + rm -f index.html diff --git a/elm/battlemap/elm-package.json b/elm/battlemap/elm-package.json new file mode 100644 index 0000000..bcb6f4a --- /dev/null +++ b/elm/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/user/project.git", + "license": "BSD3", + "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/elm/battlemap/src/Battlemap.elm b/elm/battlemap/src/Battlemap.elm new file mode 100644 index 0000000..309b538 --- /dev/null +++ b/elm/battlemap/src/Battlemap.elm @@ -0,0 +1,91 @@ +module Battlemap exposing + ( + Type, + apply_to_tile, + apply_to_tile_unsafe, + has_location, + apply_to_all_tiles + ) + +import Array + +import Battlemap.Tile +import Battlemap.Direction +import Battlemap.Location + +type alias Type = + { + width : Int, + height : Int, + content : (Array.Array Battlemap.Tile.Type) + } + +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) + ) + +apply_to_all_tiles : ( + Type -> (Battlemap.Tile.Type -> Battlemap.Tile.Type) -> Type + ) +apply_to_all_tiles bmap fun = + {bmap | + content = (Array.map fun bmap.content) + } + +apply_to_tile : ( + Type -> + Battlemap.Location.Type -> + (Battlemap.Tile.Type -> Battlemap.Tile.Type) -> + (Maybe Type) + ) +apply_to_tile bmap loc fun = + let + index = (location_to_index bmap loc) + at_index = (Array.get index bmap.content) + in + case at_index of + Nothing -> + Nothing + (Just tile) -> + (Just + {bmap | + content = + (Array.set + index + (fun tile) + bmap.content + ) + } + ) + +apply_to_tile_unsafe : ( + Type -> + Battlemap.Location.Type -> + (Battlemap.Tile.Type -> Battlemap.Tile.Type) -> + Type + ) +apply_to_tile_unsafe bmap loc fun = + let + index = (location_to_index bmap loc) + at_index = (Array.get index bmap.content) + in + case at_index of + Nothing -> bmap + (Just tile) -> + {bmap | + content = + (Array.set + index + (fun tile) + bmap.content + ) + } 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 + } diff --git a/elm/battlemap/src/Character.elm b/elm/battlemap/src/Character.elm new file mode 100644 index 0000000..41cfc84 --- /dev/null +++ b/elm/battlemap/src/Character.elm @@ -0,0 +1,20 @@ +module Character exposing (Type, Ref, get_ref) + +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 diff --git a/elm/battlemap/src/Error.elm b/elm/battlemap/src/Error.elm new file mode 100644 index 0000000..e2906dc --- /dev/null +++ b/elm/battlemap/src/Error.elm @@ -0,0 +1,5 @@ +module Error exposing (Type(..)) + +type Type = + IllegalAction + | Programming diff --git a/elm/battlemap/src/Event.elm b/elm/battlemap/src/Event.elm new file mode 100644 index 0000000..2c46360 --- /dev/null +++ b/elm/battlemap/src/Event.elm @@ -0,0 +1,13 @@ +module Event exposing (Type(..)) + +import Battlemap +import Battlemap.Direction +import Battlemap.Location + +import Character + +type Type = + DirectionRequest Battlemap.Direction.Type + | SelectTile Battlemap.Location.Ref + | SelectCharacter Character.Ref + | EndTurn diff --git a/elm/battlemap/src/Main.elm b/elm/battlemap/src/Main.elm new file mode 100644 index 0000000..c92f59c --- /dev/null +++ b/elm/battlemap/src/Main.elm @@ -0,0 +1,13 @@ +import Html +import View +import Shim.Model +import Update + +main = + (Html.beginnerProgram + { + model = Shim.Model.generate, + view = View.view, + update = Update.update + } + ) diff --git a/elm/battlemap/src/Model.elm b/elm/battlemap/src/Model.elm new file mode 100644 index 0000000..4303b6f --- /dev/null +++ b/elm/battlemap/src/Model.elm @@ -0,0 +1,38 @@ +module Model exposing (Type, CharacterSelection, State(..)) + +import Dict + +import Battlemap +import Battlemap.Navigator +import Battlemap.Location +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 + | Error Error.Type + | MovingCharacterWithButtons + | MovingCharacterWithClick + | FocusingTile + +type alias Type = + { + state: State, + battlemap: Battlemap.Type, + characters: (Dict.Dict Character.Ref Character.Type), + selection: (Maybe CharacterSelection) + } diff --git a/elm/battlemap/src/Shim/Battlemap.elm b/elm/battlemap/src/Shim/Battlemap.elm new file mode 100644 index 0000000..f35cb67 --- /dev/null +++ b/elm/battlemap/src/Shim/Battlemap.elm @@ -0,0 +1,11 @@ +module Shim.Battlemap exposing (generate) + +import Shim.Battlemap.Tile + +--generate : Battlemap.Type +generate = + { + width = 32, + height = 32, + content = (Shim.Battlemap.Tile.generate 32) + } diff --git a/elm/battlemap/src/Shim/Battlemap/Tile.elm b/elm/battlemap/src/Shim/Battlemap/Tile.elm new file mode 100644 index 0000000..4f5b40b --- /dev/null +++ b/elm/battlemap/src/Shim/Battlemap/Tile.elm @@ -0,0 +1,143 @@ +module Shim.Battlemap.Tile exposing (generate) + +import Array +import List + +import Battlemap.Location +import Battlemap.Direction +import Battlemap.Tile + +from_int : Int -> Int -> Int -> Battlemap.Tile.Type +from_int map_width index i = + let + location = + (Battlemap.Location.get_ref + { + x = (index % map_width), + y = (index // map_width) + } + ) + in + if (i >= 10) + then + { + location = location, + floor_level = (i - 10), + nav_level = Battlemap.Direction.None, + char_level = (Just (toString (i - 10))), + mod_level = Nothing + } + else + { + location = location, + floor_level = i, + nav_level = Battlemap.Direction.None, + char_level = Nothing, + mod_level = Nothing + } + + +generate : Int -> (Array.Array Battlemap.Tile.Type) +generate map_width = + let + as_int_list = + ( + [ + 10, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ++ [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 + ] + ) + as_list = (List.indexedMap (from_int map_width) as_int_list) + in + (Array.fromList as_list) diff --git a/elm/battlemap/src/Shim/Model.elm b/elm/battlemap/src/Shim/Model.elm new file mode 100644 index 0000000..03c2450 --- /dev/null +++ b/elm/battlemap/src/Shim/Model.elm @@ -0,0 +1,53 @@ +module Shim.Model exposing (generate) + +import Dict + +import Model + +import Shim.Battlemap + +--generate : Model.Type +generate = + { + state = Model.Default, + selection = 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/elm/battlemap/src/Update.elm b/elm/battlemap/src/Update.elm new file mode 100644 index 0000000..b6b2a80 --- /dev/null +++ b/elm/battlemap/src/Update.elm @@ -0,0 +1,25 @@ +module Update exposing (update) + +import Event + +import Model + +import Update.DirectionRequest +import Update.SelectTile +import Update.SelectCharacter +import Update.EndTurn + +update : Event.Type -> Model.Type -> Model.Type +update event model = + case event of + (Event.DirectionRequest d) -> + (Update.DirectionRequest.apply_to model d) + + (Event.SelectTile loc) -> + (Update.SelectTile.apply_to model loc) + + (Event.SelectCharacter char_id) -> + (Update.SelectCharacter.apply_to model char_id) + + Event.EndTurn -> + (Update.EndTurn.apply_to model) diff --git a/elm/battlemap/src/Update/DirectionRequest.elm b/elm/battlemap/src/Update/DirectionRequest.elm new file mode 100644 index 0000000..da32240 --- /dev/null +++ b/elm/battlemap/src/Update/DirectionRequest.elm @@ -0,0 +1,37 @@ +module Update.DirectionRequest exposing (apply_to) + +import Dict + +import Battlemap.Direction +import Battlemap.Navigator.Move + +import Model +import Error + +make_it_so : Model.Type -> Battlemap.Direction.Type -> Model.Type +make_it_so model dir = + case model.selection of + Nothing -> {model | state = (Model.Error Error.Programming)} + (Just selection) -> + let + (new_bmap, new_nav) = + (Battlemap.Navigator.Move.to + model.battlemap + selection.navigator + dir + (Dict.values model.characters) + ) + in + {model | + state = Model.MovingCharacterWithButtons, + battlemap = new_bmap, + selection = (Just {selection | navigator = new_nav}) + } + + +apply_to : Model.Type -> Battlemap.Direction.Type -> Model.Type +apply_to model dir = + case model.state of + Model.MovingCharacterWithButtons -> (make_it_so model dir) + Model.MovingCharacterWithClick -> (make_it_so model dir) + _ -> {model | state = (Model.Error Error.IllegalAction)} diff --git a/elm/battlemap/src/Update/EndTurn.elm b/elm/battlemap/src/Update/EndTurn.elm new file mode 100644 index 0000000..7172b2f --- /dev/null +++ b/elm/battlemap/src/Update/EndTurn.elm @@ -0,0 +1,61 @@ +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 | state = (Model.Error Error.Programming)} + (Just selection) -> + case (Dict.get selection.character model.characters) of + Nothing -> {model | state = (Model.Error Error.Programming)} + (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_tile) + ), + 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.state of + Model.MovingCharacterWithButtons -> (make_it_so model) + Model.MovingCharacterWithClick -> (make_it_so model) + _ -> {model | state = (Model.Error Error.IllegalAction)} + diff --git a/elm/battlemap/src/Update/SelectCharacter.elm b/elm/battlemap/src/Update/SelectCharacter.elm new file mode 100644 index 0000000..0e7b1c4 --- /dev/null +++ b/elm/battlemap/src/Update/SelectCharacter.elm @@ -0,0 +1,88 @@ +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 | state = (Model.Error Error.Programming)} + (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_tile) + ) + 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.state of + _ -> (make_it_so model char_id) diff --git a/elm/battlemap/src/Update/SelectTile.elm b/elm/battlemap/src/Update/SelectTile.elm new file mode 100644 index 0000000..aa89c30 --- /dev/null +++ b/elm/battlemap/src/Update/SelectTile.elm @@ -0,0 +1,80 @@ +module Update.SelectTile 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 Update.DirectionRequest +import Update.EndTurn + +import Model +import Error + +autopilot : Battlemap.Direction.Type -> Model.Type -> Model.Type +autopilot dir model = + (Update.DirectionRequest.apply_to model dir) + +go_to_tile : Model.Type -> Battlemap.Location.Ref -> Model.Type +go_to_tile model loc_ref = + case model.selection of + Nothing -> {model | state = (Model.Error Error.Programming)} + (Just selection) -> + case (Dict.get loc_ref selection.range_indicator) of + Nothing -> {model | state = Model.Default, selection = Nothing} + (Just indicator) -> + let + new_model = + (List.foldr + (autopilot) + {model | + battlemap = + (Battlemap.apply_to_all_tiles + model.battlemap + (Battlemap.Tile.set_direction + Battlemap.Direction.None + ) + ), + selection = + (Just + { + selection | + navigator = + (Battlemap.Navigator.reset + selection.navigator + ) + } + ) + } + indicator.path + ) + in + if + ( + (model.state == Model.MovingCharacterWithClick) + && + ( + (Battlemap.Location.get_ref + selection.navigator.current_location + ) + == loc_ref + ) + ) + then + (Update.EndTurn.apply_to new_model) + else + {new_model | state = model.state} + + +apply_to : Model.Type -> Battlemap.Location.Ref -> Model.Type +apply_to model loc_ref = + case model.state of + Model.MovingCharacterWithButtons -> (go_to_tile model loc_ref) + Model.MovingCharacterWithClick -> (go_to_tile model loc_ref) + _ -> {model | state = (Model.Error Error.IllegalAction)} diff --git a/elm/battlemap/src/Util/Array.elm b/elm/battlemap/src/Util/Array.elm new file mode 100644 index 0000000..8088244 --- /dev/null +++ b/elm/battlemap/src/Util/Array.elm @@ -0,0 +1,14 @@ +module Util.Array exposing (update) + +import Array + +update : ( + Int -> + ((Maybe t) -> (Maybe t)) -> + (Array t) -> + (Array t) + ) +update index fun array = + case (fun (Array.get index array)) of + Nothing -> array + (Just e) -> (Array.set index e array) diff --git a/elm/battlemap/src/Util/List.elm b/elm/battlemap/src/Util/List.elm new file mode 100644 index 0000000..c4db397 --- /dev/null +++ b/elm/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/elm/battlemap/src/View.elm b/elm/battlemap/src/View.elm new file mode 100644 index 0000000..3450f9c --- /dev/null +++ b/elm/battlemap/src/View.elm @@ -0,0 +1,32 @@ +module View exposing (view) + +import Html + +import Battlemap.Html + +import View.Controls +import View.Status + +import Event +import Update +import Model + +view : Model.Type -> (Html.Html Event.Type) +view model = + (Html.div + [] + [ + (Html.div + [] + (View.Controls.view) + ), + (Html.div + [] + [ (Battlemap.Html.view model.battlemap) ] + ), + (Html.div + [] + [ (View.Status.view model) ] + ) + ] + ) diff --git a/elm/battlemap/src/View/Controls.elm b/elm/battlemap/src/View/Controls.elm new file mode 100644 index 0000000..be698bf --- /dev/null +++ b/elm/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.DirectionRequest dir) + ) + ] + [ (Html.text label) ] + ) + +end_turn_button : (Html.Html Event.Type) +end_turn_button = + (Html.button + [ (Html.Events.onClick Event.EndTurn) ] + [ (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/elm/battlemap/src/View/Status.elm b/elm/battlemap/src/View/Status.elm new file mode 100644 index 0000000..a7beb28 --- /dev/null +++ b/elm/battlemap/src/View/Status.elm @@ -0,0 +1,42 @@ +module View.Status exposing (view) + +import Dict + +import Html + +import Error +import Event +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 + Nothing -> "Error: Unknown character selected." + (Just char) -> + ( + "Controlling " + ++ char.name + ++ ": " + ++ (toString selection.navigator.remaining_points) + ++ "/" + ++ (toString char.movement_points) + ++ " movement points remaining." + ) + +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." + (Model.Error Error.Programming) -> + "Error of programming, please report." + (Model.Error Error.IllegalAction) -> + "This cannot be done while in this state." + ) + ) |