| summaryrefslogtreecommitdiff | 
diff options
33 files changed, 990 insertions, 7 deletions
| @@ -1,7 +1,7 @@  ################################################################################  ## CONFIG ######################################################################  ################################################################################ -MODULES ?= battle css global asset map-editor +MODULES ?= css login map-editor battle asset  SRC_DIR = ${CURDIR}/src  WWW_DIR = ${CURDIR}/www diff --git a/src/css/src/battle/sub-menus/timeline-tab.scss b/src/css/src/battle/sub-menus/timeline-tab.scss index cf9793c..91dc8db 100644 --- a/src/css/src/battle/sub-menus/timeline-tab.scss +++ b/src/css/src/battle/sub-menus/timeline-tab.scss @@ -19,12 +19,13 @@     width: 36px;     height: 36px; +   border-radius: 5px; +     @include box-shadow(1px, $BROWN-0, 1);  }  .battle-timeline-element .battle-character-portrait + *  { -   border-radius: 5px;     margin-left: 1em;  } diff --git a/src/login/Makefile b/src/login/Makefile new file mode 100644 index 0000000..3b58a08 --- /dev/null +++ b/src/login/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/login/elm-package.json b/src/login/elm-package.json new file mode 100644 index 0000000..5f6573f --- /dev/null +++ b/src/login/elm-package.json @@ -0,0 +1,18 @@ +{ +    "version": "1.0.0", +    "summary": "helpful summary of your project, less than 80 characters", +    "repository": "https://github.com/nsensfel/tacticians-client.git", +    "license": "Apache 2.0", +    "source-directories": [ +        "src" +    ], +    "exposed-modules": [], +    "dependencies": { +        "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/login/src/Comm/Okay.elm b/src/login/src/Comm/Okay.elm new file mode 100644 index 0000000..ca7a2eb --- /dev/null +++ b/src/login/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/login/src/Comm/Send.elm b/src/login/src/Comm/Send.elm new file mode 100644 index 0000000..ddaa047 --- /dev/null +++ b/src/login/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) +      "set_session" -> (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/login/src/Comm/SendSignIn.elm b/src/login/src/Comm/SendSignIn.elm new file mode 100644 index 0000000..bf1c7c3 --- /dev/null +++ b/src/login/src/Comm/SendSignIn.elm @@ -0,0 +1,41 @@ +module Comm.SendSignIn exposing (try) + +-- Elm ------------------------------------------------------------------------- +import Json.Encode + +-- Map ------------------------------------------------------------------- +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 +         [ +            ("usr", (Json.Encode.string model.username)), +            ("pwd", (Json.Encode.string model.password)) +         ] +      ) +   ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try : Struct.Model.Type -> (Maybe (Cmd Struct.Event.Type)) +try model = +   (Comm.Send.try_sending +      model +      Constants.IO.login_sign_in_handler +      try_encoding +   ) diff --git a/src/login/src/Comm/SendSignUp.elm b/src/login/src/Comm/SendSignUp.elm new file mode 100644 index 0000000..0094178 --- /dev/null +++ b/src/login/src/Comm/SendSignUp.elm @@ -0,0 +1,42 @@ +module Comm.SendSignUp exposing (try) + +-- Elm ------------------------------------------------------------------------- +import Json.Encode + +-- Map ------------------------------------------------------------------- +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 +         [ +            ("usr", (Json.Encode.string model.username)), +            ("pwd", (Json.Encode.string model.password)), +            ("eml", (Json.Encode.string model.email)) +         ] +      ) +   ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try : Struct.Model.Type -> (Maybe (Cmd Struct.Event.Type)) +try model = +   (Comm.Send.try_sending +      model +      Constants.IO.login_sign_up_handler +      try_encoding +   ) diff --git a/src/login/src/Comm/SetSession.elm b/src/login/src/Comm/SetSession.elm new file mode 100644 index 0000000..3edc6b7 --- /dev/null +++ b/src/login/src/Comm/SetSession.elm @@ -0,0 +1,28 @@ +module Comm.SetSession exposing (decode) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode + +-- Map ------------------------------------------------------------------- +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +internal_decoder : String -> String -> Struct.ServerReply.Type +internal_decoder pid stk = (Struct.ServerReply.SetSession (pid, stk)) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +decode : (Json.Decode.Decoder Struct.ServerReply.Type) +decode = +   (Json.Decode.map2 +      (internal_decoder) +      (Json.Decode.field "pid" Json.Decode.string) +      (Json.Decode.field "stk" Json.Decode.string) +   ) diff --git a/src/login/src/Constants/IO.elm.m4 b/src/login/src/Constants/IO.elm.m4 new file mode 100644 index 0000000..674f910 --- /dev/null +++ b/src/login/src/Constants/IO.elm.m4 @@ -0,0 +1,13 @@ +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 ++ "/plr_sign_in") + +login_sign_up_handler : String +login_sign_up_handler = (login_handler_url ++ "/plr_sign_up") diff --git a/src/login/src/ElmModule/Init.elm b/src/login/src/ElmModule/Init.elm new file mode 100644 index 0000000..4cfbcb2 --- /dev/null +++ b/src/login/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/login/src/ElmModule/Subscriptions.elm b/src/login/src/ElmModule/Subscriptions.elm new file mode 100644 index 0000000..fe276f4 --- /dev/null +++ b/src/login/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/login/src/ElmModule/Update.elm b/src/login/src/ElmModule/Update.elm new file mode 100644 index 0000000..6245ae1 --- /dev/null +++ b/src/login/src/ElmModule/Update.elm @@ -0,0 +1,54 @@ +module ElmModule.Update exposing (update) + +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- +import Struct.Event +import Struct.Model + +import Update.HandleServerReply +import Update.SendSignIn +import Update.SendSignUp +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.SendSignInRequested -> +         (Update.SendSignIn.apply_to new_model) + +      Struct.Event.SendSignUpRequested -> +         (Update.SendSignUp.apply_to model) + +      (Struct.Event.TabSelected tab) -> +         (Update.SelectTab.apply_to new_model tab) + +      (Struct.Event.RequestedHelp _) -> +         -- TODO +         (model, Cmd.none) diff --git a/src/login/src/ElmModule/View.elm b/src/login/src/ElmModule/View.elm new file mode 100644 index 0000000..558decd --- /dev/null +++ b/src/login/src/ElmModule/View.elm @@ -0,0 +1,27 @@ +module ElmModule.View exposing (view) + +-- Elm ------------------------------------------------------------------------- +import Html +import Html.Lazy +import Html.Attributes + +-- Map ------------------------------------------------------------------- +import Struct.Event +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +view : Struct.Model.Type -> (Html.Html Struct.Event.Type) +view model = +   (Html.div +      [ +         (Html.Attributes.class "fullscreen-module") +      ] +      [ +      ] +   ) diff --git a/src/login/src/Main.elm b/src/login/src/Main.elm new file mode 100644 index 0000000..8140041 --- /dev/null +++ b/src/login/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/login/src/Struct/Error.elm b/src/login/src/Struct/Error.elm new file mode 100644 index 0000000..5f40c09 --- /dev/null +++ b/src/login/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/login/src/Struct/Event.elm b/src/login/src/Struct/Event.elm new file mode 100644 index 0000000..b473475 --- /dev/null +++ b/src/login/src/Struct/Event.elm @@ -0,0 +1,29 @@ +module Struct.Event exposing (Type(..), attempted) + +-- Elm ------------------------------------------------------------------------- +import Http + +-- Map ------------------------------------------------------------------- +import Struct.Error +import Struct.ServerReply +import Struct.HelpRequest +import Struct.UI + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Type = +   None +   | Failed Struct.Error.Type +   | RequestedHelp Struct.HelpRequest.Type +   | SendSignInRequested +   | SendSignUpRequested +   | 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/login/src/Struct/Flags.elm b/src/login/src/Struct/Flags.elm new file mode 100644 index 0000000..228d258 --- /dev/null +++ b/src/login/src/Struct/Flags.elm @@ -0,0 +1,42 @@ +module Struct.Flags exposing +   ( +      Type, +      maybe_get_param +   ) + +-- Elm ------------------------------------------------------------------------- +import List + +-- Map ------------------------------------------------------------------- +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/login/src/Struct/HelpRequest.elm b/src/login/src/Struct/HelpRequest.elm new file mode 100644 index 0000000..86d442a --- /dev/null +++ b/src/login/src/Struct/HelpRequest.elm @@ -0,0 +1,11 @@ +module Struct.HelpRequest exposing (Type(..)) + +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Type = +   None diff --git a/src/login/src/Struct/Model.elm b/src/login/src/Struct/Model.elm new file mode 100644 index 0000000..787d6ba --- /dev/null +++ b/src/login/src/Struct/Model.elm @@ -0,0 +1,85 @@ +module Struct.Model exposing +   ( +      Type, +      new, +      invalidate, +      reset, +      clear_error +   ) + +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- +import Struct.Error +import Struct.Flags +import Struct.HelpRequest +import Struct.UI + +import Util.Array + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = +   { +      help_request: Struct.HelpRequest.Type, +      error: (Maybe Struct.Error.Type), +      username: String, +      password: String, +      email: String, +      player_id: String, +      session_token: String, +      ui: Struct.UI.Type +   } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Struct.Flags.Type -> Type +new flags = +   let +      maybe_mode = (Struct.Flags.maybe_get_param "mode" flags) +      model = +         { +            help_request = Struct.HelpRequest.None, +            error = Nothing, +            username = "", +            password = "", +            email = "", +            player_id = flags.user_id, +            session_token = flags.token, +            ui = (Struct.UI.default) +         } +   in +      case maybe_mode of +         Nothing -> model + +         (Just id) -> +            {model | +               ui = +                  (Struct.UI.set_displayed_tab +                     (Struct.UI.tab_from_string id) +                     model.ui +                  ) +            } + +reset : Type -> Type +reset model = +   {model | +      help_request = Struct.HelpRequest.None, +      error = Nothing, +      ui = (Struct.UI.default) +   } + +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/login/src/Struct/ServerReply.elm b/src/login/src/Struct/ServerReply.elm new file mode 100644 index 0000000..a8580dc --- /dev/null +++ b/src/login/src/Struct/ServerReply.elm @@ -0,0 +1,21 @@ +module Struct.ServerReply exposing (Type(..)) + +-- Elm ------------------------------------------------------------------------- + +-- Map ------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +type Type = +   Okay +   | SetSession (String, String) + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- diff --git a/src/login/src/Struct/UI.elm b/src/login/src/Struct/UI.elm new file mode 100644 index 0000000..53528f7 --- /dev/null +++ b/src/login/src/Struct/UI.elm @@ -0,0 +1,69 @@ +module Struct.UI exposing +   ( +      Type, +      Tab(..), +      default, +      -- Tab +      try_getting_displayed_tab, +      set_displayed_tab, +      reset_displayed_tab, +      to_string, +      tab_from_string, +      get_all_tabs +   ) + +-- Map ------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Tab = +   SignInTab +   | SignUpTab +   | SignedInTab + +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 +      SignInTab -> "Sign In" +      SignUpTab -> "Sign Up" +      SignedInTab -> "Signed In" + +tab_from_string : String -> Tab +tab_from_string str = +   case str of +      "signin" -> SignInTab +      "signup" -> SignUpTab +      _ -> SignInTab + +get_all_tabs : (List Tab) +get_all_tabs = +   [SignInTab, SignUpTab] diff --git a/src/login/src/Update/HandleServerReply.elm b/src/login/src/Update/HandleServerReply.elm new file mode 100644 index 0000000..cdad752 --- /dev/null +++ b/src/login/src/Update/HandleServerReply.elm @@ -0,0 +1,82 @@ +module Update.HandleServerReply exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Array + +import Dict + +import Http + +-- Map ------------------------------------------------------------------- +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)) -> +      (Struct.Model.Type, (Maybe Struct.Error.Type)) +   ) +set_session pid stk current_state = +   case current_state of +      (_, (Just _)) -> current_state + +      (model, _) -> +         ( +            {model | +               player_id = pid, +               session_token = stk +            }, +            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.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) -> updated_model +                  (_, (Just error)) -> (Struct.Model.invalidate error model) +            ), +            Cmd.none +         ) diff --git a/src/login/src/Update/SelectTab.elm b/src/login/src/Update/SelectTab.elm new file mode 100644 index 0000000..d15a463 --- /dev/null +++ b/src/login/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/login/src/Update/SendSignIn.elm b/src/login/src/Update/SendSignIn.elm new file mode 100644 index 0000000..9e28c95 --- /dev/null +++ b/src/login/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/login/src/Update/SendSignUp.elm b/src/login/src/Update/SendSignUp.elm new file mode 100644 index 0000000..b4b2605 --- /dev/null +++ b/src/login/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/login/src/Update/SetRequestedHelp.elm b/src/login/src/Update/SetRequestedHelp.elm new file mode 100644 index 0000000..dfc58db --- /dev/null +++ b/src/login/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/login/src/Util/Array.elm b/src/login/src/Util/Array.elm new file mode 100644 index 0000000..9e57c18 --- /dev/null +++ b/src/login/src/Util/Array.elm @@ -0,0 +1,34 @@ +module Util.Array exposing +   ( +      update, +      update_unsafe, +      filter_first +   ) + +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) + +filter_first : (t -> Bool) -> (Array.Array t) -> (Maybe t) +filter_first fun array = +   (Array.get 0 (Array.filter fun array)) diff --git a/src/login/src/Util/Html.elm b/src/login/src/Util/Html.elm new file mode 100644 index 0000000..42eadba --- /dev/null +++ b/src/login/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/login/src/Util/List.elm b/src/login/src/Util/List.elm new file mode 100644 index 0000000..2bc5217 --- /dev/null +++ b/src/login/src/Util/List.elm @@ -0,0 +1,16 @@ +module Util.List exposing (..) + +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)) + +get_first : (a -> Bool) -> (List a) -> (Maybe a) +get_first fun list = +   (List.head (List.filter fun list)) diff --git a/src/login/www/index.html b/src/login/www/index.html new file mode 100644 index 0000000..d2e13fd --- /dev/null +++ b/src/login/www/index.html @@ -0,0 +1,29 @@ +<!DOCTYPE html> +<html> +   <head> +      <link rel="stylesheet" type="text/css" href="/css/global.css"> +      <link rel="stylesheet" type="text/css" href="/css/verbose.css"> +      <link rel="stylesheet" type="text/css" href="/css/login.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> diff --git a/src/map-editor/src/Comm/Okay.elm b/src/map-editor/src/Comm/Okay.elm index 8ade538..ca7a2eb 100644 --- a/src/map-editor/src/Comm/Okay.elm +++ b/src/map-editor/src/Comm/Okay.elm @@ -4,7 +4,6 @@ module Comm.Okay exposing (decode)  import Json.Decode  -- Battlemap ------------------------------------------------------------------- -import Struct.Tile  import Struct.ServerReply  -------------------------------------------------------------------------------- diff --git a/src/map-editor/www/index.html b/src/map-editor/www/index.html index 61e551f..80b147d 100644 --- a/src/map-editor/www/index.html +++ b/src/map-editor/www/index.html @@ -1,10 +1,8 @@  <!DOCTYPE html>  <html>     <head> -      <link rel="stylesheet" type="text/css" href="../css/global.css"> -      <link rel="stylesheet" type="text/css" href="../css/map-editor.css"> -      <link rel="stylesheet" type="text/css" href="../asset/characters.css"> -      <link rel="stylesheet" type="text/css" href="../asset/armors.css"> +      <link rel="stylesheet" type="text/css" href="/css/global.css"> +      <link rel="stylesheet" type="text/css" href="/css/map-editor.css">        <link rel="icon" type="image/x-icon" href="/favicon.ico">     </head>     <body> | 


