| summaryrefslogtreecommitdiff |
diff options
33 files changed, 664 insertions, 647 deletions
diff --git a/src/battle/src/Struct/Attack.elm b/src/battle/src/Struct/Attack.elm index 7ef8280..08803ce 100644 --- a/src/battle/src/Struct/Attack.elm +++ b/src/battle/src/Struct/Attack.elm @@ -60,6 +60,9 @@ precision_decoder : (Json.Decode.Decoder Precision) precision_decoder = (Json.Decode.map (precision_from_string) (Json.Decode.string)) +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- decoder : (Json.Decode.Decoder Type) decoder = (Json.Decode.map5 @@ -70,7 +73,3 @@ decoder = (Json.Decode.field "par" (Json.Decode.bool)) (Json.Decode.field "dmg" (Json.Decode.int)) ) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- diff --git a/src/battle/src/Struct/CharacterTurn.elm b/src/battle/src/Struct/CharacterTurn.elm index 8cc4360..c869feb 100644 --- a/src/battle/src/Struct/CharacterTurn.elm +++ b/src/battle/src/Struct/CharacterTurn.elm @@ -1,25 +1,49 @@ module Struct.CharacterTurn exposing ( Type, - State(..), - toggle_target_index, - toggle_location, - switch_weapons, - undo_action, - get_path, + Action(..) + + -- Active Character + maybe_get_active_character, + get_active_character_index, + set_active_character, + clear_active_character, + has_active_character, + + -- Action + set_action, get_action, + clear_action, + + -- Target Indices + add_target_index, + remove_target_index, + toggle_target_index, get_target_indices, + set_target_indices, + + -- Locations + add_location, + remove_location, + toggle_location, get_locations, - lock_path, - unlock_path, - show_attack_range_navigator, - new, - set_active_character, - set_active_character_no_reset, - set_navigator, - maybe_get_active_character, + set_locations, + toggle_location, + + -- Navigator maybe_get_navigator, - encode + set_navigator, + clear_navigator, + + -- Path + get_path, + store_path, + override_path, + clear_path, + + -- Other + encode, + new ) -- Elm ------------------------------------------------------------------------- @@ -46,13 +70,14 @@ type Action = | Attacking | SwitchingWeapons | UsingSkill + | AwaitingConfirmation type alias Type = { active_character : (Maybe Struct.Character.Type), - path : (List BattleMap.Struct.Direction.Type), navigator : (Maybe Struct.Navigator.Type), + path : (List BattleMap.Struct.Direction.Type), action : Action, targets : (Set.Set Int), @@ -62,6 +87,63 @@ type alias Type = -------------------------------------------------------------------------------- -- LOCAL ----------------------------------------------------------------------- -------------------------------------------------------------------------------- +encode_path : Type -> (Json.Encode.Value) +encode_path ct = + (Json.Encode.object + [ + ("cat", "mov"), + ( + "pat", + (Json.Encode.list + ( + (Json.Encode.string) + << + (BattleMap.Struct.Direction.to_string) + ) + (List.reverse (get_path ct)) + ) + ) + ] + ) + +encode_action : Type -> (Json.Encode.Value) +encode_action ct = + case ct.action of + None -> (Json.Encode.null) + Attacking -> + case (List.head (Set.toList ct.targets)) of + Nothing -> (Json.Encode.null) + (Just target) -> + (Json.Encode.object + [ + ("cat", "atk"), + ("tar", (Json.Encode.int target)) + ] + ) + + SwitchingWeapons -> + (Json.Encode.object [("cat", "swp")]) + + UsingSkill -> + (Json.Encode.object + [ + ("cat", "skl"), + ( + "tar", + (Json.Encode.list + (Json.Encode.int) + (Set.toList ct.targets) + ) + ), + ( + "loc", + (Json.Encode.list + (BattleMap.Struct.Location.encode) + (Set.toList ct.locations) + ) + ) + ] + ) -------------------------------------------------------------------------------- -- EXPORTED -------------------------------------------------------------------- @@ -71,149 +153,105 @@ new = { active_character = Nothing, - path = [], navigator = Nothing, + path = [], action = None, targets = (Set.empty), locations = (Set.empty) } +---- Active Character ---------------------------------------------------------- maybe_get_active_character : Type -> (Maybe Struct.Character.Type) maybe_get_active_character ct = ct.active_character -switch_weapons : Type -> Type -switch_weapons : -toggle_target_index : Int -> Type -> Type -toggle_target_index ix ct = - let - uct = - case ct.action of - None -> (lock_path ct) - _ -> ct - in - if (Set.member ix uct.targets) - then {uct | targets = (Set.remove ix uct.targets)} - else {uct | targets = (Set.insert ix uct.targets)} +set_active_character : Struct.Character.Type -> Type -> Type +set_active_character char ct = {ct | active_character = (Just char)} -toggle_location : BattleMap.Struct.Location.Ref -> Type -> Type -toggle_location loc ct = - let - uct = - case ct.action of - None -> (lock_path ct) - _ -> ct - in - if (Set.member loc uct.locations) - then {uct | locations = (Set.remove loc uct.locations)} - else {uct | locations = (Set.insert loc uct.locations)} - -set_active_character : ( - Struct.Character.Type -> - Type -> - Type - ) -set_active_character char ct = - {ct | - active_character = (Just char), +clear_active_character : Type -> Type +clear_active_character ct = {ct | active_character = Nothing} - path = [], - navigator = Nothing, +get_active_character_index : Type -> Int +get_active_character_index ct = + case ct.active_character of + Nothing -> -1 + (Just char) -> (Struct.Character.get_index char) - action = None, - targets = (Set.empty), - locations = (Set.empty) - } +has_active_character : Type -> Bool +has_active_character ct = (ct.active_character /= Nothing) -set_active_character_no_reset : ( - Struct.Character.Type -> - Type -> - Type - ) -set_active_character_no_reset char ct = - {ct | - active_character = (Just char) - } +---- Action -------------------------------------------------------------------- +set_action : Action -> Type -> Type +set_action act ct = {ct | action = act} get_action : Type -> Action -get_action ct = ct.action - -get_path : Type -> (List BattleMap.Struct.Direction.Type) -get_path ct = ct.path +get_action act ct = ct.action -lock_path : Type -> Type -lock_path ct = - case ct.navigator of - (Just old_nav) -> - {ct | - path = (Struct.Navigator.get_path old_nav), - navigator = (Just (Struct.Navigator.lock_path old_nav)), - - action = Attacking, - targets = (Set.empty), - locations = (Set.empty) - } - - _ -> - ct - -unlock_path : Type -> Type -unlock_path ct = - case ct.navigator of - (Just old_nav) -> - {ct | - navigator = (Just (Struct.Navigator.unlock_path old_nav)), - - action = None, - targets = (Set.empty), - locations = (Set.empty) - } - - _ -> - ct - -show_attack_range_navigator : Int -> Int -> Type -> Type -show_attack_range_navigator range_min range_max ct = - case ct.navigator of - Nothing -> ct - - (Just old_nav) -> - {ct | - path = (Struct.Navigator.get_path old_nav), - navigator = - (Just - (Struct.Navigator.lock_path_with_new_attack_ranges - range_min - range_max - old_nav - ) - ), - - action = None, - targets = (Set.empty), - locations = (Set.empty) - } +clear_action : Type -> Type +clear_action ct = {ct | action = None} -maybe_get_navigator : Type -> (Maybe Struct.Navigator.Type) -maybe_get_navigator ct = ct.navigator +---- Targets ------------------------------------------------------------------- +add_target_index : Int -> Type -> Type +add_target_index ix ct = {ct | targets = (Set.insert ix ct.targets)} -set_navigator : Struct.Navigator.Type -> Type -> Type -set_navigator navigator ct = - {ct | - path = [], - navigator = (Just navigator), +remove_target_index : Int -> Type -> Type +remove_target_index ix ct = {ct | targets = (Set.remove ix ct.targets)} - action = None, - targets = (Set.empty), - locations = (Set.empty) - } +toggle_target_index : Int -> Type -> Type +toggle_target_index ix ct = + if (Set.member ix ct.targets) + then (remove_target_index ix ct) + else (add_target_index ix ct) get_target_indices : Type -> (Set.Set Int) get_target_indices ct = ct.targets +set_target_indices : (Set.Set Int) -> Type -> Type +set_target_indices targets ct = {ct | targets = targets} + +---- Locations ----------------------------------------------------------------- +add_location : BattleMap.Struct.Location.Ref -> Type -> Type +add_location ix ct = {ct | locations = (Set.insert ix ct.locations)} + +remove_location : BattleMap.Struct.Location.Ref -> Type -> Type +remove_location ix ct = {ct | locations = (Set.remove ix ct.locations)} + +toggle_location : BattleMap.Struct.Location.Ref -> Type -> Type +toggle_location ix ct = + if (Set.member ix ct.locations) + then (remove_location ix ct) + else (add_location ix ct) + get_locations : Type -> (Set.Set BattleMap.Struct.Location.Ref) get_locations ct = ct.locations +set_locations : (Set.Set BattleMap.Struct.Location.Ref) -> Type -> Type +set_locations locations ct = {ct | locations = locations} + +---- Navigator ----------------------------------------------------------------- +maybe_get_navigator : Type -> (Maybe Struct.Navigator.Type) +maybe_get_navigator ct = ct.navigator + +set_navigator : Type -> (Maybe Struct.Navigator.Type) +set_navigator navigator ct = {ct | navigator = (Just navigator)} + +clear_navigator : Type -> Type +clear_navigator ct = {ct | navigator = Nothing} + +---- Path ---------------------------------------------------------------------- +get_path : Type -> (List BattleMap.Struct.Direction.Type) +get_path ct = ct.path + +store_path : Type -> Type +store_path ct = {ct | path = (Struct.Navigator.get_path old_nav)} + +override_path : (List BattleMap.Struct.Direction.Type) -> Type -> Type +override_path path ct = {ct | path = path} + +clear_path : Type -> Type +clear_path ct = {ct | path = []} + +---- Encode/Decode ------------------------------------------------------------- encode : Type -> (Json.Encode.Value) encode ct = case ct.active_character of @@ -248,60 +286,3 @@ encode ct = ] ) -encode_path : Type -> (Json.Encode.Value) -encode_path ct = - (Json.Encode.object - [ - ("cat", "mov"), - ( - "pat", - (Json.Encode.list - ( - (Json.Encode.string) - << - (BattleMap.Struct.Direction.to_string) - ) - (List.reverse (get_path ct)) - ) - ) - ] - ) - -encode_action : Type -> (Json.Encode.Value) -encode_action ct = - case ct.action of - None -> (Json.Encode.null) - Attacking -> - case (List.head (Set.toList ct.targets)) of - Nothing -> (Json.Encode.null) - (Just target) -> - (Json.Encode.object - [ - ("cat", "atk"), - ("tar", (Json.Encode.int target)) - ] - ) - - SwitchingWeapons -> - (Json.Encode.object [("cat", "swp")]) - - UsingSkill -> - (Json.Encode.object - [ - ("cat", "skl"), - ( - "tar", - (Json.Encode.list - (Json.Encode.int) - (Set.toList ct.targets) - ) - ), - ( - "loc", - (Json.Encode.list - (BattleMap.Struct.Location.encode) - (Set.toList ct.locations) - ) - ) - ] - ) diff --git a/src/battle/src/Struct/Event.elm b/src/battle/src/Struct/Event.elm index 2e6c5ff..e0fa827 100644 --- a/src/battle/src/Struct/Event.elm +++ b/src/battle/src/Struct/Event.elm @@ -37,6 +37,14 @@ type Type = | UndoActionRequest | WeaponSwitchRequest +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- + attempted : (Result.Result err val) -> Type attempted act = case act of diff --git a/src/battle/src/Struct/HelpRequest.elm b/src/battle/src/Struct/HelpRequest.elm index 03eb63f..f20610c 100644 --- a/src/battle/src/Struct/HelpRequest.elm +++ b/src/battle/src/Struct/HelpRequest.elm @@ -16,3 +16,11 @@ type Type = None | Attribute Battle.Struct.Attributes.Category | DamageType Battle.Struct.DamageType.Type + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- diff --git a/src/battle/src/Struct/Marker.elm b/src/battle/src/Struct/Marker.elm index e3a051d..d2ffc5a 100644 --- a/src/battle/src/Struct/Marker.elm +++ b/src/battle/src/Struct/Marker.elm @@ -8,3 +8,11 @@ type Type = | CanGoToCanDefend | CanAttackCantDefend | CanGoToCantDefend + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- diff --git a/src/battle/src/Struct/Path.elm b/src/battle/src/Struct/Path.elm index c288103..aae8c41 100644 --- a/src/battle/src/Struct/Path.elm +++ b/src/battle/src/Struct/Path.elm @@ -1,11 +1,14 @@ module Struct.Path exposing ( Type, + new, + get_current_location, get_remaining_points, get_summary, - maybe_follow_direction + + maybe_add_step ) -- Elm ------------------------------------------------------------------------- @@ -37,11 +40,11 @@ type alias Type = -- LOCAL ----------------------------------------------------------------------- -------------------------------------------------------------------------------- has_been_to : ( - Type -> BattleMap.Struct.Location.Type -> + Type -> Bool ) -has_been_to path location = +has_been_to location path = ( (path.current_location == location) || @@ -51,17 +54,15 @@ has_been_to path location = ) ) -maybe_mov_to : ( - Type -> +maybe_move_to : ( BattleMap.Struct.Direction.Type -> BattleMap.Struct.Location.Type -> Int -> + Type -> (Maybe Type) ) -maybe_mov_to path dir next_loc cost = - let - remaining_points = (path.remaining_points - cost) - in +maybe_move_to dir next_loc cost path = + let remaining_points = (path.remaining_points - cost) in if (remaining_points >= 0) then (Just @@ -124,12 +125,11 @@ maybe_backtrack_to path dir location = -------------------------------------------------------------------------------- -- EXPORTED -------------------------------------------------------------------- -------------------------------------------------------------------------------- - new : BattleMap.Struct.Location.Type -> Int -> Type new start points = { current_location = start, - visited_locations = Set.empty, + visited_locations = (Set.empty), previous_directions = [], previous_points = [], remaining_points = points @@ -144,37 +144,12 @@ get_remaining_points path = path.remaining_points get_summary : Type -> (List BattleMap.Struct.Direction.Type) get_summary path = path.previous_directions -maybe_follow_direction : ( - (BattleMap.Struct.Location.Type -> (Int, Int)) -> - (Maybe Type) -> - BattleMap.Struct.Direction.Type -> - (Maybe Type) - ) -maybe_follow_direction tile_data_fun maybe_path dir = - case maybe_path of - (Just path) -> - let - next_location = - (BattleMap.Struct.Location.neighbor - dir - path.current_location - ) - (next_location_cost, next_location_battles) = - (tile_data_fun next_location) - in - if (next_location_cost <= Constants.Movement.max_points) - then - if (has_been_to path next_location) - then - (maybe_backtrack_to path dir next_location) - else - (maybe_mov_to - path - dir - next_location - next_location_cost - ) - else - Nothing - - Nothing -> Nothing +maybe_add_step : BattleMap.Struct.Direction.Type -> Int -> Type -> (Maybe Type) +maybe_add_step direction cost path = + let + next_location = + (BattleMap.Struct.Location.neighbor direction path.current_location) + in + if (has_been_to next_location path) + then (maybe_backtrack_to direction next_location path) + else (maybe_move_to direction next_location cost path) diff --git a/src/battle/src/Struct/UI.elm b/src/battle/src/Struct/UI.elm index e1881ed..f853c01 100644 --- a/src/battle/src/Struct/UI.elm +++ b/src/battle/src/Struct/UI.elm @@ -3,23 +3,29 @@ module Struct.UI exposing Type, Tab(..), Action(..), + default, + -- Zoom get_zoom_level, reset_zoom_level, mod_zoom_level, + -- Tab maybe_get_displayed_tab, set_displayed_tab, reset_displayed_tab, - to_string, + tab_to_string, get_all_tabs, + -- Navigator maybe_get_displayed_nav, set_displayed_nav, reset_displayed_nav, + -- Manual Controls has_manual_controls_enabled, + -- Previous Action get_previous_action, set_previous_action @@ -92,8 +98,8 @@ set_displayed_tab tab ui = {ui | displayed_tab = (Just tab)} reset_displayed_tab : Type -> Type reset_displayed_tab ui = {ui | displayed_tab = Nothing} -to_string : Tab -> String -to_string tab = +tab_to_string : Tab -> String +tab_to_string tab = case tab of StatusTab -> "Status" CharactersTab -> "Characters" @@ -121,10 +127,8 @@ has_manual_controls_enabled ui = ui.show_manual_controls toggle_manual_controls : Type -> Type toggle_manual_controls ui = if (ui.show_manual_controls) - then - {ui | show_manual_controls = False} - else - {ui | show_manual_controls = True} + then {ui | show_manual_controls = False} + else {ui | show_manual_controls = True} set_enable_manual_controls : Bool -> Type -> Type set_enable_manual_controls val ui = {ui | show_manual_controls = val} diff --git a/src/battle/src/Update/DisplayCharacterInfo.elm b/src/battle/src/Update/Character/DisplayCharacterInfo.elm index ed1c0ec..bcf972d 100644 --- a/src/battle/src/Update/DisplayCharacterInfo.elm +++ b/src/battle/src/Update/Character/DisplayCharacterInfo.elm @@ -1,14 +1,8 @@ -module Update.DisplayCharacterInfo exposing (apply_to) +module Update.Character.DisplayInfo exposing (apply_to) -- Elm ------------------------------------------------------------------------- -import Array -import Task -- Local Module ---------------------------------------------------------------- -import Action.Scroll - -import Struct.Battle -import Struct.Character import Struct.Event import Struct.Model import Struct.UI @@ -16,30 +10,16 @@ import Struct.UI -------------------------------------------------------------------------------- -- LOCAL ----------------------------------------------------------------------- -------------------------------------------------------------------------------- -scroll_to_char : Struct.Model.Type -> Int -> (Cmd Struct.Event.Type) -scroll_to_char model char_ix = - case (Struct.Battle.get_character char_ix model.battle) of - (Just char) -> - (Task.attempt - (Struct.Event.attempted) - (Action.Scroll.to - (Struct.Character.get_location char) - model.ui - ) - ) - - Nothing -> - Cmd.none -------------------------------------------------------------------------------- -- EXPORTED -------------------------------------------------------------------- -------------------------------------------------------------------------------- apply_to : ( - Struct.Model.Type -> Int -> + Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) ) -apply_to model target_ref = +apply_to target_ref model = ( {model | ui = @@ -51,5 +31,5 @@ apply_to model target_ref = ) ) }, - (scroll_to_char model target_ref) + Cmd.none ) diff --git a/src/battle/src/Update/Character/DisplayInfo.elm b/src/battle/src/Update/Character/DisplayInfo.elm new file mode 100644 index 0000000..c43e0bd --- /dev/null +++ b/src/battle/src/Update/Character/DisplayInfo.elm @@ -0,0 +1,32 @@ +module Update.Character.DisplayInfo exposing (apply_to_ref) + +-- Elm ------------------------------------------------------------------------- + +-- Local Module ---------------------------------------------------------------- +import Struct.Event +import Struct.Model +import Struct.UI + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to_ref : ( + Int -> + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to_ref target_ref model = + {model | + ui = + (Struct.UI.set_displayed_tab + Struct.UI.StatusTab + (Struct.UI.set_previous_action + (Just (Struct.UI.SelectedCharacter target_ref)) + model.ui + ) + ) + } diff --git a/src/battle/src/Update/Character/DisplayNavigator.elm b/src/battle/src/Update/Character/DisplayNavigator.elm new file mode 100644 index 0000000..9c935ee --- /dev/null +++ b/src/battle/src/Update/Character/DisplayNavigator.elm @@ -0,0 +1,42 @@ +module Update.Character.ScrollTo exposing (apply_to_ref, apply_to_character) + +-- Elm ------------------------------------------------------------------------- +import Task + +-- Local Module ---------------------------------------------------------------- +import Action.Scroll + +import Struct.Battle +import Struct.Character +import Struct.Event +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to_character : ( + Struct.Character.Type -> + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to_character char model = + ( + model, + (Task.attempt + (Struct.Event.attempted) + (Action.Scroll.to + (Struct.Character.get_location char) + model.ui + ) + ) + ) + +apply_to_ref : Int -> Struct.Model.Type -> (Cmd Struct.Event.Type) +apply_to_ref char_ix model = + case (Struct.Battle.get_character char_ix model.battle) of + (Just char) -> (apply_to_character char model) + Nothing -> (model, Cmd.none) diff --git a/src/battle/src/Update/LookForCharacter.elm b/src/battle/src/Update/Character/LookForCharacter.elm index 1c2af0a..1c2af0a 100644 --- a/src/battle/src/Update/LookForCharacter.elm +++ b/src/battle/src/Update/Character/LookForCharacter.elm diff --git a/src/battle/src/Update/Character/ScrollTo.elm b/src/battle/src/Update/Character/ScrollTo.elm new file mode 100644 index 0000000..9c935ee --- /dev/null +++ b/src/battle/src/Update/Character/ScrollTo.elm @@ -0,0 +1,42 @@ +module Update.Character.ScrollTo exposing (apply_to_ref, apply_to_character) + +-- Elm ------------------------------------------------------------------------- +import Task + +-- Local Module ---------------------------------------------------------------- +import Action.Scroll + +import Struct.Battle +import Struct.Character +import Struct.Event +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to_character : ( + Struct.Character.Type -> + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to_character char model = + ( + model, + (Task.attempt + (Struct.Event.attempted) + (Action.Scroll.to + (Struct.Character.get_location char) + model.ui + ) + ) + ) + +apply_to_ref : Int -> Struct.Model.Type -> (Cmd Struct.Event.Type) +apply_to_ref char_ix model = + case (Struct.Battle.get_character char_ix model.battle) of + (Just char) -> (apply_to_character char model) + Nothing -> (model, Cmd.none) diff --git a/src/battle/src/Update/CharacterTurn.elm b/src/battle/src/Update/CharacterTurn.elm new file mode 100644 index 0000000..19c75b6 --- /dev/null +++ b/src/battle/src/Update/CharacterTurn.elm @@ -0,0 +1,18 @@ +module Update.CharacterTurn exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + Int -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model target_char_id = + diff --git a/src/battle/src/Update/AbortTurn.elm b/src/battle/src/Update/CharacterTurn/AbortTurn.elm index 486e846..7d45d08 100644 --- a/src/battle/src/Update/AbortTurn.elm +++ b/src/battle/src/Update/CharacterTurn/AbortTurn.elm @@ -1,4 +1,4 @@ -module Update.AbortTurn exposing (apply_to) +module Update.CharacterTurn.AbortTurn exposing (apply_to) -- Local Module ---------------------------------------------------------------- import Struct.CharacterTurn diff --git a/src/battle/src/Update/AttackWithoutMoving.elm b/src/battle/src/Update/CharacterTurn/AttackWithoutMoving.elm index 3584e69..7946b8f 100644 --- a/src/battle/src/Update/AttackWithoutMoving.elm +++ b/src/battle/src/Update/CharacterTurn/AttackWithoutMoving.elm @@ -1,4 +1,4 @@ -module Update.AttackWithoutMoving exposing (apply_to) +module Update.CharacterTurn.AttackWithoutMoving exposing (apply_to) -- Local Module ---------------------------------------------------------------- import Struct.CharacterTurn diff --git a/src/battle/src/Update/EndTurn.elm b/src/battle/src/Update/CharacterTurn/EndTurn.elm index bc7631b..b3b6cb0 100644 --- a/src/battle/src/Update/EndTurn.elm +++ b/src/battle/src/Update/CharacterTurn/EndTurn.elm @@ -1,4 +1,4 @@ -module Update.EndTurn exposing (apply_to) +module Update.CharacterTurn.EndTurn exposing (apply_to) -- Local Module ---------------------------------------------------------------- import Comm.CharacterTurn diff --git a/src/battle/src/Update/RequestDirection.elm b/src/battle/src/Update/CharacterTurn/RequestDirection.elm index de301c0..9b3ef0e 100644 --- a/src/battle/src/Update/RequestDirection.elm +++ b/src/battle/src/Update/CharacterTurn/RequestDirection.elm @@ -1,4 +1,4 @@ -module Update.RequestDirection exposing (apply_to) +module Update.CharacterTurn.RequestDirection exposing (apply_to) -- Battle Map ------------------------------------------------------------------ import BattleMap.Struct.Direction diff --git a/src/battle/src/Update/SwitchWeapon.elm b/src/battle/src/Update/CharacterTurn/SwitchWeapon.elm index 0b4816f..122f2a4 100644 --- a/src/battle/src/Update/SwitchWeapon.elm +++ b/src/battle/src/Update/CharacterTurn/SwitchWeapon.elm @@ -1,4 +1,4 @@ -module Update.SwitchWeapon exposing (apply_to) +module Update.CharacterTurn.SwitchWeapon exposing (apply_to) -- Battle Characters ----------------------------------------------------------- import BattleCharacters.Struct.Weapon diff --git a/src/battle/src/Update/CharacterTurn/ToggleTarget.elm b/src/battle/src/Update/CharacterTurn/ToggleTarget.elm new file mode 100644 index 0000000..272163e --- /dev/null +++ b/src/battle/src/Update/CharacterTurn/ToggleTarget.elm @@ -0,0 +1,74 @@ +module Update.CharacterTurn.ToggleTarget exposing (apply_to_ref) + +-- Local Module ---------------------------------------------------------------- +import Struct.CharacterTurn +import Struct.Event +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +can_target_character : ( + Struct.Model.Type -> + Struct.Character.Type -> + Bool + ) +can_target_character model target = + ( + (Struct.Character.is_alive target) + && + ( + case + (Struct.CharacterTurn.maybe_get_navigator + model.char_turn + ) + of + (Just nav) -> + case + (Struct.Navigator.maybe_get_path_to + (BattleMap.Struct.Location.get_ref + (Struct.Character.get_location target) + ) + nav + ) + of + (Just _) -> True + _ -> False + + _ -> + False + ) + ) + +attack_character : ( + Struct.Model.Type -> + Int -> + Struct.Character.Type -> + Struct.Model.Type + ) +attack_character model target_char_id target_char = + {model | + char_turn = + (Struct.CharacterTurn.set_target + (Just target_char_id) + model.char_turn + ), + ui = + (Struct.UI.reset_displayed_nav + (Struct.UI.reset_displayed_tab + (Struct.UI.set_previous_action Nothing model.ui) + ) + ) + } + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) +apply_to model = + ( + {model | + char_turn = (Struct.CharacterTurn.new) + }, + Cmd.none + ) diff --git a/src/battle/src/Update/UndoAction.elm b/src/battle/src/Update/CharacterTurn/UndoAction.elm index dc5b025..284b37d 100644 --- a/src/battle/src/Update/UndoAction.elm +++ b/src/battle/src/Update/CharacterTurn/UndoAction.elm @@ -1,4 +1,4 @@ -module Update.UndoAction exposing (apply_to) +module Update.CharacterTurn.UndoAction exposing (apply_to) -- Elm ------------------------------------------------------------------------- import Array diff --git a/src/battle/src/Update/HandleServerReply.elm b/src/battle/src/Update/HandleServerReply.elm index 3bea958..e2dad31 100644 --- a/src/battle/src/Update/HandleServerReply.elm +++ b/src/battle/src/Update/HandleServerReply.elm @@ -20,6 +20,8 @@ import Struct.Flags import Util.Http +import Update.Sequence + -- Battle Characters ----------------------------------------------------------- import BattleCharacters.Struct.DataSetItem import BattleCharacters.Struct.Equipment @@ -54,186 +56,136 @@ import Update.Puppeteer -- LOCAL ----------------------------------------------------------------------- -------------------------------------------------------------------------------- disconnected : ( - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + Struct.Model.Type -> + (Cmd Struct.Event.Type) ) -disconnected current_state = - let (model, cmds) = current_state in - ( - model, - [ - (Action.Ports.go_to +disconnected model = + ( + model, + (Action.Ports.go_to + ( + Constants.IO.base_url + ++ "/login/?action=disconnect&goto=" + ++ + (Url.percentEncode ( - Constants.IO.base_url - ++ "/login/?action=disconnect&goto=" - ++ - (Url.percentEncode - ( - "/battle/?" - ++ (Struct.Flags.get_parameters_as_url model.flags) - ) - ) + "/battle/?" + ++ (Struct.Flags.get_parameters_as_url model.flags) ) ) - ] + ) ) + ) add_characters_data_set_item : ( BattleCharacters.Struct.DataSetItem.Type -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + Struct.Model.Type -> + (Cmd Struct.Event.Type) + ) +add_characters_data_set_item item model = + ( + {model | + characters_data_set = + (BattleCharacters.Struct.DataSetItem.add_to + item + model.characters_data_set + ) + }, + Cmd.none ) -add_characters_data_set_item item current_state = - let (model, cmds) = current_state in - ( - {model | - characters_data_set = - (BattleCharacters.Struct.DataSetItem.add_to - item - model.characters_data_set - ) - }, - cmds - ) add_map_data_set_item : ( BattleMap.Struct.DataSetItem.Type -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + Struct.Model.Type -> + (Cmd Struct.Event.Type) + ) +add_map_data_set_item item model = + ( + {model | + map_data_set = + (BattleMap.Struct.DataSetItem.add_to item model.map_data_set) + }, + Cmd.none ) -add_map_data_set_item item current_state = - let (model, cmds) = current_state in - ( - {model | - map_data_set = - (BattleMap.Struct.DataSetItem.add_to item model.map_data_set) - }, - cmds - ) add_player : ( Struct.Player.Type -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + Struct.Model.Type -> + (Cmd Struct.Event.Type) + ) +add_player pl model = + ( + {model | + battle = (Struct.Battle.add_player model.flags pl model.battle) + }, + Cmd.none ) -add_player pl current_state = - let (model, cmds) = current_state in - ( - {model | - battle = (Struct.Battle.add_player model.flags pl model.battle) - }, - cmds - ) add_character : ( Struct.Character.Unresolved -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + Struct.Model.Type -> + (Cmd Struct.Event.Type) ) -add_character unresolved_char current_state = - let (model, cmds) = current_state in - ( - {model | - battle = - (Struct.Battle.add_character - (Struct.Character.resolve - (\loc -> - (BattleMap.Struct.Map.get_omnimods_at - loc - model.map_data_set - (Struct.Battle.get_map model.battle) - ) - ) - (BattleCharacters.Struct.Equipment.resolve - model.characters_data_set +add_character unresolved_char model = + ( + {model | + battle = + (Struct.Battle.add_character + (Struct.Character.resolve + (\loc -> + (BattleMap.Struct.Map.get_omnimods_at + loc + model.map_data_set + (Struct.Battle.get_map model.battle) ) - unresolved_char ) - model.battle + (BattleCharacters.Struct.Equipment.resolve + model.characters_data_set + ) + unresolved_char ) - }, - cmds - ) + model.battle + ) + }, + Cmd.none + ) set_map : ( BattleMap.Struct.Map.Type -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + Struct.Model.Type -> + (Cmd Struct.Event.Type) ) -set_map map current_state = - let (model, cmds) = current_state in - ( - {model | - battle = - (Struct.Battle.set_map - (BattleMap.Struct.Map.solve_tiles - model.map_data_set - map - ) - model.battle +set_map map model = + ( + {model | + battle = + (Struct.Battle.set_map + (BattleMap.Struct.Map.solve_tiles + model.map_data_set + map ) - }, - cmds - ) - -add_to_timeline : ( - (List Struct.TurnResult.Type) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) - ) -add_to_timeline turn_results current_state = - let - (model, cmds) = current_state - (next_model, new_cmd) = - (Update.Puppeteer.apply_to - ( - {model | - puppeteer = - (List.foldl - (\turn_result puppeteer -> - (Struct.Puppeteer.append_forward - (Struct.PuppeteerAction.from_turn_result - turn_result - ) - puppeteer - ) - ) - model.puppeteer - turn_results - ), - battle = - (Struct.Battle.set_timeline - (Array.append - (Array.fromList turn_results) - (Struct.Battle.get_timeline model.battle) - ) - model.battle - ) - } + model.battle ) - ) - in - ( - next_model, - if (new_cmd == Cmd.none) - then cmds - else (new_cmd :: cmds) - ) + }, + Cmd.none + ) -set_timeline : ( +add_to_timeline : ( (List Struct.TurnResult.Type) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + Struct.Model.Type -> + (Cmd Struct.Event.Type) ) -set_timeline turn_results current_state = - let (model, cmds) = current_state in +add_to_timeline turn_results model = + (Update.Puppeteer.apply_to ( {model | puppeteer = - (List.foldr + (List.foldl (\turn_result puppeteer -> - (Struct.Puppeteer.append_backward - (Struct.PuppeteerAction.from_turn_result turn_result) + (Struct.Puppeteer.append_forward + (Struct.PuppeteerAction.from_turn_result + turn_result + ) puppeteer ) ) @@ -242,44 +194,71 @@ set_timeline turn_results current_state = ), battle = (Struct.Battle.set_timeline - (Array.fromList turn_results) + (Array.append + (Array.fromList turn_results) + (Struct.Battle.get_timeline model.battle) + ) model.battle ) - }, - cmds + } ) + ) + +set_timeline : ( + (List Struct.TurnResult.Type) -> + Struct.Model.Type -> + (Cmd Struct.Event.Type) + ) +set_timeline turn_results model = + ( + {model | + puppeteer = + (List.foldr + (\turn_result puppeteer -> + (Struct.Puppeteer.append_backward + (Struct.PuppeteerAction.from_turn_result turn_result) + puppeteer + ) + ) + model.puppeteer + turn_results + ), + battle = + (Struct.Battle.set_timeline + (Array.fromList turn_results) + model.battle + ) + }, + Cmd.none + ) -apply_command : ( +server_command_to_update : ( Struct.ServerReply.Type -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + (Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type))) ) -apply_command command current_state = - case command of - Struct.ServerReply.Disconnected -> (disconnected current_state) +server_command_to_update server_command = + case server_command of + Struct.ServerReply.Disconnected -> (disconnected) (Struct.ServerReply.AddCharactersDataSetItem item) -> - (add_characters_data_set_item item current_state) + (add_characters_data_set_item item) (Struct.ServerReply.AddMapDataSetItem item) -> - (add_map_data_set_item item current_state) + (add_map_data_set_item item) (Struct.ServerReply.AddPlayer pl) -> - (add_player pl current_state) + (add_player pl) (Struct.ServerReply.AddCharacter char) -> - (add_character char current_state) + (add_character char) - (Struct.ServerReply.SetMap map) -> - (set_map map current_state) + (Struct.ServerReply.SetMap map) -> (set_map map) - (Struct.ServerReply.TurnResults results) -> - (add_to_timeline results current_state) + (Struct.ServerReply.TurnResults results) -> (add_to_timeline results) - (Struct.ServerReply.SetTimeline timeline) -> - (set_timeline timeline current_state) + (Struct.ServerReply.SetTimeline timeline) -> (set_timeline timeline) - Struct.ServerReply.Okay -> current_state + Struct.ServerReply.Okay -> (do_nothing) -------------------------------------------------------------------------------- -- EXPORTED -------------------------------------------------------------------- @@ -302,17 +281,8 @@ apply_to model query_result = Cmd.none ) - (Result.Ok commands) -> - let - (new_model, elm_commands) = - (List.foldl (apply_command) (model, [Cmd.none]) commands) - in - ( - new_model, - ( - case elm_commands of - [] -> Cmd.none - [cmd] -> cmd - _ -> (Cmd.batch elm_commands) - ) - ) + (Result.Ok server_command) -> + (Update.Sequence.sequence + (List.map (server_command_to_update) commands) + model + ) diff --git a/src/battle/src/Update/SelectCharacter.elm b/src/battle/src/Update/SelectCharacter.elm index d39b8d0..ae2860f 100644 --- a/src/battle/src/Update/SelectCharacter.elm +++ b/src/battle/src/Update/SelectCharacter.elm @@ -31,35 +31,6 @@ import Struct.UI -------------------------------------------------------------------------------- -- LOCAL ----------------------------------------------------------------------- -------------------------------------------------------------------------------- -get_character_navigator : ( - Struct.Battle.Type -> - Struct.Character.Type -> - Struct.Navigator.Type - ) -get_character_navigator battle char = - let - base_char = (Struct.Character.get_base_character char) - weapon = (BattleCharacters.Struct.Character.get_active_weapon base_char) - in - (Struct.Navigator.new - (Struct.Character.get_location char) - (Battle.Struct.Attributes.get_movement_points - (BattleCharacters.Struct.Character.get_attributes base_char) - ) - (BattleCharacters.Struct.Weapon.get_defense_range weapon) - (BattleCharacters.Struct.Weapon.get_attack_range weapon) - (BattleMap.Struct.Map.get_tile_data_function - (Struct.Battle.get_map battle) - (List.map - (Struct.Character.get_location) - (Array.toList - (Struct.Battle.get_characters battle) - ) - ) - (Struct.Character.get_location char) - ) - ) - attack_character : ( Struct.Model.Type -> Int -> @@ -126,165 +97,36 @@ ctrl_or_focus_character model target_char_id target_char = ) } -can_target_character : ( - Struct.Model.Type -> - Struct.Character.Type -> - Bool - ) -can_target_character model target = - ( - (Struct.Character.is_alive target) - && - ( - case - (Struct.CharacterTurn.maybe_get_navigator - model.char_turn - ) - of - (Just nav) -> - case - (Struct.Navigator.maybe_get_path_to - (BattleMap.Struct.Location.get_ref - (Struct.Character.get_location target) - ) - nav - ) - of - (Just _) -> True - _ -> False - - _ -> - False - ) - ) second_click_on : ( - Struct.Model.Type -> Int -> + Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) ) -second_click_on model target_char_id = - case (Struct.Battle.get_character target_char_id model.battle) of - (Just target_char) -> - case - ( - (Struct.CharacterTurn.maybe_get_active_character - model.char_turn - ), - (Struct.CharacterTurn.maybe_get_target model.char_turn) - ) - of - ((Just _), (Just char_turn_target_id)) -> - if (char_turn_target_id == target_char_id) - then - ( - model, - Cmd.none - ) - else - ( - (ctrl_or_focus_character model target_char_id target_char), - (Task.attempt - (Struct.Event.attempted) - (Action.Scroll.to - (Struct.Character.get_location target_char) - model.ui - ) - ) - ) - - ((Just _), Nothing) -> - if (can_target_character model target_char) - then - ( - (attack_character - model - target_char_id - target_char - ), - Cmd.none - ) - else - ( - (ctrl_or_focus_character model target_char_id target_char), - (Task.attempt - (Struct.Event.attempted) - (Action.Scroll.to - (Struct.Character.get_location target_char) - model.ui - ) - ) - ) - - (_, _) -> - ( - (ctrl_or_focus_character model target_char_id target_char), - (Task.attempt - (Struct.Event.attempted) - (Action.Scroll.to - (Struct.Character.get_location target_char) - model.ui - ) - ) - ) - - Nothing -> - ( - (Struct.Model.invalidate - (Struct.Error.new - Struct.Error.Programming - "SelectCharacter: Unknown char selected." - ) - model - ), - Cmd.none - ) +second_click_on target_char_id model = + if (Struct.CharacterTurn.has_active_character model.char_turn) + then (Update.CharacterTurn.ToggleTarget.apply_to_ref target_char_id model) + else (Update.CharacterTurn.apply_to target_char_id model) first_click_on : ( - Struct.Model.Type -> Int -> + Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) ) -first_click_on model target_char_id = - if - ( - (Struct.CharacterTurn.maybe_get_target model.char_turn) - == - (Just target_char_id) - ) - then - (model, Cmd.none) - else - case (Struct.Battle.get_character target_char_id model.battle) of - (Just target_char) -> - ( - {model | - ui = - (Struct.UI.set_previous_action - (Just (Struct.UI.SelectedCharacter target_char_id)) - (Struct.UI.set_displayed_tab - Struct.UI.StatusTab - (Struct.UI.set_displayed_nav - (get_character_navigator model.battle target_char) - model.ui - ) - ) - ) - }, - Cmd.none - ) - - Nothing -> - ( - (Struct.Model.invalidate - (Struct.Error.new - Struct.Error.Programming - "SelectCharacter: Unknown char selected." - ) - model - ), - Cmd.none +first_click_on target_char_id model = + (Update.Sequence.sequence + [ + (Update.Character.DisplayInfo.apply_to target_char_id), + (Update.Character.DisplayNavigator.apply_to_ref target_char_id) + ] + {model | + ui = + (Struct.UI.set_previous_action + (Just (Struct.UI.SelectedCharacter target_ref)) + model.ui ) + } + ) -------------------------------------------------------------------------------- -- EXPORTED -------------------------------------------------------------------- @@ -301,5 +143,5 @@ apply_to model target_char_id = == (Just (Struct.UI.SelectedCharacter target_char_id)) ) - then (second_click_on model target_char_id) - else (first_click_on model target_char_id) + then (second_click_on target_char_id model) + else (first_click_on target_char_id model) diff --git a/src/battle/src/Update/ChangeScale.elm b/src/battle/src/Update/UI/ChangeScale.elm index bb98e84..b5884ff 100644 --- a/src/battle/src/Update/ChangeScale.elm +++ b/src/battle/src/Update/UI/ChangeScale.elm @@ -1,4 +1,4 @@ -module Update.ChangeScale exposing (apply_to) +module Update.UI.ChangeScale exposing (apply_to) -- Local Module ---------------------------------------------------------------- import Struct.Event diff --git a/src/battle/src/Update/GoToMainMenu.elm b/src/battle/src/Update/UI/GoToMainMenu.elm index a0471f2..7aec7b2 100644 --- a/src/battle/src/Update/GoToMainMenu.elm +++ b/src/battle/src/Update/UI/GoToMainMenu.elm @@ -1,4 +1,4 @@ -module Update.GoToMainMenu exposing (apply_to) +module Update.UI.GoToMainMenu exposing (apply_to) -- Shared ---------------------------------------------------------------------- import Action.Ports diff --git a/src/battle/src/Update/SelectTab.elm b/src/battle/src/Update/UI/SelectTab.elm index 86ef4e7..37ab910 100644 --- a/src/battle/src/Update/SelectTab.elm +++ b/src/battle/src/Update/UI/SelectTab.elm @@ -1,4 +1,4 @@ -module Update.SelectTab exposing (apply_to) +module Update.UI.SelectTab exposing (apply_to) -- Local Module ---------------------------------------------------------------- import Struct.Model diff --git a/src/shared/elm/Action/Ports.elm b/src/shared/elm/Shared/Action/Ports.elm index 8da9bac..0f87da5 100644 --- a/src/shared/elm/Action/Ports.elm +++ b/src/shared/elm/Shared/Action/Ports.elm @@ -1,4 +1,4 @@ -port module Action.Ports exposing (..) +port module Shared.Action.Ports exposing (..) port store_new_session : (String, String) -> (Cmd msg) port reset_session : () -> (Cmd msg) diff --git a/src/shared/elm/Comm/GoTo.elm b/src/shared/elm/Shared/Comm/GoTo.elm index ea8d7af..19e9619 100644 --- a/src/shared/elm/Comm/GoTo.elm +++ b/src/shared/elm/Shared/Comm/GoTo.elm @@ -1,4 +1,4 @@ -module Comm.GoTo exposing (decode) +module Shared.Comm.GoTo exposing (decode) -- Elm ------------------------------------------------------------------------- import Json.Decode diff --git a/src/shared/elm/Struct/Flags.elm b/src/shared/elm/Shared/Struct/Flags.elm index 475d1f2..f57362e 100644 --- a/src/shared/elm/Struct/Flags.elm +++ b/src/shared/elm/Shared/Struct/Flags.elm @@ -1,4 +1,4 @@ -module Struct.Flags exposing +module Shared.Struct.Flags exposing ( Type, maybe_get_parameter, diff --git a/src/shared/elm/Shared/Update/Sequence.elm b/src/shared/elm/Shared/Update/Sequence.elm new file mode 100644 index 0000000..ff33ae4 --- /dev/null +++ b/src/shared/elm/Shared/Update/Sequence.elm @@ -0,0 +1,37 @@ +module Shared.Update.Sequence exposing (sequence) + +-- Elm ------------------------------------------------------------------------- +import List + +-- Local Module ---------------------------------------------------------------- +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +sequence_step : ( + (Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type))) + -> (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + -> (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + ) +sequence_step action (model, cmd_list) = + let (next_model, new_cmd) = (action model) in + case new_cmd of + Cmd.none -> (next_model, cmd_list) + _ -> (next_model, (cmd_list ++ new_cmds)) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +sequence : ( + (List + (Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type))) + ) + -> (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +sequence actions model = + let (final_model, cmds) = (List.foldr (sequence_step) (model, []) actions) in + case cmds of + [] -> (final_model, Cmd.none) + [cmd] -> (final_model, cmd) + _ -> (final_model, (Cmd.batch cmds)) diff --git a/src/shared/elm/Util/Array.elm b/src/shared/elm/Shared/Util/Array.elm index 26d13f6..234b4c4 100644 --- a/src/shared/elm/Util/Array.elm +++ b/src/shared/elm/Shared/Util/Array.elm @@ -1,4 +1,4 @@ -module Util.Array exposing +module Shared.Util.Array exposing ( update, update_unsafe, diff --git a/src/shared/elm/Util/Html.elm b/src/shared/elm/Shared/Util/Html.elm index 42eadba..8b803f7 100644 --- a/src/shared/elm/Util/Html.elm +++ b/src/shared/elm/Shared/Util/Html.elm @@ -1,4 +1,4 @@ -module Util.Html exposing (nothing) +module Shared.Util.Html exposing (nothing) import Html diff --git a/src/shared/elm/Util/Http.elm b/src/shared/elm/Shared/Util/Http.elm index c098dc7..2e57819 100644 --- a/src/shared/elm/Util/Http.elm +++ b/src/shared/elm/Shared/Util/Http.elm @@ -1,4 +1,4 @@ -module Util.Http exposing (error_to_string) +module Shared.Util.Http exposing (error_to_string) import Http diff --git a/src/shared/elm/Util/List.elm b/src/shared/elm/Shared/Util/List.elm index 829dd3e..6a22a5a 100644 --- a/src/shared/elm/Util/List.elm +++ b/src/shared/elm/Shared/Util/List.elm @@ -1,4 +1,4 @@ -module Util.List exposing (..) +module Shared.Util.List exposing (..) import Set @@ -6,12 +6,9 @@ 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)) + case l of + (head :: tail) -> (Just (head, tail)) + [] -> Nothing get_first : (a -> Bool) -> (List a) -> (Maybe a) get_first fun list = |