| summaryrefslogtreecommitdiff |
diff options
Diffstat (limited to 'src/altar/src')
26 files changed, 2110 insertions, 0 deletions
diff --git a/src/altar/src/Comm/AddChar.elm b/src/altar/src/Comm/AddChar.elm new file mode 100644 index 0000000..1270b0d --- /dev/null +++ b/src/altar/src/Comm/AddChar.elm @@ -0,0 +1,40 @@ +module Comm.AddChar exposing (decode) + +-- Elm ------------------------------------------------------------------------- +import Dict + +import Json.Decode + +-- Battlemap ------------------------------------------------------------------- +import Data.Weapons + +import Struct.Character +import Struct.Model +import Struct.ServerReply +import Struct.Weapon + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +weapon_getter : Struct.Model.Type -> Struct.Weapon.Ref -> Struct.Weapon.Type +weapon_getter model ref = + case (Dict.get ref model.weapons) of + (Just w) -> w + Nothing -> Data.Weapons.none + +internal_decoder : Struct.Character.Type -> Struct.ServerReply.Type +internal_decoder char = (Struct.ServerReply.AddCharacter char) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +decode : (Struct.Model.Type -> (Json.Decode.Decoder Struct.ServerReply.Type)) +decode model = + (Json.Decode.map + (internal_decoder) + (Struct.Character.decoder (weapon_getter model)) + ) diff --git a/src/altar/src/Comm/Send.elm b/src/altar/src/Comm/Send.elm new file mode 100644 index 0000000..485b9b9 --- /dev/null +++ b/src/altar/src/Comm/Send.elm @@ -0,0 +1,74 @@ +module Comm.Send exposing (try_sending) + +-- Elm ------------------------------------------------------------------------- +import Http + +import Json.Decode +import Json.Encode + +-- Battlemap ------------------------------------------------------------------- +import Comm.AddChar +import Comm.SetMap +import Comm.SetTimeline +import Comm.TurnResults + +import Struct.Event +import Struct.ServerReply +import Struct.Model + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +internal_decoder : ( + Struct.Model.Type -> + String -> + (Json.Decode.Decoder Struct.ServerReply.Type) + ) +internal_decoder model reply_type = + case reply_type of + "add_char" -> (Comm.AddChar.decode model) + "set_map" -> (Comm.SetMap.decode model) + "turn_results" -> (Comm.TurnResults.decode) + "set_timeline" -> (Comm.SetTimeline.decode) + other -> + (Json.Decode.fail + ( + "Unknown server command \"" + ++ other + ++ "\"" + ) + ) + +decode : Struct.Model.Type -> (Json.Decode.Decoder Struct.ServerReply.Type) +decode model = + (Json.Decode.field "msg" Json.Decode.string) + |> (Json.Decode.andThen (internal_decoder model)) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try_sending : ( + Struct.Model.Type -> + String -> + (Struct.Model.Type -> (Maybe Json.Encode.Value)) -> + (Maybe (Cmd Struct.Event.Type)) + ) +try_sending model recipient try_encoding_fun = + case (try_encoding_fun model) of + (Just serial) -> + (Just + (Http.send + Struct.Event.ServerReplied + (Http.post + recipient + (Http.jsonBody serial) + (Json.Decode.list (decode model)) + ) + ) + ) + + Nothing -> Nothing diff --git a/src/altar/src/Constants/IO.elm b/src/altar/src/Constants/IO.elm new file mode 100644 index 0000000..dbf6422 --- /dev/null +++ b/src/altar/src/Constants/IO.elm @@ -0,0 +1,13 @@ +module Constants.IO exposing (..) + +base_url : String +base_url = "${BASE_URL}" + +altar_handler_url : String +altar_handler_url = (base_url ++ "/handler/altar") + +altar_saving_handler : String +altar_saving_handler = (battlemap_handler_url ++ "/save") + +altar_loading_handler : String +altar_loading_handler = (battlemap_handler_url ++ "/load") diff --git a/src/altar/src/Data/Weapons.elm b/src/altar/src/Data/Weapons.elm new file mode 100644 index 0000000..e74d89e --- /dev/null +++ b/src/altar/src/Data/Weapons.elm @@ -0,0 +1,309 @@ +module Data.Weapons exposing (generate_dict, none) +-- Elm ------------------------------------------------------------------------- +import Dict + +-- Battlemap ------------------------------------------------------------------- +import Struct.Weapon + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +dataset : (List (Struct.Weapon.Ref, Struct.Weapon.Type)) +dataset = + [ + -- TODO: have those in separate text files, and put them here only at + -- compilation. + ( + 0, + (Struct.Weapon.new + 0 + "None" + Struct.Weapon.Melee + Struct.Weapon.Short + Struct.Weapon.Blunt + Struct.Weapon.Light + ) + ), + ( + 1, + (Struct.Weapon.new + 1 + "Dagger" + Struct.Weapon.Melee + Struct.Weapon.Short + Struct.Weapon.Slash + Struct.Weapon.Light + ) + ), + ( + 2, + (Struct.Weapon.new + 2 + "Sword" + Struct.Weapon.Melee + Struct.Weapon.Short + Struct.Weapon.Slash + Struct.Weapon.Heavy + ) + ), + ( + 3, + (Struct.Weapon.new + 3 + "Claymore" + Struct.Weapon.Melee + Struct.Weapon.Long + Struct.Weapon.Slash + Struct.Weapon.Light + ) + ), + ( + 4, + (Struct.Weapon.new + 4 + "Bardiche" + Struct.Weapon.Melee + Struct.Weapon.Long + Struct.Weapon.Slash + Struct.Weapon.Heavy + ) + ), + ( + 5, + (Struct.Weapon.new + 5 + "Stiletto" + Struct.Weapon.Melee + Struct.Weapon.Short + Struct.Weapon.Pierce + Struct.Weapon.Light + ) + ), + ( + 6, + (Struct.Weapon.new + 6 + "Pickaxe" + Struct.Weapon.Melee + Struct.Weapon.Short + Struct.Weapon.Pierce + Struct.Weapon.Heavy + ) + ), + ( + 7, + (Struct.Weapon.new + 7 + "Rapier" + Struct.Weapon.Melee + Struct.Weapon.Long + Struct.Weapon.Pierce + Struct.Weapon.Light + ) + ), + ( + 8, + (Struct.Weapon.new + 8 + "Pike" + Struct.Weapon.Melee + Struct.Weapon.Long + Struct.Weapon.Pierce + Struct.Weapon.Heavy + ) + ), + ( + 9, + (Struct.Weapon.new + 9 + "Club" + Struct.Weapon.Melee + Struct.Weapon.Short + Struct.Weapon.Blunt + Struct.Weapon.Light + ) + ), + ( + 10, + (Struct.Weapon.new + 10 + "Mace" + Struct.Weapon.Melee + Struct.Weapon.Short + Struct.Weapon.Blunt + Struct.Weapon.Heavy + ) + ), + ( + 11, + (Struct.Weapon.new + 11 + "Staff" + Struct.Weapon.Melee + Struct.Weapon.Long + Struct.Weapon.Blunt + Struct.Weapon.Light + ) + ), + ( + 12, + (Struct.Weapon.new + 12 + "War Hammer" + Struct.Weapon.Melee + Struct.Weapon.Long + Struct.Weapon.Blunt + Struct.Weapon.Heavy + ) + ), + ( + 13, + (Struct.Weapon.new + 13 + "Short Bow (Broadhead)" + Struct.Weapon.Ranged + Struct.Weapon.Short + Struct.Weapon.Slash + Struct.Weapon.Light + ) + ), + ( + 14, + (Struct.Weapon.new + 14 + "Short Bow (Blunt)" + Struct.Weapon.Ranged + Struct.Weapon.Short + Struct.Weapon.Blunt + Struct.Weapon.Light + ) + ), + ( + 15, + (Struct.Weapon.new + 15 + "Short Bow (Bodkin Point)" + Struct.Weapon.Ranged + Struct.Weapon.Short + Struct.Weapon.Pierce + Struct.Weapon.Light + ) + ), + ( + 16, + (Struct.Weapon.new + 16 + "Long Bow (Broadhead)" + Struct.Weapon.Ranged + Struct.Weapon.Long + Struct.Weapon.Slash + Struct.Weapon.Light + ) + ), + ( + 17, + (Struct.Weapon.new + 17 + "Long Bow (Blunt)" + Struct.Weapon.Ranged + Struct.Weapon.Long + Struct.Weapon.Blunt + Struct.Weapon.Light + ) + ), + ( + 18, + (Struct.Weapon.new + 18 + "Long Bow (Bodkin Point)" + Struct.Weapon.Ranged + Struct.Weapon.Long + Struct.Weapon.Pierce + Struct.Weapon.Light + ) + ), + ( + 19, + (Struct.Weapon.new + 19 + "Crossbow (Broadhead)" + Struct.Weapon.Ranged + Struct.Weapon.Short + Struct.Weapon.Slash + Struct.Weapon.Heavy + ) + ), + ( + 20, + (Struct.Weapon.new + 20 + "Crossbow (Blunt)" + Struct.Weapon.Ranged + Struct.Weapon.Short + Struct.Weapon.Blunt + Struct.Weapon.Heavy + ) + ), + ( + 21, + (Struct.Weapon.new + 21 + "Crossbow (Bodkin Point)" + Struct.Weapon.Ranged + Struct.Weapon.Short + Struct.Weapon.Pierce + Struct.Weapon.Heavy + ) + ), + ( + 22, + (Struct.Weapon.new + 22 + "Arbalest (Broadhead)" + Struct.Weapon.Ranged + Struct.Weapon.Long + Struct.Weapon.Slash + Struct.Weapon.Heavy + ) + ), + ( + 23, + (Struct.Weapon.new + 23 + "Arbalest (Blunt)" + Struct.Weapon.Ranged + Struct.Weapon.Long + Struct.Weapon.Blunt + Struct.Weapon.Heavy + ) + ), + ( + 24, + (Struct.Weapon.new + 24 + "Arbalest (Bodkin Point)" + Struct.Weapon.Ranged + Struct.Weapon.Long + Struct.Weapon.Pierce + Struct.Weapon.Heavy + ) + ) + ] + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +generate_dict : (Dict.Dict Struct.Weapon.Ref Struct.Weapon.Type) +generate_dict = (Dict.fromList dataset) + +-- If it's not found. +none : (Struct.Weapon.Type) +none = + (Struct.Weapon.new + 0 + "None" + Struct.Weapon.Melee + Struct.Weapon.Short + Struct.Weapon.Blunt + Struct.Weapon.Light + ) diff --git a/src/altar/src/ElmModule/Init.elm b/src/altar/src/ElmModule/Init.elm new file mode 100644 index 0000000..f8fb439 --- /dev/null +++ b/src/altar/src/ElmModule/Init.elm @@ -0,0 +1,27 @@ +module ElmModule.Init exposing (init) + +-- Battlemap ------------------------------------------------------------------- +import Comm.LoadBattlemap + +import Struct.Event +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +init : (Struct.Model.Type, (Cmd Struct.Event.Type)) +init = + let + model = (Struct.Model.new) + in + ( + model, + (case (Comm.LoadBattlemap.try model) of + (Just cmd) -> cmd + Nothing -> Cmd.none + ) + ) diff --git a/src/altar/src/ElmModule/Subscriptions.elm b/src/altar/src/ElmModule/Subscriptions.elm new file mode 100644 index 0000000..c8126b1 --- /dev/null +++ b/src/altar/src/ElmModule/Subscriptions.elm @@ -0,0 +1,7 @@ +module ElmModule.Subscriptions exposing (..) + +import Struct.Model +import Struct.Event + +subscriptions : Struct.Model.Type -> (Sub Struct.Event.Type) +subscriptions model = Sub.none diff --git a/src/altar/src/ElmModule/Update.elm b/src/altar/src/ElmModule/Update.elm new file mode 100644 index 0000000..22217bf --- /dev/null +++ b/src/altar/src/ElmModule/Update.elm @@ -0,0 +1,62 @@ +module ElmModule.Update exposing (update) + +-- Elm ------------------------------------------------------------------------- + +-- Battlemap ------------------------------------------------------------------- +import Struct.Event +import Struct.Model + +import Update.ChangeScale +import Update.DisplayCharacterInfo +import Update.EndTurn +import Update.HandleServerReply +import Update.RequestDirection +import Update.SelectCharacter +import Update.SelectTab +import Update.SelectTile +import Update.SendLoadBattlemapRequest +import Update.SwitchTeam +import Update.SwitchWeapon + +update : ( + Struct.Event.Type -> + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +update event model = + let + new_model = (Struct.Model.clear_error model) + in + case event of + (Struct.Event.DirectionRequested d) -> + (Update.RequestDirection.apply_to new_model d) + + (Struct.Event.TileSelected loc) -> + (Update.SelectTile.apply_to new_model loc) + + (Struct.Event.CharacterSelected char_id) -> + (Update.SelectCharacter.apply_to new_model char_id) + + (Struct.Event.CharacterInfoRequested char_id) -> + (Update.DisplayCharacterInfo.apply_to new_model char_id) + + Struct.Event.TurnEnded -> + (Update.EndTurn.apply_to new_model) + + (Struct.Event.ScaleChangeRequested mod) -> + (Update.ChangeScale.apply_to new_model mod) + + (Struct.Event.TabSelected tab) -> + (Update.SelectTab.apply_to new_model tab) + + Struct.Event.DebugTeamSwitchRequest -> + (Update.SwitchTeam.apply_to new_model) + + (Struct.Event.DebugLoadBattlemapRequest) -> + (Update.SendLoadBattlemapRequest.apply_to new_model) + + (Struct.Event.ServerReplied result) -> + (Update.HandleServerReply.apply_to model result) + + Struct.Event.WeaponSwitchRequest -> + (Update.SwitchWeapon.apply_to new_model) diff --git a/src/altar/src/ElmModule/View.elm b/src/altar/src/ElmModule/View.elm new file mode 100644 index 0000000..63e382f --- /dev/null +++ b/src/altar/src/ElmModule/View.elm @@ -0,0 +1,54 @@ +module ElmModule.View exposing (view) + +-- Elm ------------------------------------------------------------------------- +import Html +import Html.Attributes + +-- Battlemap ------------------------------------------------------------------- +import Struct.Event +import Struct.Model + +import View.Battlemap +import View.SideBar +import View.Footer + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +view : Struct.Model.Type -> (Html.Html Struct.Event.Type) +view model = + (Html.div + [ + (Html.Attributes.class "fullscreen-module") + ] + [ + (Html.div + [ + (Html.Attributes.class "battlemap-left-panel") + ] + [ + (Html.div + [ + (Html.Attributes.class "battlemap-container") + ] + [ + (View.Battlemap.get_html model) + ] + ), + (View.Footer.get_html model) + ] + ), + (Html.div + [ + (Html.Attributes.class "battlemap-right-panel") + ] + [ + (View.SideBar.get_html model) + ] + ) + ] + ) diff --git a/src/altar/src/Main.elm b/src/altar/src/Main.elm new file mode 100644 index 0000000..96b267f --- /dev/null +++ b/src/altar/src/Main.elm @@ -0,0 +1,22 @@ +-- Elm ------------------------------------------------------------------------ +import Html + +-- Battlemap ------------------------------------------------------------------- +import Struct.Model +import Struct.Event + +import ElmModule.Init +import ElmModule.Subscriptions +import ElmModule.View +import ElmModule.Update + +main : (Program Never Struct.Model.Type Struct.Event.Type) +main = + (Html.program + { + init = ElmModule.Init.init, + view = ElmModule.View.view, + update = ElmModule.Update.update, + subscriptions = ElmModule.Subscriptions.subscriptions + } + ) diff --git a/src/altar/src/Struct/Attributes.elm b/src/altar/src/Struct/Attributes.elm new file mode 100644 index 0000000..407856d --- /dev/null +++ b/src/altar/src/Struct/Attributes.elm @@ -0,0 +1,134 @@ +module Struct.Attributes exposing + ( + Type, + get_constitution, + get_dexterity, + get_intelligence, + get_mind, + get_speed, + get_strength, + mod_constitution, + mod_dexterity, + mod_intelligence, + mod_mind, + mod_speed, + mod_strength, + new, + decoder + ) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode +import Json.Decode.Pipeline + +-- Battlemap ------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + constitution : Int, + dexterity : Int, + intelligence : Int, + mind : Int, + speed : Int, + strength : Int + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_within_range : Int -> Int -> Int -> Int +get_within_range vmin vmax v = (min vmax (max vmin v)) + +get_within_att_range : Int -> Int +get_within_att_range v = (get_within_range 0 100 v) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_constitution : Type -> Int +get_constitution t = t.constitution + +get_dexterity : Type -> Int +get_dexterity t = t.dexterity + +get_intelligence : Type -> Int +get_intelligence t = t.intelligence + +get_mind : Type -> Int +get_mind t = t.mind + +get_speed : Type -> Int +get_speed t = t.speed + +get_strength : Type -> Int +get_strength t = t.strength + +mod_constitution : Int -> Type -> Type +mod_constitution i t = + {t | + constitution = (get_within_att_range (i + t.constitution)) + } + +mod_dexterity : Int -> Type -> Type +mod_dexterity i t = + {t | + dexterity = (get_within_att_range (i + t.dexterity)) + } + +mod_intelligence : Int -> Type -> Type +mod_intelligence i t = + {t | + intelligence = (get_within_att_range (i + t.intelligence)) + } + +mod_mind : Int -> Type -> Type +mod_mind i t = + {t | + mind = (get_within_att_range (i + t.mind)) + } + +mod_speed : Int -> Type -> Type +mod_speed i t = + {t | + speed = (get_within_att_range (i + t.speed)) + } + +mod_strength : Int -> Type -> Type +mod_strength i t = + {t | + strength = (get_within_att_range (i + t.strength)) + } + +new : ( + Int -> -- constitution + Int -> -- dexterity + Int -> -- intelligence + Int -> -- mind + Int -> -- speed + Int -> -- strength + Type + ) +new con dex int min spe str = + { + constitution = con, + dexterity = dex, + intelligence = int, + mind = min, + speed = spe, + strength = str + } + +decoder : (Json.Decode.Decoder Type) +decoder = + (Json.Decode.Pipeline.decode + Type + |> (Json.Decode.Pipeline.required "con" Json.Decode.int) + |> (Json.Decode.Pipeline.required "dex" Json.Decode.int) + |> (Json.Decode.Pipeline.required "int" Json.Decode.int) + |> (Json.Decode.Pipeline.required "min" Json.Decode.int) + |> (Json.Decode.Pipeline.required "spe" Json.Decode.int) + |> (Json.Decode.Pipeline.required "str" Json.Decode.int) + ) diff --git a/src/altar/src/Struct/Character.elm b/src/altar/src/Struct/Character.elm new file mode 100644 index 0000000..d4f65f7 --- /dev/null +++ b/src/altar/src/Struct/Character.elm @@ -0,0 +1,174 @@ +module Struct.Character exposing + ( + Type, + Ref, + get_ref, + get_player_id, + get_name, + get_icon_id, + get_portrait_id, + get_current_health, + set_current_health, + get_location, + set_location, + get_attributes, + get_statistics, + is_enabled, + set_enabled, + get_weapons, + set_weapons, + decoder + ) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode +import Json.Decode.Pipeline + +-- Battlemap ------------------------------------------------------------------- +import Struct.Attributes +import Struct.Location +import Struct.Statistics +import Struct.Weapon +import Struct.WeaponSet + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias PartiallyDecoded = + { + ix : Int, + nam : String, + ico : String, + prt : String, + lc : Struct.Location.Type, + hea : Int, + pla : String, + ena : Bool, + att : Struct.Attributes.Type, + awp : Int, + swp : Int + } + +type alias Type = + { + id : String, + name : String, + icon : String, + portrait : String, + location : Struct.Location.Type, + health : Int, + player_id : String, + enabled : Bool, + attributes : Struct.Attributes.Type, + statistics : Struct.Statistics.Type, + weapons : Struct.WeaponSet.Type + } + +type alias Ref = String + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +finish_decoding : ( + (Struct.Weapon.Ref -> Struct.Weapon.Type) -> + PartiallyDecoded -> + Type + ) +finish_decoding get_weapon add_char = + let + active_weapon = (get_weapon add_char.awp) + secondary_weapon = (get_weapon add_char.swp) + weapon_set = (Struct.WeaponSet.new active_weapon secondary_weapon) + in + { + id = (toString add_char.ix), + name = add_char.nam, + icon = add_char.ico, + portrait = add_char.prt, + location = add_char.lc, + health = add_char.hea, + attributes = add_char.att, + statistics = (Struct.Statistics.new add_char.att weapon_set), + player_id = add_char.pla, + enabled = add_char.ena, + weapons = weapon_set + } + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_ref : Type -> Ref +get_ref c = c.id + +get_name : Type -> String +get_name c = c.name + +get_player_id : Type -> String +get_player_id c = c.player_id + +get_icon_id : Type -> String +get_icon_id c = c.icon + +get_portrait_id : Type -> String +get_portrait_id c = c.portrait + +get_current_health : Type -> Int +get_current_health c = c.health + +set_current_health : Int -> Type -> Type +set_current_health health c = {c | health = health} + +get_location : Type -> Struct.Location.Type +get_location t = t.location + +set_location : Struct.Location.Type -> Type -> Type +set_location location char = {char | location = location} + +get_attributes : Type -> Struct.Attributes.Type +get_attributes char = char.attributes + +get_statistics : Type -> Struct.Statistics.Type +get_statistics char = char.statistics + +is_enabled : Type -> Bool +is_enabled char = char.enabled + +set_enabled : Bool -> Type -> Type +set_enabled enabled char = {char | enabled = enabled} + +get_weapons : Type -> Struct.WeaponSet.Type +get_weapons char = char.weapons + +set_weapons : Struct.WeaponSet.Type -> Type -> Type +set_weapons weapons char = + {char | + weapons = weapons, + statistics = + (Struct.Statistics.new + char.attributes + weapons + ) + } + +decoder : ( + (Struct.Weapon.Ref -> Struct.Weapon.Type) -> + (Json.Decode.Decoder Type) + ) +decoder get_weapon = + (Json.Decode.map + (finish_decoding get_weapon) + (Json.Decode.Pipeline.decode + PartiallyDecoded + |> (Json.Decode.Pipeline.required "ix" Json.Decode.int) + |> (Json.Decode.Pipeline.required "nam" Json.Decode.string) + |> (Json.Decode.Pipeline.required "ico" Json.Decode.string) + |> (Json.Decode.Pipeline.required "prt" Json.Decode.string) + |> (Json.Decode.Pipeline.required "lc" (Struct.Location.decoder)) + |> (Json.Decode.Pipeline.required "hea" Json.Decode.int) + |> (Json.Decode.Pipeline.required "pla" Json.Decode.string) + |> (Json.Decode.Pipeline.required "ena" Json.Decode.bool) + |> (Json.Decode.Pipeline.required "att" (Struct.Attributes.decoder)) + |> (Json.Decode.Pipeline.required "awp" Json.Decode.int) + |> (Json.Decode.Pipeline.required "swp" Json.Decode.int) + ) + ) diff --git a/src/altar/src/Struct/Error.elm b/src/altar/src/Struct/Error.elm new file mode 100644 index 0000000..3607d1d --- /dev/null +++ b/src/altar/src/Struct/Error.elm @@ -0,0 +1,43 @@ +module Struct.Error exposing (Type, Mode(..), new, to_string) + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Mode = + IllegalAction + | Programming + | Unimplemented + | Networking + +type alias Type = + { + mode: Mode, + message: String + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +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): " + Unimplemented -> "Update discarded due to unimplemented feature: " + Networking -> "Error while conversing with the server: " + ) + ++ e.message + ) + diff --git a/src/altar/src/Struct/Event.elm b/src/altar/src/Struct/Event.elm new file mode 100644 index 0000000..ecda85b --- /dev/null +++ b/src/altar/src/Struct/Event.elm @@ -0,0 +1,27 @@ +module Struct.Event exposing (Type(..)) + +-- Elm ------------------------------------------------------------------------- +import Http + +-- Battlemap ------------------------------------------------------------------- +import Struct.Character +import Struct.Direction +import Struct.Location +import Struct.ServerReply +import Struct.UI + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Type = + DirectionRequested Struct.Direction.Type + | TileSelected Struct.Location.Ref + | CharacterSelected Struct.Character.Ref + | CharacterInfoRequested Struct.Character.Ref + | TurnEnded + | ScaleChangeRequested Float + | TabSelected Struct.UI.Tab + | ServerReplied (Result Http.Error (List Struct.ServerReply.Type)) + | DebugTeamSwitchRequest + | DebugLoadBattlemapRequest + | WeaponSwitchRequest diff --git a/src/altar/src/Struct/Model.elm b/src/altar/src/Struct/Model.elm new file mode 100644 index 0000000..4955163 --- /dev/null +++ b/src/altar/src/Struct/Model.elm @@ -0,0 +1,89 @@ +module Struct.Model exposing + ( + Type, + new, + add_character, + invalidate, + reset, + clear_error + ) + +-- Elm ------------------------------------------------------------------------- +import Dict +import Array + +-- Battlemap ------------------------------------------------------------------- +import Data.Weapons + +import Struct.Battlemap +import Struct.Character +import Struct.CharacterTurn +import Struct.TurnResult +import Struct.Error +import Struct.UI +import Struct.Weapon + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + battlemap: Struct.Battlemap.Type, + characters: (Dict.Dict Struct.Character.Ref Struct.Character.Type), + weapons: (Dict.Dict Struct.Weapon.Ref Struct.Weapon.Type), + error: (Maybe Struct.Error.Type), + player_id: String, + ui: Struct.UI.Type, + char_turn: Struct.CharacterTurn.Type, + timeline: (Array.Array Struct.TurnResult.Type) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Type +new = + { + battlemap = (Struct.Battlemap.empty), + characters = (Dict.empty), + weapons = (Data.Weapons.generate_dict), + error = Nothing, + player_id = "0", + ui = (Struct.UI.default), + char_turn = (Struct.CharacterTurn.new), + timeline = (Array.empty) + } + +add_character : Struct.Character.Type -> Type -> Type +add_character char model = + {model | + characters = + (Dict.insert + (Struct.Character.get_ref char) + char + model.characters + ) + } + +reset : Type -> (Dict.Dict Struct.Character.Ref Struct.Character.Type) -> Type +reset model characters = + {model | + characters = characters, + error = Nothing, + ui = (Struct.UI.set_previous_action model.ui Nothing), + char_turn = (Struct.CharacterTurn.new) + } + +invalidate : Type -> Struct.Error.Type -> Type +invalidate model err = + {model | + error = (Just err), + ui = (Struct.UI.set_displayed_tab model.ui Struct.UI.StatusTab) + } + +clear_error : Type -> Type +clear_error model = {model | error = Nothing} diff --git a/src/altar/src/Struct/ServerReply.elm b/src/altar/src/Struct/ServerReply.elm new file mode 100644 index 0000000..b986abe --- /dev/null +++ b/src/altar/src/Struct/ServerReply.elm @@ -0,0 +1,27 @@ +module Struct.ServerReply exposing (Type(..)) + +-- Elm ------------------------------------------------------------------------- + +-- Battlemap ------------------------------------------------------------------- +import Struct.Battlemap +import Struct.Character +import Struct.TurnResult + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +type Type = + Okay + | AddCharacter Struct.Character.Type + | SetMap Struct.Battlemap.Type + | TurnResults (List Struct.TurnResult.Type) + | SetTimeline (List Struct.TurnResult.Type) + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- diff --git a/src/altar/src/Struct/Statistics.elm b/src/altar/src/Struct/Statistics.elm new file mode 100644 index 0000000..aad1411 --- /dev/null +++ b/src/altar/src/Struct/Statistics.elm @@ -0,0 +1,170 @@ +module Struct.Statistics exposing + ( + Type, + get_movement_points, + get_max_health, + get_dodges, + get_parries, + get_damage_min, + get_damage_max, + get_accuracy, + get_double_hits, + get_critical_hits, + new + ) + +-- Elm ------------------------------------------------------------------------- +import List + +-- Battlemap ------------------------------------------------------------------- +import Struct.Attributes +import Struct.Weapon +import Struct.WeaponSet + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + movement_points : Int, + max_health : Int, + dodges : Int, + parries : Int, + damage_min : Int, + damage_max : Int, + accuracy : Int, + double_hits : Int, + critical_hits : Int + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +average : (List Int) -> Float +average l = ((toFloat (List.sum l)) / (toFloat (List.length l))) + +float_to_int : Float -> Int +float_to_int f = + (ceiling f) + +gentle_squared_growth : Int -> Int +gentle_squared_growth v = (float_to_int (((toFloat v)^1.8)/20.0)) + +gentle_squared_growth_f : Float -> Int +gentle_squared_growth_f v = (float_to_int ((v^1.8)/20.0)) + +sudden_squared_growth : Int -> Int +sudden_squared_growth v = (float_to_int (((toFloat v)^2.5)/1000.0)) + +sudden_squared_growth_f : Float -> Int +sudden_squared_growth_f v = (float_to_int ((v^2.5)/1000.0)) + +sudden_exp_growth : Int -> Int +sudden_exp_growth v = (float_to_int (4.0^((toFloat v)/25.0))) + +sudden_exp_growth_f : Float -> Int +sudden_exp_growth_f f = (float_to_int (4.0^(f/25.0))) + +already_high_slow_growth : Int -> Int +already_high_slow_growth v = + (float_to_int + (30.0 * (logBase 2.718281828459 (((toFloat v) + 5.0)/4.0))) + ) + +damage_base_mod : Float -> Float +damage_base_mod str = (((str^1.8)/2000.0) - 0.75) + +apply_damage_base_mod : Float -> Float -> Int +apply_damage_base_mod bmod dmg = + (max 0 (float_to_int (dmg + (bmod * dmg)))) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_movement_points : Type -> Int +get_movement_points t = t.movement_points + +get_max_health : Type -> Int +get_max_health t = t.max_health + +get_dodges : Type -> Int +get_dodges t = t.dodges + +get_parries : Type -> Int +get_parries t = t.parries + +get_damage_min : Type -> Int +get_damage_min t = t.damage_min + +get_damage_max : Type -> Int +get_damage_max t = t.damage_max + +get_accuracy : Type -> Int +get_accuracy t = t.accuracy + +get_double_hits : Type -> Int +get_double_hits t = t.double_hits + +get_critical_hits : Type -> Int +get_critical_hits t = t.critical_hits + +new : ( + Struct.Attributes.Type -> + Struct.WeaponSet.Type -> + Type + ) +new att wp_set = + let + active_weapon = (Struct.WeaponSet.get_active_weapon wp_set) + actual_att = (Struct.Weapon.apply_to_attributes active_weapon att) + constitution = (Struct.Attributes.get_constitution actual_att) + dexterity = (Struct.Attributes.get_dexterity actual_att) + intelligence = (Struct.Attributes.get_intelligence actual_att) + mind = (Struct.Attributes.get_mind actual_att) + speed = (Struct.Attributes.get_speed actual_att) + strength = (Struct.Attributes.get_strength actual_att) + dmg_bmod = (damage_base_mod (toFloat strength)) + in + { + movement_points = + (gentle_squared_growth_f + (average [mind, constitution, constitution, speed, speed, speed]) + ), + max_health = + (gentle_squared_growth_f + (average [mind, constitution, constitution]) + ), + dodges = + (clamp + 0 + 100 + (sudden_exp_growth_f + (average + [dexterity, mind, speed] + ) + ) + ), + parries = + (clamp + 0 + 75 + (sudden_exp_growth_f + (average [dexterity, intelligence, speed, strength]) + ) + ), + damage_min = + (apply_damage_base_mod + dmg_bmod + (toFloat (Struct.Weapon.get_min_damage active_weapon)) + ), + damage_max = + (apply_damage_base_mod + dmg_bmod + (toFloat (Struct.Weapon.get_max_damage active_weapon)) + ), + accuracy = (sudden_squared_growth dexterity), + double_hits = + (clamp 0 100 (sudden_squared_growth_f (average [mind, speed]))), + critical_hits = + (clamp 0 100 (sudden_squared_growth intelligence)) + } diff --git a/src/altar/src/Struct/UI.elm b/src/altar/src/Struct/UI.elm new file mode 100644 index 0000000..3343565 --- /dev/null +++ b/src/altar/src/Struct/UI.elm @@ -0,0 +1,124 @@ +module Struct.UI exposing + ( + Type, + Tab(..), + Action(..), + default, + -- Zoom + get_zoom_level, + reset_zoom_level, + mod_zoom_level, + -- Tab + try_getting_displayed_tab, + set_displayed_tab, + reset_displayed_tab, + to_string, + get_all_tabs, + -- Manual Controls + has_manual_controls_enabled, + -- Previous Action + has_focus, + get_previous_action, + set_previous_action + ) + +-- Battlemap ------------------------------------------------------------------- +import Struct.Location + +import Struct.Character + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Tab = + StatusTab + | CharactersTab + | SettingsTab + | TimelineTab + +type Action = + UsedManualControls + | SelectedLocation Struct.Location.Ref + | SelectedCharacter Struct.Character.Ref + | AttackedCharacter Struct.Character.Ref + +type alias Type = + { + zoom_level : Float, + show_manual_controls : Bool, + displayed_tab : (Maybe Tab), + previous_action : (Maybe Action) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +default : Type +default = + { + zoom_level = 1.0, + show_manual_controls = True, + displayed_tab = (Just StatusTab), + previous_action = Nothing + } + +-- Zoom ------------------------------------------------------------------------ +get_zoom_level : Type -> Float +get_zoom_level ui = ui.zoom_level + +reset_zoom_level : Type -> Type +reset_zoom_level ui = {ui | zoom_level = 1.0} + +mod_zoom_level : Type -> Float -> Type +mod_zoom_level ui mod = {ui | zoom_level = (mod * ui.zoom_level)} + +-- Tab ------------------------------------------------------------------------- +try_getting_displayed_tab : Type -> (Maybe Tab) +try_getting_displayed_tab ui = ui.displayed_tab + +set_displayed_tab : Type -> Tab -> Type +set_displayed_tab ui tab = {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 = + case tab of + StatusTab -> "Status" + CharactersTab -> "Characters" + SettingsTab -> "Settings" + TimelineTab -> "Timeline" + +get_all_tabs : (List Tab) +get_all_tabs = + [StatusTab, CharactersTab, SettingsTab, TimelineTab] + +-- ManualControls -------------------------------------------------------------- +has_manual_controls_enabled : Type -> Bool +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} + +set_enable_manual_controls : Type -> Bool -> Type +set_enable_manual_controls ui val = {ui | show_manual_controls = val} + +-- Previous Action ------------------------------------------------------------- +has_focus : Type -> Bool +has_focus ui = True + +set_previous_action : Type -> (Maybe Action) -> Type +set_previous_action ui act = {ui | previous_action = act} + +get_previous_action : Type -> (Maybe Action) +get_previous_action ui = ui.previous_action diff --git a/src/altar/src/Struct/Weapon.elm b/src/altar/src/Struct/Weapon.elm new file mode 100644 index 0000000..d1d5807 --- /dev/null +++ b/src/altar/src/Struct/Weapon.elm @@ -0,0 +1,150 @@ +module Struct.Weapon exposing + ( + Type, + Ref, + RangeType(..), + RangeModifier(..), + DamageType(..), + DamageModifier(..), + new, + get_name, + get_range_type, + get_range_modifier, + get_damage_type, + get_damage_modifier, + get_attack_range, + get_defense_range, + get_max_damage, + get_min_damage, + apply_to_attributes + ) + +-- Battlemap ------------------------------------------------------------------- +import Struct.Attributes + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + id : Int, + name : String, + range_type : RangeType, + range_mod : RangeModifier, + dmg_type : DamageType, + dmg_mod : DamageModifier, + def_range : Int, + atk_range : Int, + dmg_min : Int, + dmg_max : Int + } + +type alias Ref = Int + +type RangeType = Ranged | Melee +type RangeModifier = Long | Short +-- Having multiple types at the same time, like Warframe does, would be nice. +type DamageType = Slash | Blunt | Pierce +type DamageModifier = Heavy | Light + +type alias WeaponType = + { + range : RangeType, + range_mod : RangeModifier, + dmg_type : DamageType + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_ranges : RangeType -> RangeModifier -> (Int, Int) +get_ranges rt rm = + case (rt, rm) of + (Ranged, Long) -> (2, 6) + (Ranged, Short) -> (1, 4) + (Melee, Long) -> (0, 2) + (Melee, Short) -> (0, 1) + +get_damages : RangeType -> DamageModifier -> (Int, Int) +get_damages rt dm = + case (rt, dm) of + (Ranged, Heavy) -> (10, 25) + (Ranged, Light) -> (5, 20) + (Melee, Heavy) -> (20, 35) + (Melee, Light) -> (15, 30) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : ( + Int -> + String -> + RangeType -> + RangeModifier -> + DamageType -> + DamageModifier -> + Type + ) +new + id name + range_type range_mod + dmg_type dmg_mod + = + let + (def_range, atk_range) = (get_ranges range_type range_mod) + (dmg_min, dmg_max) = (get_damages range_type dmg_mod) + in + { + id = id, + name = name, + range_type = range_type, + range_mod = range_mod, + dmg_type = dmg_type, + dmg_mod = dmg_mod, + def_range = def_range, + atk_range = atk_range, + dmg_min = dmg_min, + dmg_max = dmg_max + } + +get_name : Type -> String +get_name wp = wp.name + +get_range_type : Type -> RangeType +get_range_type wp = wp.range_type + +get_range_modifier : Type -> RangeModifier +get_range_modifier wp = wp.range_mod + +get_damage_type : Type -> DamageType +get_damage_type wp = wp.dmg_type + +get_damage_modifier : Type -> DamageModifier +get_damage_modifier wp = wp.dmg_mod + +get_attack_range : Type -> Int +get_attack_range wp = wp.atk_range + +get_defense_range : Type -> Int +get_defense_range wp = wp.def_range + +get_max_damage : Type -> Int +get_max_damage wp = wp.dmg_max + +get_min_damage : Type -> Int +get_min_damage wp = wp.dmg_min + +apply_to_attributes : Type -> Struct.Attributes.Type -> Struct.Attributes.Type +apply_to_attributes wp atts = + case (wp.range_mod, wp.dmg_mod) of + (Long, Heavy) -> + (Struct.Attributes.mod_dexterity + -20 + (Struct.Attributes.mod_speed -20 atts) + ) + + (Long, Light) -> (Struct.Attributes.mod_dexterity -20 atts) + + (Short, Heavy) -> (Struct.Attributes.mod_speed -20 atts) + + (Short, Light) -> atts diff --git a/src/altar/src/Struct/WeaponSet.elm b/src/altar/src/Struct/WeaponSet.elm new file mode 100644 index 0000000..444152d --- /dev/null +++ b/src/altar/src/Struct/WeaponSet.elm @@ -0,0 +1,39 @@ +module Struct.WeaponSet exposing + ( + Type, + new, + get_active_weapon, + get_secondary_weapon, + switch_weapons + ) + +-- Battlemap ------------------------------------------------------------------- +import Struct.Weapon + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + active : Struct.Weapon.Type, + secondary : Struct.Weapon.Type + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Struct.Weapon.Type -> Struct.Weapon.Type -> Type +new wp0 wp1 = { active = wp0, secondary = wp1 } + +get_active_weapon : Type -> Struct.Weapon.Type +get_active_weapon set = set.active + +get_secondary_weapon : Type -> Struct.Weapon.Type +get_secondary_weapon set = set.secondary + +switch_weapons : Type -> Type +switch_weapons set = {set | active = set.secondary, secondary = set.active} diff --git a/src/altar/src/Update/HandleServerReply.elm b/src/altar/src/Update/HandleServerReply.elm new file mode 100644 index 0000000..8b3ae27 --- /dev/null +++ b/src/altar/src/Update/HandleServerReply.elm @@ -0,0 +1,154 @@ +module Update.HandleServerReply exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Array + +import Http + +-- Battlemap ------------------------------------------------------------------- +import Struct.Battlemap +import Struct.Character +import Struct.Error +import Struct.Event +import Struct.Model +import Struct.ServerReply +import Struct.TurnResult +import Struct.UI + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +add_character : ( + Struct.Character.Type -> + (Struct.Model.Type, (Maybe Struct.Error.Type)) -> + (Struct.Model.Type, (Maybe Struct.Error.Type)) + ) +add_character char current_state = + case current_state of + (_, (Just _)) -> current_state + (model, _) -> + ( + (Struct.Model.add_character + char + model + ), + Nothing + ) + +set_map : ( + Struct.Battlemap.Type -> + (Struct.Model.Type, (Maybe Struct.Error.Type)) -> + (Struct.Model.Type, (Maybe Struct.Error.Type)) + ) +set_map map current_state = + case current_state of + (_, (Just _)) -> current_state + (model, _) -> + ( + {model | battlemap = map}, + Nothing + ) + +add_to_timeline : ( + (List Struct.TurnResult.Type) -> + (Struct.Model.Type, (Maybe Struct.Error.Type)) -> + (Struct.Model.Type, (Maybe Struct.Error.Type)) + ) +add_to_timeline turn_results current_state = + case current_state of + (_, (Just _)) -> current_state + + (model, _) -> + let + updated_characters = + (List.foldl + (Struct.TurnResult.apply_to_characters) + model.characters + turn_results + ) + in + ( + {model | + timeline = + (Array.append + (Array.fromList turn_results) + model.timeline + ), + ui = + (Struct.UI.set_displayed_tab + model.ui + Struct.UI.TimelineTab + ), + characters = updated_characters + }, + Nothing + ) + +set_timeline : ( + (List Struct.TurnResult.Type) -> + (Struct.Model.Type, (Maybe Struct.Error.Type)) -> + (Struct.Model.Type, (Maybe Struct.Error.Type)) + ) +set_timeline turn_results current_state = + case current_state of + (_, (Just _)) -> current_state + + (model, _) -> + ( + {model | timeline = (Array.fromList turn_results)}, + Nothing + ) + +apply_command : ( + Struct.ServerReply.Type -> + (Struct.Model.Type, (Maybe Struct.Error.Type)) -> + (Struct.Model.Type, (Maybe Struct.Error.Type)) + ) +apply_command command current_state = + case command of + (Struct.ServerReply.AddCharacter char) -> + (add_character char current_state) + + (Struct.ServerReply.SetMap map) -> + (set_map map current_state) + + (Struct.ServerReply.TurnResults results) -> + (add_to_timeline results current_state) + + (Struct.ServerReply.SetTimeline timeline) -> + (set_timeline timeline current_state) + + Struct.ServerReply.Okay -> current_state + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + (Result Http.Error (List Struct.ServerReply.Type)) -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model query_result = + case query_result of + (Result.Err error) -> + ( + (Struct.Model.invalidate + model + (Struct.Error.new Struct.Error.Networking (toString error)) + ), + Cmd.none + ) + + (Result.Ok commands) -> + ( + ( + case (List.foldl (apply_command) (model, Nothing) commands) of + (updated_model, Nothing) -> updated_model + (_, (Just error)) -> (Struct.Model.invalidate model error) + ), + Cmd.none + ) diff --git a/src/altar/src/Update/SelectCharacter.elm b/src/altar/src/Update/SelectCharacter.elm new file mode 100644 index 0000000..0e08a4d --- /dev/null +++ b/src/altar/src/Update/SelectCharacter.elm @@ -0,0 +1,203 @@ +module Update.SelectCharacter exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Dict + +-- Battlemap ------------------------------------------------------------------- +import Struct.Battlemap +import Struct.Character +import Struct.CharacterTurn +import Struct.Error +import Struct.Event +import Struct.Location +import Struct.Model +import Struct.Navigator +import Struct.Statistics +import Struct.UI +import Struct.Weapon +import Struct.WeaponSet + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +attack_character : ( + Struct.Model.Type -> + Struct.Character.Ref -> + 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.set_previous_action model.ui Nothing) + } + +ctrl_or_focus_character : ( + Struct.Model.Type -> + Struct.Character.Ref -> + Struct.Character.Type -> + Struct.Model.Type + ) +ctrl_or_focus_character model target_char_id target_char = + if (Struct.Character.is_enabled target_char) + then + let + weapon = + (Struct.WeaponSet.get_active_weapon + (Struct.Character.get_weapons target_char) + ) + in + {model | + char_turn = + (Struct.CharacterTurn.set_navigator + (Struct.Navigator.new + (Struct.Character.get_location target_char) + (Struct.Statistics.get_movement_points + (Struct.Character.get_statistics target_char) + ) + (Struct.Weapon.get_attack_range weapon) + (Struct.Weapon.get_defense_range weapon) + (Struct.Battlemap.get_movement_cost_function + model.battlemap + (Struct.Character.get_location target_char) + (Dict.values model.characters) + ) + ) + (Struct.CharacterTurn.set_active_character + target_char + model.char_turn + ) + ), + ui = (Struct.UI.set_previous_action model.ui Nothing) + } + else + {model | + ui = + (Struct.UI.set_previous_action + model.ui + (Just (Struct.UI.SelectedCharacter target_char_id)) + ) + } + +can_target_character : ( + Struct.Model.Type -> + Struct.Character.Type -> + Bool + ) +can_target_character model target = + ( + (Struct.CharacterTurn.can_select_target model.char_turn) + && + ( + case + (Struct.CharacterTurn.try_getting_navigator + model.char_turn + ) + of + (Just nav) -> + case + (Struct.Navigator.try_getting_path_to + nav + (Struct.Location.get_ref + (Struct.Character.get_location target) + ) + ) + of + (Just _) -> True + _ -> False + + _ -> + False + ) + ) + +double_clicked_character : ( + Struct.Model.Type -> + Struct.Character.Ref -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +double_clicked_character model target_char_id = + case (Dict.get target_char_id model.characters) of + (Just target_char) -> + case + (Struct.CharacterTurn.try_getting_active_character + model.char_turn + ) + of + (Just _) -> + if (can_target_character model target_char) + then + ( + (attack_character + model + target_char_id + target_char + ), + Cmd.none + ) + else + ( + (Struct.Model.invalidate + model + (Struct.Error.new + Struct.Error.IllegalAction + "Has not yet moved or target is out of range." + ) + ), + Cmd.none + ) + + _ -> + ( + (ctrl_or_focus_character model target_char_id target_char), + Cmd.none + ) + + Nothing -> + ( + (Struct.Model.invalidate + model + (Struct.Error.new + Struct.Error.Programming + "SelectCharacter: Unknown char selected." + ) + ), + Cmd.none + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + Struct.Character.Ref -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model target_char_id = + if + ( + (Struct.UI.get_previous_action model.ui) + == + (Just (Struct.UI.SelectedCharacter target_char_id)) + ) + then + (double_clicked_character model target_char_id) + else + ( + {model | + ui = + (Struct.UI.set_previous_action + (Struct.UI.set_displayed_tab + model.ui + Struct.UI.StatusTab + ) + (Just (Struct.UI.SelectedCharacter target_char_id)) + ) + }, + Cmd.none + ) diff --git a/src/altar/src/Update/SelectTab.elm b/src/altar/src/Update/SelectTab.elm new file mode 100644 index 0000000..c48b0fc --- /dev/null +++ b/src/altar/src/Update/SelectTab.elm @@ -0,0 +1,25 @@ +module Update.SelectTab exposing (apply_to) +-- Elm ------------------------------------------------------------------------- + +-- Battlemap ------------------------------------------------------------------- +import Struct.Model +import Struct.Event +import Struct.UI + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + Struct.UI.Tab -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model tab = + ( + {model | ui = (Struct.UI.set_displayed_tab model.ui tab)}, + Cmd.none + ) diff --git a/src/altar/src/Update/SwitchWeapon.elm b/src/altar/src/Update/SwitchWeapon.elm new file mode 100644 index 0000000..7921b66 --- /dev/null +++ b/src/altar/src/Update/SwitchWeapon.elm @@ -0,0 +1,100 @@ +module Update.SwitchWeapon exposing (apply_to) +-- Elm ------------------------------------------------------------------------- +import Dict + +-- Battlemap ------------------------------------------------------------------- +import Struct.Battlemap +import Struct.Character +import Struct.CharacterTurn +import Struct.Error +import Struct.Event +import Struct.Model +import Struct.Navigator +import Struct.Statistics +import Struct.Weapon +import Struct.WeaponSet + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +make_it_so : Struct.Model.Type -> Struct.Model.Type +make_it_so model = + case (Struct.CharacterTurn.try_getting_active_character model.char_turn) of + (Just char) -> + let + new_weapons = + (Struct.WeaponSet.switch_weapons + (Struct.Character.get_weapons char) + ) + new_char = (Struct.Character.set_weapons new_weapons char) + in + {model | + char_turn = + (Struct.CharacterTurn.set_has_switched_weapons + True + (Struct.CharacterTurn.lock_path + (Struct.CharacterTurn.set_navigator + (Struct.Navigator.new + (Struct.Character.get_location new_char) + (Struct.Statistics.get_movement_points + (Struct.Character.get_statistics new_char) + ) + (Struct.Weapon.get_attack_range + (Struct.WeaponSet.get_active_weapon new_weapons) + ) + (Struct.Weapon.get_defense_range + (Struct.WeaponSet.get_active_weapon new_weapons) + ) + (Struct.Battlemap.get_movement_cost_function + model.battlemap + (Struct.Character.get_location new_char) + (Dict.values model.characters) + ) + ) + (Struct.CharacterTurn.set_active_character + new_char + model.char_turn + ) + ) + ) + ) + } + + _ -> + (Struct.Model.invalidate + model + (Struct.Error.new + Struct.Error.Programming + ( + "CharacterTurn structure in the 'SelectedCharacter' state" + ++ " without character being selected." + ) + ) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model = + case (Struct.CharacterTurn.get_state model.char_turn) of + Struct.CharacterTurn.SelectedCharacter -> + ((make_it_so model), Cmd.none) + + _ -> + ( + (Struct.Model.invalidate + model + (Struct.Error.new + Struct.Error.Programming + ( + "Attempt to switch weapons as a secondary action or" + ++ " without character being selected." + ) + ) + ), + Cmd.none + ) diff --git a/src/altar/src/Util/Array.elm b/src/altar/src/Util/Array.elm new file mode 100644 index 0000000..69d329c --- /dev/null +++ b/src/altar/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/altar/src/Util/Html.elm b/src/altar/src/Util/Html.elm new file mode 100644 index 0000000..42eadba --- /dev/null +++ b/src/altar/src/Util/Html.elm @@ -0,0 +1,6 @@ +module Util.Html exposing (nothing) + +import Html + +nothing : (Html.Html a) +nothing = (Html.text "") diff --git a/src/altar/src/Util/List.elm b/src/altar/src/Util/List.elm new file mode 100644 index 0000000..c4db397 --- /dev/null +++ b/src/altar/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)) |