| summaryrefslogtreecommitdiff |
diff options
Diffstat (limited to 'src/main-menu')
27 files changed, 1198 insertions, 0 deletions
diff --git a/src/main-menu/Makefile b/src/main-menu/Makefile new file mode 100644 index 0000000..3b58a08 --- /dev/null +++ b/src/main-menu/Makefile @@ -0,0 +1,36 @@ +################################################################################ +## CONFIG ###################################################################### +################################################################################ +SRC_DIR ?= src +WWW_DIR ?= www +WWW_SCRIPT_DIR ?= $(WWW_DIR)/script + +ELM_CC ?= elm-make --warn + +MAIN_MODULE ?= $(SRC_DIR)/Main.elm + +################################################################################ +## MAKEFILE MAGIC ############################################################## +################################################################################ +SUB_MODULES = $(shell find $(SRC_DIR) -type f | grep "elm$$") + +################################################################################ +## SANITY CHECKS ############################################################### +################################################################################ + +################################################################################ +## TARGET RULES ################################################################ +################################################################################ +build: $(WWW_SCRIPT_DIR)/main.js + +clean: + rm -f $(WWW_SCRIPT_DIR)/main.js + +reset: + rm -rf elm-stuff + +################################################################################ +## INTERNAL RULES ############################################################## +################################################################################ +$(WWW_SCRIPT_DIR)/main.js: $(MAIN_MODULE) $(SUB_MODULES) + $(ELM_CC) $(MAIN_MODULE) --output $@ diff --git a/src/main-menu/elm-package.json b/src/main-menu/elm-package.json new file mode 100644 index 0000000..d62239e --- /dev/null +++ b/src/main-menu/elm-package.json @@ -0,0 +1,19 @@ +{ + "version": "1.0.0", + "summary": "helpful summary of your project, less than 80 characters", + "repository": "https://github.com/nsensfel/tacticians-client.git", + "license": "Apache 2.0", + "source-directories": [ + "src", + "../shared/elm" + ], + "exposed-modules": [], + "dependencies": { + "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", + "elm-lang/core": "5.1.1 <= v < 6.0.0", + "elm-lang/dom": "1.1.1 <= v < 2.0.0", + "elm-lang/html": "2.0.0 <= v < 3.0.0", + "elm-lang/http": "1.0.0 <= v < 2.0.0" + }, + "elm-version": "0.18.0 <= v < 0.19.0" +} diff --git a/src/main-menu/src/Comm/LoadPlayer.elm b/src/main-menu/src/Comm/LoadPlayer.elm new file mode 100644 index 0000000..c4a28ee --- /dev/null +++ b/src/main-menu/src/Comm/LoadPlayer.elm @@ -0,0 +1,41 @@ +module Comm.LoadPlayer exposing (try) + +-- Elm ------------------------------------------------------------------------- +import Json.Encode + +-- MainMenu -------------------------------------------------------------------- +import Comm.Send + +import Constants.IO + +import Struct.Event +import Struct.Model + +-------------------------------------------------------------------------------- +-- TYPES ------------------------------------------------------------------------ +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try_encoding : Struct.Model.Type -> (Maybe Json.Encode.Value) +try_encoding model = + (Just + (Json.Encode.object + [ + ("stk", (Json.Encode.string model.session_token)), + ("pid", (Json.Encode.string model.player_id)) + ] + ) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try : Struct.Model.Type -> (Maybe (Cmd Struct.Event.Type)) +try model = + (Comm.Send.try_sending + model + Constants.IO.player_loading_handler + try_encoding + ) diff --git a/src/main-menu/src/Comm/Okay.elm b/src/main-menu/src/Comm/Okay.elm new file mode 100644 index 0000000..ca7a2eb --- /dev/null +++ b/src/main-menu/src/Comm/Okay.elm @@ -0,0 +1,21 @@ +module Comm.Okay exposing (decode) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode + +-- Battlemap ------------------------------------------------------------------- +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +decode : (Json.Decode.Decoder Struct.ServerReply.Type) +decode = (Json.Decode.succeed Struct.ServerReply.Okay) diff --git a/src/main-menu/src/Comm/Send.elm b/src/main-menu/src/Comm/Send.elm new file mode 100644 index 0000000..e488d77 --- /dev/null +++ b/src/main-menu/src/Comm/Send.elm @@ -0,0 +1,66 @@ +module Comm.Send exposing (try_sending) + +-- Elm ------------------------------------------------------------------------- +import Http + +import Json.Decode +import Json.Encode + +-- Map ------------------------------------------------------------------- +import Comm.Okay +import Comm.SetSession + +import Struct.Event +import Struct.ServerReply +import Struct.Model + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +internal_decoder : String -> (Json.Decode.Decoder Struct.ServerReply.Type) +internal_decoder reply_type = + case reply_type of + "okay" -> (Comm.Okay.decode) + "sse" -> (Comm.SetSession.decode) + other -> + (Json.Decode.fail + ( + "Unknown server command \"" + ++ other + ++ "\"" + ) + ) + +decode : (Json.Decode.Decoder Struct.ServerReply.Type) +decode = + (Json.Decode.field "msg" Json.Decode.string) + |> (Json.Decode.andThen (internal_decoder)) + +-------------------------------------------------------------------------------- +-- 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)) + ) + ) + ) + + Nothing -> Nothing diff --git a/src/main-menu/src/Constants/IO.elm.m4 b/src/main-menu/src/Constants/IO.elm.m4 new file mode 100644 index 0000000..fdb5ed3 --- /dev/null +++ b/src/main-menu/src/Constants/IO.elm.m4 @@ -0,0 +1,16 @@ +module Constants.IO exposing (..) + +base_url : String +base_url = "__CONF_SERVER_URL" + +login_handler_url : String +login_handler_url = (base_url ++ "/handler/login") + +login_sign_in_handler : String +login_sign_in_handler = (login_handler_url ++ "/lgn_sign_in") + +login_sign_up_handler : String +login_sign_up_handler = (login_handler_url ++ "/lgn_sign_up") + +login_recovery_handler : String +login_recovery_handler = (login_handler_url ++ "/lgn_recovery") diff --git a/src/main-menu/src/ElmModule/Init.elm b/src/main-menu/src/ElmModule/Init.elm new file mode 100644 index 0000000..4cfbcb2 --- /dev/null +++ b/src/main-menu/src/ElmModule/Init.elm @@ -0,0 +1,18 @@ +module ElmModule.Init exposing (init) + +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- +import Struct.Event +import Struct.Flags +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +init : Struct.Flags.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) +init flags = ((Struct.Model.new flags), Cmd.none) diff --git a/src/main-menu/src/ElmModule/Subscriptions.elm b/src/main-menu/src/ElmModule/Subscriptions.elm new file mode 100644 index 0000000..fe276f4 --- /dev/null +++ b/src/main-menu/src/ElmModule/Subscriptions.elm @@ -0,0 +1,17 @@ +module ElmModule.Subscriptions exposing (..) + +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- +import Struct.Model +import Struct.Event + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +subscriptions : Struct.Model.Type -> (Sub Struct.Event.Type) +subscriptions model = Sub.none diff --git a/src/main-menu/src/ElmModule/Update.elm b/src/main-menu/src/ElmModule/Update.elm new file mode 100644 index 0000000..babb5b5 --- /dev/null +++ b/src/main-menu/src/ElmModule/Update.elm @@ -0,0 +1,89 @@ +module ElmModule.Update exposing (update) + +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- +import Struct.Event +import Struct.Model + +import Update.HandleServerReply +import Update.SendSignIn +import Update.SendSignUp +import Update.SendRecovery +import Update.SelectTab + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +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.None -> (model, Cmd.none) + + (Struct.Event.Failed err) -> + ( + (Struct.Model.invalidate err new_model), + Cmd.none + ) + + (Struct.Event.ServerReplied result) -> + (Update.HandleServerReply.apply_to model result) + + Struct.Event.SignInRequested -> + (Update.SendSignIn.apply_to new_model) + + Struct.Event.SignUpRequested -> + (Update.SendSignUp.apply_to model) + + Struct.Event.RecoveryRequested -> + (Update.SendRecovery.apply_to model) + + (Struct.Event.TabSelected tab) -> + (Update.SelectTab.apply_to new_model tab) + + (Struct.Event.RequestedHelp _) -> + -- TODO + (model, Cmd.none) + + (Struct.Event.SetUsername str) -> + ( + {model | username = str}, + Cmd.none + ) + + (Struct.Event.SetPassword1 str) -> + ( + {model | password1 = str}, + Cmd.none + ) + + (Struct.Event.SetPassword2 str) -> + ( + {model | password2 = str}, + Cmd.none + ) + + (Struct.Event.SetEmail1 str) -> + ( + {model | email1 = str}, + Cmd.none + ) + + (Struct.Event.SetEmail2 str) -> + ( + {model | email2 = str}, + Cmd.none + ) + diff --git a/src/main-menu/src/ElmModule/View.elm b/src/main-menu/src/ElmModule/View.elm new file mode 100644 index 0000000..657e063 --- /dev/null +++ b/src/main-menu/src/ElmModule/View.elm @@ -0,0 +1,69 @@ +module ElmModule.View exposing (view) + +-- Elm ------------------------------------------------------------------------- +import Html +import Html.Lazy +import Html.Attributes + +-- Map ------------------------------------------------------------------- +import Struct.Error +import Struct.Event +import Struct.Model +import Struct.UI + +import Util.Html + +import View.AccountRecovery +import View.Header +import View.MainMenu +import View.SignIn +import View.SignUp + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +view : Struct.Model.Type -> (Html.Html Struct.Event.Type) +view model = + (Html.div + [ + (Html.Attributes.class "fullscreen-module") + ] + [ + (View.Header.get_html), + (Html.main_ + [ + ] + [ + (View.MainMenu.get_html + (Struct.UI.try_getting_displayed_tab model.ui) + ), + ( + case (Struct.UI.try_getting_displayed_tab model.ui) of + (Just Struct.UI.SignInTab) -> (View.SignIn.get_html model) + (Just Struct.UI.SignUpTab) -> (View.SignUp.get_html model) + (Just Struct.UI.RecoveryTab) -> + (View.AccountRecovery.get_html model) + + _ -> (View.SignIn.get_html model) + ), + ( + case model.error of + Nothing -> (Util.Html.nothing) + (Just err) -> + (Html.div + [ + (Html.Attributes.class "error-msg") + ] + [ + (Html.text (Struct.Error.to_string err)) + ] + ) + ) + ] + ) + ] + ) diff --git a/src/main-menu/src/Main.elm b/src/main-menu/src/Main.elm new file mode 100644 index 0000000..8140041 --- /dev/null +++ b/src/main-menu/src/Main.elm @@ -0,0 +1,23 @@ +-- Elm ------------------------------------------------------------------------ +import Html + +-- Map ------------------------------------------------------------------- +import Struct.Model +import Struct.Event +import Struct.Flags + +import ElmModule.Init +import ElmModule.Subscriptions +import ElmModule.View +import ElmModule.Update + +main : (Program Struct.Flags.Type Struct.Model.Type Struct.Event.Type) +main = + (Html.programWithFlags + { + init = ElmModule.Init.init, + view = ElmModule.View.view, + update = ElmModule.Update.update, + subscriptions = ElmModule.Subscriptions.subscriptions + } + ) diff --git a/src/main-menu/src/Struct/Error.elm b/src/main-menu/src/Struct/Error.elm new file mode 100644 index 0000000..5f40c09 --- /dev/null +++ b/src/main-menu/src/Struct/Error.elm @@ -0,0 +1,45 @@ +module Struct.Error exposing (Type, Mode(..), new, to_string) + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Mode = + IllegalAction + | Programming + | Unimplemented + | Networking + | Failure + +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 + Failure -> "The action failed: " + 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/main-menu/src/Struct/Event.elm b/src/main-menu/src/Struct/Event.elm new file mode 100644 index 0000000..419ef51 --- /dev/null +++ b/src/main-menu/src/Struct/Event.elm @@ -0,0 +1,25 @@ +module Struct.Event exposing (Type(..), attempted) + +-- Elm ------------------------------------------------------------------------- +import Http + +-- Main Menu ------------------------------------------------------------------- +import Struct.Error +import Struct.ServerReply +import Struct.UI + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Type = + None + | Failed Struct.Error.Type + | ServerReplied (Result Http.Error (List Struct.ServerReply.Type)) + | TabSelected Struct.UI.Tab + +attempted : (Result.Result err val) -> Type +attempted act = + case act of + (Result.Ok _) -> None + (Result.Err msg) -> + (Failed (Struct.Error.new Struct.Error.Failure (toString msg))) diff --git a/src/main-menu/src/Struct/Flags.elm b/src/main-menu/src/Struct/Flags.elm new file mode 100644 index 0000000..99c7458 --- /dev/null +++ b/src/main-menu/src/Struct/Flags.elm @@ -0,0 +1,42 @@ +module Struct.Flags exposing + ( + Type, + maybe_get_param + ) + +-- Elm ------------------------------------------------------------------------- +import List + +-- Main Menu ------------------------------------------------------------------- +import Util.List + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + user_id : String, + token : String, + url_params : (List (List String)) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +maybe_get_param : String -> Type -> (Maybe String) +maybe_get_param param flags = + case + (Util.List.get_first + (\e -> ((List.head e) == (Just param))) + flags.url_params + ) + of + Nothing -> Nothing + (Just a) -> + case (List.tail a) of + Nothing -> Nothing + (Just b) -> (List.head b) diff --git a/src/main-menu/src/Struct/Model.elm b/src/main-menu/src/Struct/Model.elm new file mode 100644 index 0000000..85c8344 --- /dev/null +++ b/src/main-menu/src/Struct/Model.elm @@ -0,0 +1,64 @@ +module Struct.Model exposing + ( + Type, + new, + invalidate, + reset, + clear_error + ) + +-- Elm ------------------------------------------------------------------------- + +-- Main Menu ------------------------------------------------------------------- +import Struct.Error +import Struct.Flags +import Struct.Player +import Struct.UI + +import Util.Array + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + help_request: Struct.HelpRequest.Type, + error: (Maybe Struct.Error.Type), + player_id: String, + session_token: String, + player: Struct.Player.Type, + ui: Struct.UI.Type + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Struct.Flags.Type -> Type +new flags = + { + help_request = Struct.HelpRequest.None, + error = Nothing, + player_id = flags.user_id, + session_token = flags.token, + player = (Struct.Player.none), + ui = (Struct.UI.default) + } + +reset : Type -> Type +reset model = + {model | + error = Nothing + } + +invalidate : Struct.Error.Type -> Type -> Type +invalidate err model = + {model | + error = (Just err) + } + +clear_error : Type -> Type +clear_error model = {model | error = Nothing} diff --git a/src/main-menu/src/Struct/Player.elm b/src/main-menu/src/Struct/Player.elm new file mode 100644 index 0000000..8a70023 --- /dev/null +++ b/src/main-menu/src/Struct/Player.elm @@ -0,0 +1,99 @@ +module Struct.Player exposing + ( + Type, + get_username, + get_maps, + get_campaigns, + get_invasions, + get_events, + get_roster_id, + get_inventory_id, + decoder, + none + ) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode +import Json.Decode.Pipeline + +-- Map ------------------------------------------------------------------- +import Struct.Omnimods + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias PartiallyDecoded = + { + id : Int, + nam : String, + rmi : Int, + rma : Int, + omni : String + } + +type alias Type = + { + id : Int, + name : String, + def_range : Int, + atk_range : Int, + omnimods : Struct.Omnimods.Type, + damage_sum : Int + } + +type alias Ref = Int + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Int -> String -> Int -> Int -> Struct.Omnimods.Type -> Type +new id name range_min range_max omnimods = + { + id = id, + name = name, + def_range = range_min, + atk_range = range_max, + omnimods = omnimods, + damage_sum = (Struct.Omnimods.get_damage_sum omnimods) + } + +get_id : Type -> Int +get_id wp = wp.id + +get_name : Type -> String +get_name wp = wp.name + +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_omnimods : Type -> Struct.Omnimods.Type +get_omnimods wp = wp.omnimods + +get_damage_sum : Type -> Int +get_damage_sum wp = wp.damage_sum + +decoder : (Json.Decode.Decoder Type) +decoder = + (Json.Decode.map + (\e -> {e | damage_sum = (Struct.Omnimods.get_damage_sum e.omnimods)}) + (Json.Decode.Pipeline.decode + Type + |> (Json.Decode.Pipeline.required "usr" Json.Decode.string) + |> (Json.Decode.Pipeline.required "maps" Json.Decode.list) + |> (Json.Decode.Pipeline.required "cmps" Json.Decode.list) + |> (Json.Decode.Pipeline.required "invs" Json.Decode.list) + |> (Json.Decode.Pipeline.required "evts" Json.Decode.list) + |> (Json.Decode.Pipeline.required "rtid" Json.Decode.list) + |> (Json.Decode.Pipeline.required "ivid" Json.Decode.list) + ) + ) + +none : Type +none = (new 0 "None" 0 0 (Struct.Omnimods.new [] [] [] [])) diff --git a/src/main-menu/src/Struct/ServerReply.elm b/src/main-menu/src/Struct/ServerReply.elm new file mode 100644 index 0000000..a0663a8 --- /dev/null +++ b/src/main-menu/src/Struct/ServerReply.elm @@ -0,0 +1,22 @@ +module Struct.ServerReply exposing (Type(..)) + +-- Elm ------------------------------------------------------------------------- + +-- Main Menu ------------------------------------------------------------------- +import Struct.Player + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +type Type = + Okay + | SetPlayer Struct.Player.Type + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- diff --git a/src/main-menu/src/Struct/UI.elm b/src/main-menu/src/Struct/UI.elm new file mode 100644 index 0000000..6cf853c --- /dev/null +++ b/src/main-menu/src/Struct/UI.elm @@ -0,0 +1,62 @@ +module Struct.UI exposing + ( + Type, + Tab(..), + default, + -- Tab + try_getting_displayed_tab, + set_displayed_tab, + reset_displayed_tab, + to_string + ) + +-- Main Menu ------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Tab = + CampaignsTab + | InvasionsTab + | EventsTab + | CharactersTab + | MapsEditorTab + | AccountTab + +type alias Type = + { + displayed_tab : (Maybe Tab) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +default : Type +default = + { + displayed_tab = Nothing + } + +-- Tab ------------------------------------------------------------------------- +try_getting_displayed_tab : Type -> (Maybe Tab) +try_getting_displayed_tab ui = ui.displayed_tab + +set_displayed_tab : Tab -> Type -> Type +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 = + case tab of + CampaignsTab -> "Campaigns" + InvasionsTab -> "Invasions" + EventsTab -> "Events" + CharactersTab -> "Character Editor" + MapsEditorTab -> "Map Editor" + AccountTab -> "Account Settings" diff --git a/src/main-menu/src/Update/HandleServerReply.elm b/src/main-menu/src/Update/HandleServerReply.elm new file mode 100644 index 0000000..8720457 --- /dev/null +++ b/src/main-menu/src/Update/HandleServerReply.elm @@ -0,0 +1,116 @@ +module Update.HandleServerReply exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Array + +import Dict + +import Http + +-- Map ------------------------------------------------------------------- +import Action.Session + +import Struct.Error +import Struct.Event +import Struct.Model +import Struct.ServerReply +import Struct.UI + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +set_session : ( + String -> + String -> + ( + Struct.Model.Type, + (Maybe Struct.Error.Type), + (List (Cmd Struct.Event.Type)) + ) -> + ( + Struct.Model.Type, + (Maybe Struct.Error.Type), + (List (Cmd Struct.Event.Type)) + ) + ) +set_session pid stk current_state = + case current_state of + (_, (Just _), _) -> current_state + + (model, _, cmd_list) -> + ( + {model | + player_id = pid, + session_token = stk + }, + Nothing, + ( + (Action.Session.store_new_session (pid, stk)) + :: cmd_list + ) + ) + +apply_command : ( + Struct.ServerReply.Type -> + ( + Struct.Model.Type, + (Maybe Struct.Error.Type), + (List (Cmd Struct.Event.Type)) + ) -> + ( + Struct.Model.Type, + (Maybe Struct.Error.Type), + (List (Cmd Struct.Event.Type)) + ) + ) +apply_command command current_state = + case command of + (Struct.ServerReply.SetSession (pid, stk)) -> + (set_session pid stk 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 + (Struct.Error.new Struct.Error.Networking (toString error)) + model + ), + Cmd.none + ) + + (Result.Ok commands) -> + ( + case + (List.foldl + (apply_command) + (model, Nothing, []) + commands + ) + of + (updated_model, Nothing, cmds) -> + ( + updated_model, + (Cmd.batch cmds) + ) + + (_, (Just error), _) -> + ( + (Struct.Model.invalidate error model), + Cmd.none + ) + ) diff --git a/src/main-menu/src/Update/SelectTab.elm b/src/main-menu/src/Update/SelectTab.elm new file mode 100644 index 0000000..d15a463 --- /dev/null +++ b/src/main-menu/src/Update/SelectTab.elm @@ -0,0 +1,32 @@ +module Update.SelectTab exposing (apply_to) +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- +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 = + if ((Struct.UI.try_getting_displayed_tab model.ui) == (Just tab)) + then + ( + {model | ui = (Struct.UI.reset_displayed_tab model.ui)}, + Cmd.none + ) + else + ( + {model | ui = (Struct.UI.set_displayed_tab tab model.ui)}, + Cmd.none + ) diff --git a/src/main-menu/src/Update/SendRecovery.elm b/src/main-menu/src/Update/SendRecovery.elm new file mode 100644 index 0000000..313477b --- /dev/null +++ b/src/main-menu/src/Update/SendRecovery.elm @@ -0,0 +1,29 @@ +module Update.SendRecovery exposing (apply_to) +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- +import Comm.SendRecovery + +import Struct.Event +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model = + ( + model, + (case (Comm.SendRecovery.try model) of + (Just cmd) -> cmd + Nothing -> Cmd.none + ) + ) + diff --git a/src/main-menu/src/Update/SendSignIn.elm b/src/main-menu/src/Update/SendSignIn.elm new file mode 100644 index 0000000..9e28c95 --- /dev/null +++ b/src/main-menu/src/Update/SendSignIn.elm @@ -0,0 +1,29 @@ +module Update.SendSignIn exposing (apply_to) +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- +import Comm.SendSignIn + +import Struct.Event +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model = + ( + model, + (case (Comm.SendSignIn.try model) of + (Just cmd) -> cmd + Nothing -> Cmd.none + ) + ) + diff --git a/src/main-menu/src/Update/SendSignUp.elm b/src/main-menu/src/Update/SendSignUp.elm new file mode 100644 index 0000000..b4b2605 --- /dev/null +++ b/src/main-menu/src/Update/SendSignUp.elm @@ -0,0 +1,29 @@ +module Update.SendSignUp exposing (apply_to) +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- +import Comm.SendSignUp + +import Struct.Event +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model = + ( + model, + (case (Comm.SendSignUp.try model) of + (Just cmd) -> cmd + Nothing -> Cmd.none + ) + ) + diff --git a/src/main-menu/src/Update/SetRequestedHelp.elm b/src/main-menu/src/Update/SetRequestedHelp.elm new file mode 100644 index 0000000..dfc58db --- /dev/null +++ b/src/main-menu/src/Update/SetRequestedHelp.elm @@ -0,0 +1,22 @@ +module Update.SetRequestedHelp exposing (apply_to) +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- +import Struct.Event +import Struct.HelpRequest +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + Struct.HelpRequest.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model help_request = + ({model | help_request = help_request}, Cmd.none) diff --git a/src/main-menu/src/View/BattleListing.elm b/src/main-menu/src/View/BattleListing.elm new file mode 100644 index 0000000..d3df261 --- /dev/null +++ b/src/main-menu/src/View/BattleListing.elm @@ -0,0 +1,58 @@ +module View.BattleListing exposing (get_html) + +-- Elm ------------------------------------------------------------------------- +import Html +import Html.Attributes +import Html.Events + +-- Map ------------------------------------------------------------------- +import Struct.Event +import Struct.UI + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_html : ( + String -> + String -> + (List Struct.BattleRef) -> + (Html.Html Struct.Event.Type) + ) +get_html name class battle_refs = + (Html.div + [ + (Html.Attributes.class class) + (Html.Attributes.class "main-menu-battle-listing") + ] + [ + (Html.div + [ + (Html.Attributes.class "main-menu-battle-listing-header") + ] + [ + (Html.text name) + ] + ), + (Html.div + [ + (Html.Attributes.class "main-menu-battle-listing-body") + ] + (List.map + (get_battle_ref_html) + battle_refs + ) + ), + (Html.div + [ + (Html.Attributes.class "main-menu-battle-listing-add-new") + ] + [ + (Html.text "New") + ] + ) + ] + ) diff --git a/src/main-menu/src/View/Header.elm.m4 b/src/main-menu/src/View/Header.elm.m4 new file mode 100644 index 0000000..49e9965 --- /dev/null +++ b/src/main-menu/src/View/Header.elm.m4 @@ -0,0 +1,81 @@ +module View.Header exposing (get_html) + +-- Elm ------------------------------------------------------------------------- +import Html +import Html.Attributes +import Html.Events + +-- Map ------------------------------------------------------------------- +import Struct.Event +import Struct.UI + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +link_html : String -> String -> Bool -> (Html.Html Struct.Event.Type) +link_html src label is_active = + (Html.a + [ + (Html.Attributes.href src) + ] + [ + ( + if (is_active) + then (Html.text label) + else (Html.s [] [(Html.text label)]) + ) + ] + ) + +navigation_html : (Html.Html Struct.Event.Type) +navigation_html = + (Html.nav + [] + [ + (link_html "/about.html" "About" True), + (link_html "/news/" "News" False), + (link_html "/community/" "Community" False), + (link_html "/login/?action=disconnect" "Disconnect" True) + ] + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_html : (Html.Html Struct.Event.Type) +get_html = + (Html.header + [] + [ + (Html.div + [ + (Html.Attributes.class "main-server-logo") + ] + [ + (Html.a + [ + (Html.Attributes.href "__CONF_SERVER_URL") + ] + [ + (Html.img + [ + (Html.Attributes.src "__CONF_SERVER_LOGO") + ] + [ + ] + ) + ] + ) + ] + ), + (Html.div + [ + (Html.Attributes.class "main-server-version") + ] + [ + (Html.text "__CONF_VERSION") + ] + ), + (navigation_html) + ] + ) diff --git a/src/main-menu/www/index.html b/src/main-menu/www/index.html new file mode 100644 index 0000000..b6a77e9 --- /dev/null +++ b/src/main-menu/www/index.html @@ -0,0 +1,28 @@ +<!DOCTYPE html> +<html> + <head> + <link rel="stylesheet" type="text/css" href="/css/global.css"> + <link rel="stylesheet" type="text/css" href="/css/main-menu.css"> + <link rel="icon" type="image/x-icon" href="/favicon.ico"> + </head> + <body> + <script src="script/main.js"></script> + <script src="../global/script/session.js"></script> + <script src="../global/script/urlparams.js"></script> + <script> + tacticians_online.session.load(); + + tacticians_online.app = + Elm.Main.fullscreen + ( + { + user_id: tacticians_online.session.get_user_id(), + token: tacticians_online.session.get_token(), + url_params: tacticians_online.urlparams.get_parameters() + } + ); + + tacticians_online.session.attach_to(tacticians_online.app); + </script> + </body> +</html> |