summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to 'elm/battlemap/src/Model')
-rw-r--r--elm/battlemap/src/Model/EndTurn.elm63
-rw-r--r--elm/battlemap/src/Model/RequestDirection.elm60
-rw-r--r--elm/battlemap/src/Model/SelectCharacter.elm42
-rw-r--r--elm/battlemap/src/Model/SelectTile.elm93
4 files changed, 258 insertions, 0 deletions
diff --git a/elm/battlemap/src/Model/EndTurn.elm b/elm/battlemap/src/Model/EndTurn.elm
new file mode 100644
index 0000000..788c3a1
--- /dev/null
+++ b/elm/battlemap/src/Model/EndTurn.elm
@@ -0,0 +1,63 @@
+module Model.EndTurn exposing (apply_to)
+
+import Dict
+
+import Battlemap
+
+import Character
+
+import Error
+
+import Model
+
+make_it_so : Model.Type -> Model.Type
+make_it_so model =
+ case model.selection of
+ (Model.SelectedCharacter char_id) ->
+ case (Battlemap.get_navigator_location model.battlemap) of
+ (Just location) ->
+ (Model.reset
+ model
+ (Dict.update
+ char_id
+ (\maybe_char ->
+ case maybe_char of
+ (Just char) ->
+ (Just
+ (Character.set_location location char)
+ )
+ Nothing -> Nothing
+ )
+ model.characters
+ )
+ )
+ Nothing ->
+ (Model.invalidate
+ model
+ (Error.new
+ Error.Programming
+ "EndTurn: model moving char, no navigator location."
+ )
+ )
+ _ ->
+ (Model.invalidate
+ model
+ (Error.new
+ Error.Programming
+ "EndTurn: model moving char, no char selected."
+ )
+ )
+
+apply_to : Model.Type -> Model.Type
+apply_to model =
+ case (Model.get_state model) of
+ Model.MovingCharacterWithButtons -> (make_it_so model)
+ Model.MovingCharacterWithClick -> (make_it_so model)
+ _ ->
+ (Model.invalidate
+ model
+ (Error.new
+ Error.IllegalAction
+ "This can only be done while moving a character."
+ )
+ )
diff --git a/elm/battlemap/src/Model/RequestDirection.elm b/elm/battlemap/src/Model/RequestDirection.elm
new file mode 100644
index 0000000..f47a902
--- /dev/null
+++ b/elm/battlemap/src/Model/RequestDirection.elm
@@ -0,0 +1,60 @@
+module Model.RequestDirection exposing (apply_to)
+
+import Dict
+
+import Battlemap
+import Battlemap.Direction
+
+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.add_step_to_navigator
+ model.battlemap
+ dir
+ (Dict.values model.characters)
+ )
+ in
+ case new_bmap of
+ (Just bmap) ->
+ {model |
+ state = Model.MovingCharacterWithButtons,
+ battlemap = new_bmap
+ }
+
+ Nothing ->
+ (Model.invalidate
+ model
+ (Error.new
+ Error.IllegalAction
+ "Unreachable/occupied tile."
+ )
+ )
+
+ _ ->
+ (Model.invalidate
+ model
+ (Error.new
+ Error.Programming
+ "DirectionRequest: model moving char, no char selected."
+ )
+ )
+
+apply_to : Model.Type -> Battlemap.Direction.Type -> Model.Type
+apply_to model dir =
+ 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
new file mode 100644
index 0000000..942e84d
--- /dev/null
+++ b/elm/battlemap/src/Model/SelectCharacter.elm
@@ -0,0 +1,42 @@
+module Model.SelectCharacter exposing (apply_to)
+
+import Dict
+
+import Character
+
+import Battlemap
+
+import Model
+import Event
+import Error
+
+make_it_so : Model.Type -> Character.Ref -> Model.Type
+make_it_so model char_id =
+ case (Dict.get char_id model.characters) of
+ (Just char) ->
+ {model |
+ state = Model.MovingCharacterWithClick,
+ selection = (Model.SelectedCharacter char_id),
+ battlemap =
+ (Battlemap.set_navigator
+ (Character.get_location char)
+ (Character.get_movement_points char)
+ (Character.get_attack_range char)
+ (\e -> True) -- TODO: check for characters.
+ model.battlemap
+ )
+ }
+
+ Nothing ->
+ (Model.invalidate
+ model
+ (Error.new
+ Error.Programming
+ "SelectCharacter: Unknown char selected."
+ )
+ )
+
+apply_to : Model.Type -> Character.Ref -> Model.Type
+apply_to model char_id =
+ case (Model.get_state model) of
+ _ -> (make_it_so model char_id)
diff --git a/elm/battlemap/src/Model/SelectTile.elm b/elm/battlemap/src/Model/SelectTile.elm
new file mode 100644
index 0000000..9a01e77
--- /dev/null
+++ b/elm/battlemap/src/Model/SelectTile.elm
@@ -0,0 +1,93 @@
+module Model.SelectTile exposing (apply_to)
+
+import Dict
+
+import Character
+
+import Battlemap
+import Battlemap.Direction
+import Battlemap.Location
+import Battlemap.Tile
+
+import Model.RequestDirection
+import Model.EndTurn
+
+import Model
+import Error
+
+autopilot : Battlemap.Direction.Type -> Model.Type -> Model.Type
+autopilot dir model =
+ (Update.DirectionRequest.apply_to model dir)
+
+go_to_tile : Model.Type -> Battlemap.Location.Ref -> Model.Type
+go_to_tile model loc_ref =
+ case model.selection of
+ Nothing ->
+ (Model.invalidate
+ model
+ (Error.new
+ Error.Programming
+ "SelectTile: model moving char, no selection."
+ )
+ )
+ (Just selection) ->
+ case (Dict.get loc_ref selection.range_indicator) of
+ Nothing -> -- Clicked outside of the range indicator
+ (Model.reset model)
+ (Just indicator) ->
+ let
+ new_model =
+ (List.foldr
+ (autopilot)
+ {model |
+ battlemap =
+ (Battlemap.apply_to_all_tiles
+ model.battlemap
+ (Battlemap.Tile.set_direction
+ Battlemap.Direction.None
+ )
+ ),
+ selection =
+ (Just
+ {
+ selection |
+ navigator =
+ (Battlemap.Navigator.reset
+ selection.navigator
+ )
+ }
+ )
+ }
+ indicator.path
+ )
+ in
+ if
+ (
+ (model.state == Model.MovingCharacterWithClick)
+ &&
+ (
+ (Battlemap.Location.get_ref
+ selection.navigator.current_location
+ )
+ == loc_ref
+ )
+ )
+ then
+ (Model.EndTurn.apply_to new_model)
+ else
+ {new_model | state = Model.MovingCharacterWithClick}
+
+
+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."
+ )
+ )