From e008855086d124f0de14eacc858ecb57d23e371c Mon Sep 17 00:00:00 2001 From: nsensfel Date: Thu, 19 Oct 2017 13:30:40 +0200 Subject: Starting a more modular approach for the website. --- Makefile | 29 ++- elm/battlemap/Makefile | 11 - elm/battlemap/elm-package.json | 15 -- elm/battlemap/src/Battlemap.elm | 142 ---------- elm/battlemap/src/Battlemap/Direction.elm | 17 -- elm/battlemap/src/Battlemap/Location.elm | 44 ---- elm/battlemap/src/Battlemap/Marker.elm | 5 - elm/battlemap/src/Battlemap/Navigator.elm | 141 ---------- elm/battlemap/src/Battlemap/Navigator/Move.elm | 157 ----------- elm/battlemap/src/Battlemap/Navigator/Path.elm | 168 ------------ .../src/Battlemap/Navigator/RangeIndicator.elm | 287 --------------------- elm/battlemap/src/Battlemap/Tile.elm | 25 -- elm/battlemap/src/Character.elm | 44 ---- elm/battlemap/src/Error.elm | 29 --- elm/battlemap/src/Event.elm | 12 - elm/battlemap/src/Init.elm | 9 - elm/battlemap/src/Main.elm | 20 -- elm/battlemap/src/Model.elm | 58 ----- elm/battlemap/src/Model/EndTurn.elm | 63 ----- elm/battlemap/src/Model/RequestDirection.elm | 81 ------ elm/battlemap/src/Model/SelectCharacter.elm | 41 --- elm/battlemap/src/Model/SelectTile.elm | 62 ----- elm/battlemap/src/Shim/Battlemap.elm | 12 - elm/battlemap/src/Shim/Battlemap/Tile.elm | 44 ---- elm/battlemap/src/Shim/Model.elm | 54 ---- elm/battlemap/src/Subscriptions.elm | 7 - elm/battlemap/src/Update.elm | 27 -- elm/battlemap/src/Util/Array.elm | 25 -- elm/battlemap/src/Util/List.elm | 12 - elm/battlemap/src/View.elm | 33 --- elm/battlemap/src/View/Battlemap.elm | 78 ------ elm/battlemap/src/View/Battlemap/Navigator.elm | 17 -- elm/battlemap/src/View/Battlemap/Tile.elm | 39 --- elm/battlemap/src/View/Controls.elm | 36 --- elm/battlemap/src/View/Status.elm | 52 ---- src/battlemap/Makefile | 16 ++ src/battlemap/elm-package.json | 15 ++ src/battlemap/src/Battlemap.elm | 142 ++++++++++ src/battlemap/src/Battlemap/Direction.elm | 17 ++ src/battlemap/src/Battlemap/Location.elm | 44 ++++ src/battlemap/src/Battlemap/Marker.elm | 5 + src/battlemap/src/Battlemap/Navigator.elm | 141 ++++++++++ src/battlemap/src/Battlemap/Navigator/Move.elm | 157 +++++++++++ src/battlemap/src/Battlemap/Navigator/Path.elm | 168 ++++++++++++ .../src/Battlemap/Navigator/RangeIndicator.elm | 287 +++++++++++++++++++++ src/battlemap/src/Battlemap/Tile.elm | 25 ++ src/battlemap/src/Character.elm | 44 ++++ src/battlemap/src/Error.elm | 29 +++ src/battlemap/src/Event.elm | 12 + src/battlemap/src/Init.elm | 9 + src/battlemap/src/Main.elm | 20 ++ src/battlemap/src/Model.elm | 58 +++++ src/battlemap/src/Model/EndTurn.elm | 63 +++++ src/battlemap/src/Model/RequestDirection.elm | 81 ++++++ src/battlemap/src/Model/SelectCharacter.elm | 41 +++ src/battlemap/src/Model/SelectTile.elm | 62 +++++ src/battlemap/src/Shim/Battlemap.elm | 12 + src/battlemap/src/Shim/Battlemap/Tile.elm | 44 ++++ src/battlemap/src/Shim/Model.elm | 54 ++++ src/battlemap/src/Subscriptions.elm | 7 + src/battlemap/src/Update.elm | 27 ++ src/battlemap/src/Util/Array.elm | 25 ++ src/battlemap/src/Util/List.elm | 12 + src/battlemap/src/View.elm | 33 +++ src/battlemap/src/View/Battlemap.elm | 78 ++++++ src/battlemap/src/View/Battlemap/Navigator.elm | 17 ++ src/battlemap/src/View/Battlemap/Tile.elm | 39 +++ src/battlemap/src/View/Controls.elm | 36 +++ src/battlemap/src/View/Status.elm | 52 ++++ src/battlemap/www/index.html | 9 + 70 files changed, 1901 insertions(+), 1876 deletions(-) delete mode 100644 elm/battlemap/Makefile delete mode 100644 elm/battlemap/elm-package.json delete mode 100644 elm/battlemap/src/Battlemap.elm delete mode 100644 elm/battlemap/src/Battlemap/Direction.elm delete mode 100644 elm/battlemap/src/Battlemap/Location.elm delete mode 100644 elm/battlemap/src/Battlemap/Marker.elm delete mode 100644 elm/battlemap/src/Battlemap/Navigator.elm delete mode 100644 elm/battlemap/src/Battlemap/Navigator/Move.elm delete mode 100644 elm/battlemap/src/Battlemap/Navigator/Path.elm delete mode 100644 elm/battlemap/src/Battlemap/Navigator/RangeIndicator.elm delete mode 100644 elm/battlemap/src/Battlemap/Tile.elm delete mode 100644 elm/battlemap/src/Character.elm delete mode 100644 elm/battlemap/src/Error.elm delete mode 100644 elm/battlemap/src/Event.elm delete mode 100644 elm/battlemap/src/Init.elm delete mode 100644 elm/battlemap/src/Main.elm delete mode 100644 elm/battlemap/src/Model.elm delete mode 100644 elm/battlemap/src/Model/EndTurn.elm delete mode 100644 elm/battlemap/src/Model/RequestDirection.elm delete mode 100644 elm/battlemap/src/Model/SelectCharacter.elm delete mode 100644 elm/battlemap/src/Model/SelectTile.elm delete mode 100644 elm/battlemap/src/Shim/Battlemap.elm delete mode 100644 elm/battlemap/src/Shim/Battlemap/Tile.elm delete mode 100644 elm/battlemap/src/Shim/Model.elm delete mode 100644 elm/battlemap/src/Subscriptions.elm delete mode 100644 elm/battlemap/src/Update.elm delete mode 100644 elm/battlemap/src/Util/Array.elm delete mode 100644 elm/battlemap/src/Util/List.elm delete mode 100644 elm/battlemap/src/View.elm delete mode 100644 elm/battlemap/src/View/Battlemap.elm delete mode 100644 elm/battlemap/src/View/Battlemap/Navigator.elm delete mode 100644 elm/battlemap/src/View/Battlemap/Tile.elm delete mode 100644 elm/battlemap/src/View/Controls.elm delete mode 100644 elm/battlemap/src/View/Status.elm create mode 100644 src/battlemap/Makefile create mode 100644 src/battlemap/elm-package.json create mode 100644 src/battlemap/src/Battlemap.elm create mode 100644 src/battlemap/src/Battlemap/Direction.elm create mode 100644 src/battlemap/src/Battlemap/Location.elm create mode 100644 src/battlemap/src/Battlemap/Marker.elm create mode 100644 src/battlemap/src/Battlemap/Navigator.elm create mode 100644 src/battlemap/src/Battlemap/Navigator/Move.elm create mode 100644 src/battlemap/src/Battlemap/Navigator/Path.elm create mode 100644 src/battlemap/src/Battlemap/Navigator/RangeIndicator.elm create mode 100644 src/battlemap/src/Battlemap/Tile.elm create mode 100644 src/battlemap/src/Character.elm create mode 100644 src/battlemap/src/Error.elm create mode 100644 src/battlemap/src/Event.elm create mode 100644 src/battlemap/src/Init.elm create mode 100644 src/battlemap/src/Main.elm create mode 100644 src/battlemap/src/Model.elm create mode 100644 src/battlemap/src/Model/EndTurn.elm create mode 100644 src/battlemap/src/Model/RequestDirection.elm create mode 100644 src/battlemap/src/Model/SelectCharacter.elm create mode 100644 src/battlemap/src/Model/SelectTile.elm create mode 100644 src/battlemap/src/Shim/Battlemap.elm create mode 100644 src/battlemap/src/Shim/Battlemap/Tile.elm create mode 100644 src/battlemap/src/Shim/Model.elm create mode 100644 src/battlemap/src/Subscriptions.elm create mode 100644 src/battlemap/src/Update.elm create mode 100644 src/battlemap/src/Util/Array.elm create mode 100644 src/battlemap/src/Util/List.elm create mode 100644 src/battlemap/src/View.elm create mode 100644 src/battlemap/src/View/Battlemap.elm create mode 100644 src/battlemap/src/View/Battlemap/Navigator.elm create mode 100644 src/battlemap/src/View/Battlemap/Tile.elm create mode 100644 src/battlemap/src/View/Controls.elm create mode 100644 src/battlemap/src/View/Status.elm create mode 100644 src/battlemap/www/index.html diff --git a/Makefile b/Makefile index f315542..f290bd1 100644 --- a/Makefile +++ b/Makefile @@ -1,13 +1,24 @@ -TARGETS = battlemap -PAGES = $(addsuffix .html,$(TARGETS)) +MODULES = battlemap +SRC_DIR = ${CURDIR}/src +WWW_DIR = ${CURDIR}/www -all: $(TARGETS) $(PAGES) +MODULES_SRC = $(addprefix $(SRC_DIR)/,$(MODULES)) +MODULES_WWW = $(addprefix $(WWW_DIR)/,$(MODULES)) -upload_demo: $(PAGES) LICENSE - scp -r $^ dreamhost:~/tacticians.online/ +all: build $(MODULES_WWW) -$(TARGETS): - $(MAKE) -C elm/$@ index.html +build: + for module in $(MODULES_SRC) ; do \ + $(MAKE) -C $$module build ; \ + done -%.html: elm/%/index.html - cp $< $@ +clean: + for module in $(MODULES_SRC) ; do \ + $(MAKE) -C $$module clean ; \ + done + +$(MODULES_WWW): %: $(WWW_DIR) + ln -s $(SRC_DIR)/$(notdir $<)/www $@ + +$(WWW_DIR): + mkdir -p $@ diff --git a/elm/battlemap/Makefile b/elm/battlemap/Makefile deleted file mode 100644 index 97d7b0b..0000000 --- a/elm/battlemap/Makefile +++ /dev/null @@ -1,11 +0,0 @@ -ELM_CC = elm-make --warn -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 deleted file mode 100644 index bcb6f4a..0000000 --- a/elm/battlemap/elm-package.json +++ /dev/null @@ -1,15 +0,0 @@ -{ - "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 deleted file mode 100644 index d2e4523..0000000 --- a/elm/battlemap/src/Battlemap.elm +++ /dev/null @@ -1,142 +0,0 @@ -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/elm/battlemap/src/Battlemap/Direction.elm b/elm/battlemap/src/Battlemap/Direction.elm deleted file mode 100644 index 5aad141..0000000 --- a/elm/battlemap/src/Battlemap/Direction.elm +++ /dev/null @@ -1,17 +0,0 @@ -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/Location.elm b/elm/battlemap/src/Battlemap/Location.elm deleted file mode 100644 index 36f0c4d..0000000 --- a/elm/battlemap/src/Battlemap/Location.elm +++ /dev/null @@ -1,44 +0,0 @@ -module Battlemap.Location exposing (..) - -import Battlemap.Direction - -type alias Type = - { - x : Int, - y : Int - } - -type alias Ref = (Int, Int) - -neighbor : Type -> Battlemap.Direction.Type -> Type -neighbor loc dir = - case dir of - Battlemap.Direction.Right -> {loc | x = (loc.x + 1)} - Battlemap.Direction.Left -> {loc | x = (loc.x - 1)} - Battlemap.Direction.Up -> {loc | y = (loc.y - 1)} - Battlemap.Direction.Down -> {loc | y = (loc.y + 1)} - Battlemap.Direction.None -> loc - -get_ref : Type -> Ref -get_ref l = - (l.x, l.y) - -from_ref : Ref -> Type -from_ref (x, y) = - {x = x, y = y} - -dist : Type -> Type -> Int -dist loc_a loc_b = - if (loc_a.x > loc_b.x) - then - if (loc_a.y > loc_b.y) - then - ((loc_a.x - loc_b.x) + (loc_a.y - loc_b.y)) - else - ((loc_a.x - loc_b.x) + (loc_b.y - loc_a.y)) - else - if (loc_a.y > loc_b.y) - then - ((loc_b.x - loc_a.x) + (loc_a.y - loc_b.y)) - else - ((loc_b.x - loc_a.x) + (loc_b.y - loc_a.y)) diff --git a/elm/battlemap/src/Battlemap/Marker.elm b/elm/battlemap/src/Battlemap/Marker.elm deleted file mode 100644 index ebefce6..0000000 --- a/elm/battlemap/src/Battlemap/Marker.elm +++ /dev/null @@ -1,5 +0,0 @@ -module Battlemap.Marker exposing (Type(..)) - -type Type = - CanAttack - | CanGoTo diff --git a/elm/battlemap/src/Battlemap/Navigator.elm b/elm/battlemap/src/Battlemap/Navigator.elm deleted file mode 100644 index 6687b18..0000000 --- a/elm/battlemap/src/Battlemap/Navigator.elm +++ /dev/null @@ -1,141 +0,0 @@ -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/elm/battlemap/src/Battlemap/Navigator/Move.elm b/elm/battlemap/src/Battlemap/Navigator/Move.elm deleted file mode 100644 index 9d7a17b..0000000 --- a/elm/battlemap/src/Battlemap/Navigator/Move.elm +++ /dev/null @@ -1,157 +0,0 @@ -module Battlemap.Navigator.Move exposing (to) - -import Set -import List - -import Battlemap -import Battlemap.Direction -import Battlemap.Location -import Battlemap.Tile -import Battlemap.Navigator - -import Character - -import Util.List - -can_move_to_new_tile : ( - Battlemap.Navigator.Type -> - Battlemap.Type -> - Battlemap.Location.Type -> - Bool - ) -can_move_to_new_tile nav battlemap next_location = - ( - (nav.remaining_points > 0) - && (Battlemap.has_location battlemap next_location) - && (nav.current_location /= next_location) - && - (not - (Set.member - (Battlemap.Location.get_ref next_location) - nav.visited_locations - ) - ) - ) - -battlemap_move_to : ( - Battlemap.Type -> - Battlemap.Location.Type -> - Battlemap.Direction.Type -> - Battlemap.Location.Type -> - Battlemap.Type - ) -battlemap_move_to battlemap current_loc dir next_loc = - (Battlemap.apply_to_tile_unsafe - (Battlemap.apply_to_tile_unsafe - battlemap - current_loc - (Battlemap.Tile.set_direction dir) - ) - next_loc - (Battlemap.Tile.set_direction dir) - ) - -navigator_move_to : ( - Battlemap.Navigator.Type -> - Battlemap.Direction.Type -> - Battlemap.Location.Type -> - Battlemap.Navigator.Type - ) -navigator_move_to nav dir next_loc = - {nav | - current_location = next_loc, - visited_locations = - (Set.insert - (Battlemap.Location.get_ref nav.current_location) - nav.visited_locations - ), - previous_directions = (dir :: nav.previous_directions), - remaining_points = (nav.remaining_points - 1) - } - -battlemap_backtrack : ( - Battlemap.Type -> - Battlemap.Location.Type -> - Battlemap.Type - ) -battlemap_backtrack battlemap current_loc = - (Battlemap.apply_to_tile_unsafe - battlemap - current_loc - (Battlemap.Tile.set_direction - Battlemap.Direction.None - ) - ) - -navigator_backtrack : ( - Battlemap.Navigator.Type -> - Battlemap.Location.Type -> - (List Battlemap.Direction.Type) -> - Battlemap.Navigator.Type - ) -navigator_backtrack nav next_loc prev_dir_tail = - {nav | - current_location = next_loc, - visited_locations = - (Set.remove - (Battlemap.Location.get_ref next_loc) - nav.visited_locations - ), - previous_directions = prev_dir_tail, - remaining_points = (nav.remaining_points + 1) - } - -to : ( - Battlemap.Type -> - Battlemap.Navigator.Type -> - Battlemap.Direction.Type -> - (List Character.Type) -> - (Battlemap.Type, Battlemap.Navigator.Type) - ) -to battlemap nav dir char_list = - let - next_location = (Battlemap.Location.neighbor nav.current_location dir) - is_occupied = - (List.any - (\c -> ((Character.get_location c) == next_location)) - char_list - ) - in - if (not is_occupied) - then - if (can_move_to_new_tile nav battlemap next_location) - then - ( - (battlemap_move_to - battlemap - nav.current_location - dir - next_location - ), - (navigator_move_to - nav - dir - next_location - ) - ) - else - case (Util.List.pop nav.previous_directions) of - Nothing -> (battlemap, nav) - (Just (head, tail)) -> - if (head == (Battlemap.Direction.opposite_of dir)) - then - ( - (battlemap_backtrack - battlemap - nav.current_location - ), - (navigator_backtrack - nav - next_location - tail - ) - ) - else - (battlemap, nav) - else - (battlemap, nav) diff --git a/elm/battlemap/src/Battlemap/Navigator/Path.elm b/elm/battlemap/src/Battlemap/Navigator/Path.elm deleted file mode 100644 index 53e12c0..0000000 --- a/elm/battlemap/src/Battlemap/Navigator/Path.elm +++ /dev/null @@ -1,168 +0,0 @@ -module Battlemap.Navigator.Path exposing - ( - Type, - new, - get_current_location, - get_remaining_points, - get_summary, - try_following_direction - ) - -import Set - -import Util.List - -import Battlemap.Direction -import Battlemap.Location - --------------------------------------------------------------------------------- --- 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/elm/battlemap/src/Battlemap/Navigator/RangeIndicator.elm b/elm/battlemap/src/Battlemap/Navigator/RangeIndicator.elm deleted file mode 100644 index a8cac8e..0000000 --- a/elm/battlemap/src/Battlemap/Navigator/RangeIndicator.elm +++ /dev/null @@ -1,287 +0,0 @@ -module Battlemap.Navigator.RangeIndicator exposing - ( - Type, - generate, - get_marker, - get_path - ) - -import Dict -import List - -import Battlemap.Direction -import Battlemap.Location -import Battlemap.Marker - -import 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/elm/battlemap/src/Battlemap/Tile.elm b/elm/battlemap/src/Battlemap/Tile.elm deleted file mode 100644 index 255310a..0000000 --- a/elm/battlemap/src/Battlemap/Tile.elm +++ /dev/null @@ -1,25 +0,0 @@ -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/elm/battlemap/src/Character.elm b/elm/battlemap/src/Character.elm deleted file mode 100644 index 1b4d1a1..0000000 --- a/elm/battlemap/src/Character.elm +++ /dev/null @@ -1,44 +0,0 @@ -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/elm/battlemap/src/Error.elm b/elm/battlemap/src/Error.elm deleted file mode 100644 index 581bb24..0000000 --- a/elm/battlemap/src/Error.elm +++ /dev/null @@ -1,29 +0,0 @@ -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/elm/battlemap/src/Event.elm b/elm/battlemap/src/Event.elm deleted file mode 100644 index 5debff1..0000000 --- a/elm/battlemap/src/Event.elm +++ /dev/null @@ -1,12 +0,0 @@ -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/elm/battlemap/src/Init.elm b/elm/battlemap/src/Init.elm deleted file mode 100644 index 25509d1..0000000 --- a/elm/battlemap/src/Init.elm +++ /dev/null @@ -1,9 +0,0 @@ -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/elm/battlemap/src/Main.elm b/elm/battlemap/src/Main.elm deleted file mode 100644 index 5a9d843..0000000 --- a/elm/battlemap/src/Main.elm +++ /dev/null @@ -1,20 +0,0 @@ -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/elm/battlemap/src/Model.elm b/elm/battlemap/src/Model.elm deleted file mode 100644 index ed067d3..0000000 --- a/elm/battlemap/src/Model.elm +++ /dev/null @@ -1,58 +0,0 @@ -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/elm/battlemap/src/Model/EndTurn.elm b/elm/battlemap/src/Model/EndTurn.elm deleted file mode 100644 index 441f3b7..0000000 --- a/elm/battlemap/src/Model/EndTurn.elm +++ /dev/null @@ -1,63 +0,0 @@ -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/elm/battlemap/src/Model/RequestDirection.elm b/elm/battlemap/src/Model/RequestDirection.elm deleted file mode 100644 index cf600e6..0000000 --- a/elm/battlemap/src/Model/RequestDirection.elm +++ /dev/null @@ -1,81 +0,0 @@ -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/elm/battlemap/src/Model/SelectCharacter.elm b/elm/battlemap/src/Model/SelectCharacter.elm deleted file mode 100644 index 7cc2102..0000000 --- a/elm/battlemap/src/Model/SelectCharacter.elm +++ /dev/null @@ -1,41 +0,0 @@ -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/elm/battlemap/src/Model/SelectTile.elm b/elm/battlemap/src/Model/SelectTile.elm deleted file mode 100644 index 0fe30fa..0000000 --- a/elm/battlemap/src/Model/SelectTile.elm +++ /dev/null @@ -1,62 +0,0 @@ -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/elm/battlemap/src/Shim/Battlemap.elm b/elm/battlemap/src/Shim/Battlemap.elm deleted file mode 100644 index 5a2e29b..0000000 --- a/elm/battlemap/src/Shim/Battlemap.elm +++ /dev/null @@ -1,12 +0,0 @@ -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/elm/battlemap/src/Shim/Battlemap/Tile.elm b/elm/battlemap/src/Shim/Battlemap/Tile.elm deleted file mode 100644 index 1e11cb5..0000000 --- a/elm/battlemap/src/Shim/Battlemap/Tile.elm +++ /dev/null @@ -1,44 +0,0 @@ -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/elm/battlemap/src/Shim/Model.elm b/elm/battlemap/src/Shim/Model.elm deleted file mode 100644 index f82a0d3..0000000 --- a/elm/battlemap/src/Shim/Model.elm +++ /dev/null @@ -1,54 +0,0 @@ -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/elm/battlemap/src/Subscriptions.elm b/elm/battlemap/src/Subscriptions.elm deleted file mode 100644 index 83df587..0000000 --- a/elm/battlemap/src/Subscriptions.elm +++ /dev/null @@ -1,7 +0,0 @@ -module Subscriptions exposing (..) - -import Model -import Event - -subscriptions : Model.Type -> (Sub Event.Type) -subscriptions model = Sub.none diff --git a/elm/battlemap/src/Update.elm b/elm/battlemap/src/Update.elm deleted file mode 100644 index 7ee61a3..0000000 --- a/elm/battlemap/src/Update.elm +++ /dev/null @@ -1,27 +0,0 @@ -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/elm/battlemap/src/Util/Array.elm b/elm/battlemap/src/Util/Array.elm deleted file mode 100644 index 69d329c..0000000 --- a/elm/battlemap/src/Util/Array.elm +++ /dev/null @@ -1,25 +0,0 @@ -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/elm/battlemap/src/Util/List.elm b/elm/battlemap/src/Util/List.elm deleted file mode 100644 index c4db397..0000000 --- a/elm/battlemap/src/Util/List.elm +++ /dev/null @@ -1,12 +0,0 @@ -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 deleted file mode 100644 index 8a956d1..0000000 --- a/elm/battlemap/src/View.elm +++ /dev/null @@ -1,33 +0,0 @@ -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/elm/battlemap/src/View/Battlemap.elm b/elm/battlemap/src/View/Battlemap.elm deleted file mode 100644 index efe4d1e..0000000 --- a/elm/battlemap/src/View/Battlemap.elm +++ /dev/null @@ -1,78 +0,0 @@ -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/elm/battlemap/src/View/Battlemap/Navigator.elm b/elm/battlemap/src/View/Battlemap/Navigator.elm deleted file mode 100644 index 4180e6d..0000000 --- a/elm/battlemap/src/View/Battlemap/Navigator.elm +++ /dev/null @@ -1,17 +0,0 @@ -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/elm/battlemap/src/View/Battlemap/Tile.elm b/elm/battlemap/src/View/Battlemap/Tile.elm deleted file mode 100644 index d38d84e..0000000 --- a/elm/battlemap/src/View/Battlemap/Tile.elm +++ /dev/null @@ -1,39 +0,0 @@ -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/elm/battlemap/src/View/Controls.elm b/elm/battlemap/src/View/Controls.elm deleted file mode 100644 index f5851a9..0000000 --- a/elm/battlemap/src/View/Controls.elm +++ /dev/null @@ -1,36 +0,0 @@ -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/elm/battlemap/src/View/Status.elm b/elm/battlemap/src/View/Status.elm deleted file mode 100644 index de2a167..0000000 --- a/elm/battlemap/src/View/Status.elm +++ /dev/null @@ -1,52 +0,0 @@ -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/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 @@ + + + + + + + + + -- cgit v1.2.3-70-g09d2