diff --git a/src/Bulma.elm b/src/Bulma.elm index ab5c0c8..ed6c7b4 100644 --- a/src/Bulma.elm +++ b/src/Bulma.elm @@ -29,7 +29,7 @@ icon params = btn : msg -> { text : String, icon : String, color : String } -> Html msg btn msg params = button - [ class <| "button is-medium level-item " ++ params.color + [ class <| "button " ++ params.color , onClick msg ] [ icon { icon = params.icon, size = Nothing, ratio = Nothing } @@ -38,7 +38,7 @@ btn msg params = buttons btns = - div [ class "buttons" ] btns + div [ class "buttons level-item" ] btns confirmButtons confirm cancel = @@ -66,3 +66,7 @@ datatable headers rows = headers , tbody [] rows ] + + + +-- Section diff --git a/src/Page/Chest.elm b/src/Chest.elm similarity index 98% rename from src/Page/Chest.elm rename to src/Chest.elm index e4f4ff3..fede4b5 100644 --- a/src/Page/Chest.elm +++ b/src/Chest.elm @@ -1,9 +1,9 @@ -module Page.Chest exposing (..) +module Chest exposing (..) import Api exposing (Claims, Item, Loot) +import Chest.NewFromInventory as NewFromInventory +import Chest.Selection as Selection import Html exposing (..) -import Page.Chest.NewFromInventory as NewFromInventory -import Page.Chest.Selection as Selection import Table import Utils diff --git a/src/Page/Chest/NewFromInventory.elm b/src/Chest/NewFromInventory.elm similarity index 75% rename from src/Page/Chest/NewFromInventory.elm rename to src/Chest/NewFromInventory.elm index af9d1f1..d9540ab 100644 --- a/src/Page/Chest/NewFromInventory.elm +++ b/src/Chest/NewFromInventory.elm @@ -1,6 +1,7 @@ -module Page.Chest.NewFromInventory exposing (..) +module Chest.NewFromInventory exposing (..) import Api exposing (Item, Loot) +import Bulma as B import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) @@ -25,25 +26,22 @@ init = view : Model -> Html Msg view model = article [] - [ div [ class "section" ] - [ textarea - [ class "textarea" - , value model.itemList - , onInput ItemListInput - , placeholder "Coller une liste d'objets" - ] - [] - , button - [ class "button is-primary is-fullwidth" - , onClick ItemListSend - ] - [ text "Mettre dans le coffre" ] + [ textarea + [ class "textarea" + , value model.itemList + , onInput ItemListInput + , placeholder "Coller une liste d'objets" ] - , div [ class "section" ] - [ model.validItems - ++ model.invalidItems - |> Table.view (Table.renderRowLevel viewOrEditRenderer (\i -> [])) + [] + , button + [ class "button is-primary is-fullwidth" + , onClick ItemListSend ] + [ text "Mettre dans le coffre" ] + , hr [] [] + , model.validItems + ++ model.invalidItems + |> Table.view (Table.renderRowLevel viewOrEditRenderer (\i -> [])) ] @@ -72,18 +70,21 @@ viewOrEditRenderer item = priceValid = item.base_price > 0 + + itemValid = + nameValid && priceValid in - [ div [ class "field is-grouped" ] - [ div [ class "control" ] - [ input - [ class "input is-small " - , type_ "text" - , value item.name - , onInput <| InvalidItemNameChanged item.id - ] - [] + [ div [ class "field level-item" ] + [ input + [ class "input is-small " + , type_ "text" + , value item.name + , onInput <| InvalidItemNameChanged item.id ] - , div [ class "control" ] + [] + ] + , div [ class "field has-addons level-item" ] + [ p [ class "control" ] [ input [ class "input is-small " , type_ "text" @@ -92,7 +93,13 @@ viewOrEditRenderer item = ] [] ] + , p [ class "control is-small" ] [ a [ class "button is-static" ] [ text "Prix" ] ] ] + , if itemValid then + B.icon { icon = "fas fa-check", size = Nothing, ratio = Nothing } + + else + B.icon { icon = "fas fa-times", size = Nothing, ratio = Nothing } ] else diff --git a/src/Page/Chest/Selection.elm b/src/Chest/Selection.elm similarity index 98% rename from src/Page/Chest/Selection.elm rename to src/Chest/Selection.elm index 7110ce3..7fe6cfc 100644 --- a/src/Page/Chest/Selection.elm +++ b/src/Chest/Selection.elm @@ -1,4 +1,4 @@ -module Page.Chest.Selection exposing (Model, Msg, init, modifiers, selected, update, view) +module Chest.Selection exposing (Model, Msg, init, modifiers, selected, update, view) import Api exposing (Item, Loot) import Dict exposing (Dict) diff --git a/src/Page/Admin.elm.old b/src/Page/Admin.elm.old deleted file mode 100644 index d96dcb2..0000000 --- a/src/Page/Admin.elm.old +++ /dev/null @@ -1,181 +0,0 @@ -module Page.Admin exposing (Model) - -import Api exposing (Loot) -import Api.Player as Player exposing (Player, Wealth) -import Browser.Navigation as Nav -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Page.Shop as Shop -import Route exposing (Route) -import Session exposing (Session) - - -type alias NewPlayerForm = - { name : String - , wealth : Float - } - - -type alias Status = - { session : Session - , players : List Player - , newPlayer : NewPlayerForm - } - - -type Model - = Dashboard Status - | MerchantLoot Shop.Model - - -init : Session -> ( Model, Cmd Msg ) -init session = - ( Dashboard (Status session [] (NewPlayerForm "" 0.0)) - , Player.list GotPlayers - ) - - -getSession model = - case model of - Dashboard status -> - Session.getSession status - - MerchantLoot shop -> - Session.getSession shop - - -view : Model -> List (Html Msg) -view model = - case model of - Dashboard config -> - [ div [ class "container" ] - [ p [ class "title" ] [ text "Administration" ] - , div [ class "section" ] - [ table [ class "table is-fullwidth is-striped" ] - [ thead [ class "table-header" ] - [ th [] [ text "Joueurs" ] ] - , tbody [] <| - editNewPlayer config.newPlayer - :: List.map viewPlayer config.players - ] - ] - , div [ class "section" ] - [ p [] [ text "Campagnes" ] ] - ] - ] - - MerchantLoot shop -> - let - toShopMsg = - Html.map ShopMsg - - ( controls, viewShop ) = - Shop.view shop - |> Tuple.mapBoth toShopMsg (List.map toShopMsg) - in - [ div [ class "container" ] <| - p [ class "title" ] [ text "Marchand" ] - :: controls - :: viewShop - ] - - -viewPlayer : Player -> Html Msg -viewPlayer player = - tr [] [ td [] [ p [] [ text (player.name ++ " (" ++ String.fromInt player.id ++ ")") ] ] ] - - -editNewPlayer : NewPlayerForm -> Html Msg -editNewPlayer newPlayer = - tr [] - [ td [] - [ div [ class "field is-horizontal" ] - [ div [ class "field-body" ] - [ div [ class "field" ] - [ input - [ class "input" - , type_ "text" - , value newPlayer.name - , onInput <| GotFormMsg << NameChanged - ] - [] - ] - , div [ class "field" ] - [ input - [ class "input" - , type_ "text" - , value <| String.fromFloat newPlayer.wealth - , onInput <| GotFormMsg << WealthChanged - ] - [] - ] - ] - ] - ] - ] - - -type Msg - = GotPlayers (List Player) - | GotFormMsg FormMsg - | ShopMsg Shop.Msg - - -type FormMsg - = NameChanged String - | WealthChanged String - - -updateForm : FormMsg -> NewPlayerForm -> NewPlayerForm -updateForm msg form = - case msg of - NameChanged newName -> - { form | name = newName } - - WealthChanged newWealth -> - { form | wealth = Maybe.withDefault 0.0 <| String.toFloat newWealth } - - -routeChanged : Route.Route -> Model -> ( Model, Cmd Msg ) -routeChanged route model = - case model of - Dashboard config -> - case route of - Route.Home Route.MerchantLoot -> - Tuple.mapBoth - MerchantLoot - (Cmd.map ShopMsg) - (config.session |> Shop.init) - - _ -> - ( model, Cmd.none ) - - MerchantLoot shop -> - case route of - Route.Home Route.PlayerLoot -> - init shop.session - - _ -> - ( model, Cmd.none ) - - -update msg model = - case ( msg, model ) of - ( GotPlayers players, Dashboard config ) -> - ( Dashboard { config | players = players }, Cmd.none ) - - ( GotFormMsg formMsg, Dashboard config ) -> - ( Dashboard { config | newPlayer = updateForm formMsg config.newPlayer }, Cmd.none ) - - ( _, Dashboard _ ) -> - ( model, Cmd.none ) - - ( ShopMsg shopMsg, MerchantLoot shopModel ) -> - Shop.update shopMsg shopModel - |> Tuple.mapBoth - MerchantLoot - (Cmd.map ShopMsg) - - ( _, MerchantLoot _ ) -> - ( model, Cmd.none ) diff --git a/src/Page/Chest.elm.old b/src/Page/Chest.elm.old deleted file mode 100644 index 4d811f7..0000000 --- a/src/Page/Chest.elm.old +++ /dev/null @@ -1,1242 +0,0 @@ -module Page.Chest exposing (Model, Msg, init, setContent, update, view) - -import Api - exposing - ( Claims - , HttpResult - , Item - , Loot - , RequestData(..) - , confirmAction - ) -import Api.Player exposing (Player, Wealth, blankPlayer) -import Browser.Navigation as Nav -import Dict exposing (Dict) -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (onCheck, onClick, onInput) -import Page.Chest.Wealth as Wealth -import Route exposing (ChestContent(..)) -import Session exposing (Session) -import Set exposing (Set) -import Utils exposing (..) - - -setContent : ChestContent -> Model -> Model -setContent content model = - update (SetContent content) model - |> Tuple.first - - - -{- - type AddMsg - = NewItemAdded Item - | NewItemNameChanged String - | NewItemPriceChanged String - | SourceNameChanged String - | SetNewItem Item - | OpenModal - | FromListChanged String - | FromListConfirmed - | NewItemsFromList Loot (Maybe String) - - type SelectionMsg - = SetSelection (Maybe Selection) - | SwitchSelectionState Int - -- Buy/Sell modes - | PriceModifierChanged Int String - | WealthMsg Wealth.Msg - - - type Msg - = ApiMsg Api.Msg - | GotLoot Api.ToChest (HttpResult Loot) - | GotClaims (HttpResult Claims) - | GotPlayer (HttpResult Player) - | ClearNotification - | GotChestMsg ChestMsg - --} - - -type ActionMode - = View - | Sell - | Buy - | Grab - | Add - - -type alias State = - { mode : ActionMode - , error : Maybe String - , notification : Maybe String - - -- Chest state - -- Buy/Sell loot - , priceModifiers : Dict Int Int - - -- AddLoot - , showModal : Bool - , autoComplete : Loot - , newItem : Maybe Item - , sourceName : Maybe String - , itemList : Maybe (List String) - - -- , inventoryItems : Loot - -- Fetched on init - , player : Player - , playerLoot : Loot - , groupLoot : Loot - , merchantLoot : Loot - , newLoot : Loot - } - - -type alias Selection = - Set Int - - -type alias Model = - { session : Session - , state : State - - -- Chest - , shown : Route.ChestContent - , selection : Maybe Selection - , searchText : String - - -- Others - , wealth : Wealth.Model - , claims : Claims - } - - -init : Session -> ( Model, Cmd Msg ) -init session = - let - navKey = - Session.key session - - playerId = - case Session.user session of - Session.Player player _ -> - player.id - - Session.Admin -> - 0 - in - ( Model - session - (State - View - Nothing - Nothing - Dict.empty - False - [] - Nothing - Nothing - Nothing - blankPlayer - [] - [] - [] - [] - ) - Route.PlayerLoot - Nothing - "" - Wealth.init - [] - , Cmd.batch - [ Api.Player.get GotPlayer playerId - , Api.fetchClaimsOf GotClaims playerId - , Api.fetchLoot GotLoot (Api.OfPlayer playerId) - , Api.fetchLoot GotLoot Api.OfGroup - , Api.fetchLoot GotLoot Api.OfShop - ] - ) - - -viewNotification : Model -> Html Msg -viewNotification model = - div [ class "section" ] - [ case model.state.notification of - Just t -> - div [ class "notification is-success" ] - [ button [ class "delete", onClick ClearNotification ] [] - , text t - ] - - Nothing -> - text "" - , case model.state.error of - Just e -> - div [ class "notification is-danger" ] - [ button [ class "delete", onClick ClearNotification ] [] - , text e - ] - - Nothing -> - text "" - ] - - - --- PLAYER BAR - - -viewPlayerBar : Player -> List (Html Msg) -> Wealth.Model -> Html Msg -viewPlayerBar player actionControls wealthModel = - section [ class "hero is-dark is-bold" ] - [ div [ class "hero-body" ] - [ div [ class "level container is-mobile" ] - [ div [ class "level-left" ] - (Wealth.view player.wealth wealthModel - ++ (if player.debt > 0 then - [ div [ class "level-item" ] - [ p [ class "heading is-size-4 has-text-danger" ] - [ text ("Dette : " ++ String.fromInt player.debt ++ "po") ] - ] - ] - - else - [] - ) - ) - |> Html.map WealthMsg - , div [ class "level-right" ] actionControls - ] - ] - ] - - - --- VIEW - - -type alias ItemRenderer = - Item -> List (Html Msg) - - -view : Model -> List (Html Msg) -view model = - let - renderControls = - viewControls model.state.mode model.shown - - header = - case model.shown of - PlayerLoot -> - "Mon coffre" - - GroupLoot -> - "Coffre de groupe" - - MerchantLoot -> - "Marchand" - - NewLoot -> - "Nouveau trésor" - - shownItems = - selectContent model - - isSelected = - itemInSelection model.selection - - canSelect = - canSelectIn model.state.mode - - rowRenderer item = - case model.state.mode of - View -> - case ( model.state.player.id, model.shown ) of - ( 0, PlayerLoot ) -> - -- The group is viewing its chest - let - isClaimed = - itemInClaims model.claims - in - case isClaimed item of - True -> - [ renderIcon - { icon = "fas fa-praying-hands" - , size = "small" - , ratio = "1x" - } - ] - - False -> - [] - - ( _, GroupLoot ) -> - -- A player is viewing group chest - let - isClaimed = - itemInClaims model.claims - in - case isClaimed item of - True -> - [ renderIcon - { icon = "fas fa-praying-hands" - , size = "small" - , ratio = "1x" - } - ] - - False -> - [] - - _ -> - [] - - Buy -> - let - maybeMod = - Dict.get item.id model.state.priceModifiers - in - [ viewPriceWithModApplied - (Maybe.map (\i -> toFloatingMod i) maybeMod) - (toFloat item.base_price) - , if isSelected item then - viewPriceModifier item.id <| - case Dict.get item.id model.state.priceModifiers of - Just mod -> - String.fromInt mod - - Nothing -> - "0" - - else - text "" - ] - - Sell -> - let - maybeMod = - Dict.get item.id model.state.priceModifiers - in - [ viewPriceWithModApplied - (Maybe.map (\i -> toFloatingMod i) maybeMod) - (toFloat item.base_price / 2) - , if isSelected item then - viewPriceModifier item.id <| - case maybeMod of - Just mod -> - String.fromInt mod - - Nothing -> - "0" - - else - text "" - ] - - Grab -> - [ p [ class "level-item" ] [ text "Grab" ] - ] - - Add -> - [ p [ class "level-item" ] [ text <| "Valeur : " ++ String.fromInt item.base_price ++ "po" ] - ] - - filteredItems = - shownItems - |> List.filter - (\i -> String.toLower i.name |> String.contains (String.toLower model.searchText)) - in - [ viewPlayerBar model.state.player renderControls model.wealth - , main_ - [ class "container" ] - [ viewNotification model - , article - [ class "section" ] - (case model.state.mode of - Add -> - [ Html.map AddMsg (viewAddLoot model) - , viewLoot rowRenderer canSelect isSelected shownItems - ] - - _ -> - [ div [ class "columns" ] - [ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ] - , div [ class "column" ] [ viewSearchBar model.searchText ] - ] - , viewLoot rowRenderer canSelect isSelected filteredItems - ] - ) - ] - ] - - - -{- - - module ActionMode - - type Model - = Add - | Sell - | ... - - - rowRenderer mode = - ... - - controlButtons mode = - ... - - cancelAction toMsg mode = - ... - - confirmAction toMsg items mode = - ... - - - --} --- VIEW LOOT - - -viewLoot : ItemRenderer -> Bool -> (Item -> Bool) -> Loot -> Html Msg -viewLoot rowRenderer canSelect isSelected items = - table [ class "table is-fullwidth is-striped is-hoverable" ] - [ thead [ class "table-header" ] - [ th [] [ text "Nom" ] ] - , tbody [] <| List.map (viewItemTableRow isSelected canSelect rowRenderer) items - ] - - - --- Search Bar - - -viewSearchBar : String -> Html Msg -viewSearchBar textValue = - div [ class "field" ] - [ p [ class "control has-icons-left" ] - [ input - [ class "input" - , onInput SearchTextChanged - , value textValue - ] - [] - , span [ class "icon is-left" ] [ i [ class "fas fa-search" ] [] ] - ] - ] - - -toFloatingMod : Int -> Float -toFloatingMod percent = - (100 + Debug.log "toFloat" (toFloat percent)) / 100 - - - --- Renderers : Item -> Html Msg - - -viewPriceWithModApplied : Maybe Float -> Float -> Html Msg -viewPriceWithModApplied maybeMod basePrice = - case maybeMod of - Just mod -> - p [ class "level-item has-text-weight-bold" ] - [ (Debug.log "withMod" (String.fromFloat (basePrice * mod)) ++ "po") - |> text - ] - - Nothing -> - p [ class "level-item" ] [ (String.fromFloat basePrice ++ "po") |> text ] - - -viewPriceModifier : Int -> String -> Html Msg -viewPriceModifier id modValue = - div [ class "level-item field has-addons" ] - [ div [ class "control has-icons-left" ] - [ input - [ type_ "number" - , value modValue - , class "input is-small" - , size 3 - , style "width" "6em" - , Html.Attributes.min "-50" - , Html.Attributes.max "50" - , step "5" - , onInput (PriceModifierChanged id) - ] - [] - , span [ class "icon is-left" ] [ i [ class "fas fa-percent" ] [] ] - ] - ] - - -viewItemTableRow : (Item -> Bool) -> Bool -> ItemRenderer -> Item -> Html Msg -viewItemTableRow isSelected canSelect rowRenderer item = - let - rightLevel = - div [ class "level-right" ] <| - (if canSelect then - input - [ class "checkbox level-item" - , type_ "checkbox" - , checked <| isSelected item - , onCheck (\v -> SwitchSelectionState item.id) - ] - [] - - else - text "" - ) - :: rowRenderer item - in - tr [ classList [ ( "is-selected", isSelected item ) ] ] - [ td [] - [ label [ class "level checkbox" ] - [ div [ class "level-left" ] - [ p [ class "level-item" ] [ text item.name ] ] - , rightLevel - ] - ] - ] - - - --- Adding new loot --- - - -fromListModal isActive itemList = - div [ class "modal", classList [ ( "is-active", isActive ) ] ] - [ div [ class "modal-background" ] [] - , div [ class "modal-card" ] - [ header [ class "modal-card-head" ] [ p [ class "modal-card-title" ] [ text "Liste d'objets" ] ] - , div [ class "modal-card-body" ] - [ textarea [ class "textarea", value (String.join "\n" itemList), onInput FromListChanged ] [] - ] - , div [ class "modal-card-foot" ] - [ button [ class "button", onClick FromListConfirmed ] [ text "Ok" ] - , button [ class "button" ] [ text "Annuler" ] - ] - ] - ] - - -viewCompletionDropdown : Bool -> Loot -> Html AddMsg -viewCompletionDropdown shown results = - div - [ class "dropdown" - , classList [ ( "is-active", shown ) ] - ] - [ div [ class "dropdown-menu" ] - [ div [ class "dropdown-content" ] - (List.map - (\item -> - a - [ class "dropdown-item" - , onClick (SetNewItem item) - ] - [ text item.name ] - ) - results - ) - ] - ] - - -viewAddLoot : Model -> Html AddMsg -viewAddLoot model = - let - autoResults = - model.state.autoComplete - - showCompletionTips = - if List.length autoResults > 0 && newItem.base_price == 0 then - True - - else - False - - showModal = - model.state.showModal - - newItem = - case model.state.newItem of - Just item -> - item - - Nothing -> - Item 0 "" 0 - - itemList = - case model.state.itemList of - Just items -> - items - - Nothing -> - [] - - sourceName = - case model.state.sourceName of - Just name -> - name - - Nothing -> - "" - - itemIsValid = - if nameValid && priceValid then - True - - else - False - - nameValid = - newItem.name /= "" - - priceValid = - newItem.base_price > 0 - - doesNotYetExists = - newItem.id == 0 - in - div [ class "box is-primary" ] - [ fromListModal showModal itemList - , div [ class "field is-horizontal" ] - [ div [ class "field-label is-medium" ] [ label [ class "label" ] [ text "Source du loot" ] ] - , div [ class "field-body" ] - [ div [ class "field" ] - [ div [ class "control is-expanded" ] - [ input - [ class "input" - , type_ "text" - , name "source" - , value sourceName - , onInput SourceNameChanged - ] - [] - ] - , p [ class "help" ] [ text "Personnage, lieu ou événement d'où provient ce loot." ] - ] - ] - ] - , hr [] [] - , div [ class "field is-horizontal" ] - [ div [ class "field-label is-medium" ] [ label [ class "label" ] [ text "Nouvel objet" ] ] - , div [ class "field-body" ] - [ div [ class "field" ] - [ div [ class "control" ] - [ input - [ class "input" - , classList [ ( "is-success", nameValid ), ( "is-danger", not nameValid ) ] - , type_ "text" - , value newItem.name - , onInput NewItemNameChanged - ] - [] - ] - , if showCompletionTips then - viewCompletionDropdown showCompletionTips autoResults - - else - text "" - , p [ class "help has-text-warning" ] - [ text - (if nameValid && doesNotYetExists then - "Cet objet n'existe pas dans l'inventaire. Il y sera ajouté si vous validez." - - else - "" - ) - ] - ] - , div [ class "field is-narrow" ] - [ div [ class "field has-addons" ] - [ p [ class "control" ] [ a [ class "button is-static" ] [ text "PO" ] ] - , p [ class "control" ] - [ input - [ type_ "number" - , class "input" - , value <| String.fromInt newItem.base_price - , onInput NewItemPriceChanged - , classList [ ( "is-danger", not priceValid ), ( "is-success", priceValid ) ] - ] - [] - ] - ] - , p [ class "help has-text-danger" ] - [ text - (if priceValid then - "" - - else - "Vous devez renseigner le prix !" - ) - ] - ] - , div [ class "field is-narrow" ] - [ div [ class "control" ] - [ button - [ class "button" - , classList [ ( "is-primary", not doesNotYetExists ), ( "is-warning", doesNotYetExists ) ] - , disabled <| not itemIsValid - , onClick <| NewItemAdded newItem - ] - [ text "Ajouter au coffre" ] - ] - ] - ] - ] - , div [ class "field is-horizontal" ] - [ div [ class "field-label is-medium" ] [ label [ class "label" ] [ text "ou" ] ] - , div [ class "field-body" ] - [ div [ class "control" ] - [ button - [ class "button" - , onClick OpenModal - ] - [ text "Depuis une liste" ] - ] - ] - ] - ] - - - --- ACTION MODES --- - - -canSelectIn : ActionMode -> Bool -canSelectIn mode = - case mode of - Sell -> - True - - Buy -> - True - - Grab -> - True - - Add -> - False - - View -> - False - - -viewControls : ActionMode -> ChestContent -> List (Html Msg) -viewControls mode content = - case mode of - View -> - case content of - PlayerLoot -> - [ actionButton (ModeSwitched Sell) "Vendre" "coins" "danger" ] - - GroupLoot -> - [ actionButton (ModeSwitched Grab) "Demander" "praying-hands" "primary" ] - - MerchantLoot -> - [ actionButton (ModeSwitched Buy) "Acheter" "coins" "success" ] - - NewLoot -> - [ actionButton (ModeSwitched Add) "Nouveau loot" "plus" "primary" ] - - m -> - [ actionButton ConfirmAction "Valider" "check" "primary" - , actionButton (ModeSwitched View) "Annuler" "times" "danger" - ] - - - --- UPDATE - - -type AddMsg - = NewItemAdded Item - | NewItemNameChanged String - | NewItemPriceChanged String - | SourceNameChanged String - | SetNewItem Item - | OpenModal - | FromListChanged String - | FromListConfirmed - | NewItemsFromList Loot (Maybe String) - - -type Msg - = ApiMsg Api.Msg - | GotLoot Api.ToChest (HttpResult Loot) - | GotClaims (HttpResult Claims) - | GotPlayer (HttpResult Player) - -- Chest UI - | ClearNotification - | SetContent ChestContent - | SearchTextChanged String - -- Selection - | SetSelection (Maybe Selection) - | SwitchSelectionState Int - -- Action modes - | ModeSwitched ActionMode - | OnModeEnter ActionMode - | OnModeExit ActionMode - | ConfirmAction - -- Add loot - | AddMsg AddMsg - -- Buy/Sell modes - | PriceModifierChanged Int String - | WealthMsg Wealth.Msg - - - --- Edit wealth ---| EditWealth ---| AmountChanged String ---| ConfirmEditWealth - - -insensitiveContains : String -> String -> Bool -insensitiveContains substring string = - String.contains (String.toLower substring) (String.toLower string) - - -switchEditWealth state = - { state | editWealth = not state.editWealth } - - -setWealthAmount state amount = - { state - | wealthAmount = String.replace "," "." amount - } - - -update : Msg -> Model -> ( Model, Cmd Msg ) -update msg model = - case msg of - WealthMsg wealthMsg -> - let - ( newWealth, edited ) = - Wealth.update wealthMsg model.wealth - in - ( { model | wealth = newWealth } - , case edited of - Just a -> - Cmd.map ApiMsg <| - Api.confirmAction - (String.fromInt model.state.player.id) - (Api.WealthPayload a) - - Nothing -> - Cmd.none - ) - - PriceModifierChanged id value -> - let - state = - model.state - in - ( { model - | state = - { state - | priceModifiers = - Dict.insert - id - (case String.toInt value of - Just i -> - i - - Nothing -> - 0 - ) - model.state.priceModifiers - } - } - , Cmd.none - ) - - AddMsg addMsg -> - case addMsg of - NewItemsFromList newLoot maybeErrors -> - let - state = - model.state - - error = - case maybeErrors of - Just errors -> - (String.lines errors - |> String.join "" - ) - ++ "n'ont pas pu être ajoutés.\n Faites le manuellement !" - |> Just - - Nothing -> - Nothing - in - ( { model - | state = - { state - | itemList = Nothing - , newLoot = newLoot ++ model.state.newLoot - , error = error - } - } - , Cmd.none - ) - - FromListChanged newText -> - let - state = - model.state - - itemList = - String.lines newText - in - ( { model | state = { state | itemList = Just itemList } } - , Cmd.none - ) - - FromListConfirmed -> - let - state = - model.state - - itemList = - Maybe.withDefault [] model.state.itemList - in - ( { model | state = { state | showModal = False } } - , Cmd.map AddMsg <| Api.checkList NewItemsFromList itemList - ) - - OpenModal -> - let - state = - model.state - in - ( { model | state = { state | showModal = True } }, Cmd.none ) - - NewItemAdded item -> - let - state = - model.state - in - ( { model | state = { state | newLoot = item :: state.newLoot } }, Cmd.none ) - - SetNewItem item -> - let - state = - model.state - in - ( { model | state = { state | newItem = Just item } }, Cmd.none ) - - SourceNameChanged name -> - let - state = - model.state - in - ( { model | state = { state | sourceName = Just name } } - , Cmd.none - ) - - NewItemPriceChanged price -> - case String.toInt price of - Just newPrice -> - let - newItem = - case model.state.newItem of - Just item -> - { item | base_price = newPrice } - - Nothing -> - Item 0 "" newPrice - in - update (AddMsg (SetNewItem newItem)) model - - Nothing -> - ( model, Cmd.none ) - - NewItemNameChanged itemName -> - let - state = - model.state - - -- Recalculate auto-completion results - matches = - if itemName == "" then - [] - - else - -- TODO: For now, merchantLoot *IS* the inventory - model.state.merchantLoot - |> List.filter (\i -> insensitiveContains itemName i.name) - in - { model | state = { state | autoComplete = matches } } - -- Update newItem field and erase other (outdated) values - |> update - (AddMsg (SetNewItem <| Item 0 itemName 0)) - - ApiMsg apiMsg -> - case apiMsg of - Api.GotActionResult response -> - case response of - Ok result -> - let - updates = - Maybe.withDefault [] result.updates - - notification = - result.notification - - errors = - Maybe.withDefault "" result.errors - in - List.foldl applyUpdate model updates - |> setNotification notification - |> setError errors - |> update (ModeSwitched View) - - Err r -> - ( setError (Debug.toString r) model, Cmd.none ) - - SetContent content -> - if content == NewLoot then - { model | shown = content } - |> update (ModeSwitched Add) - - else - ( { model | shown = content } - , Cmd.none - ) - - GotPlayer result -> - case result of - Ok player -> - let - state = - model.state - in - ( { model | state = { state | player = player } }, Cmd.none ) - - Err error -> - ( setError ("Fetching player... " ++ Debug.toString error) model - , Cmd.none - ) - - OnModeEnter mode -> - update - (SetSelection - (case ( mode, canSelectIn mode ) of - ( _, False ) -> - Nothing - - -- Currently claimed object are initially selected - ( Grab, _ ) -> - Just (Set.fromList <| List.map (\c -> c.loot_id) model.claims) - - ( _, True ) -> - Just Set.empty - ) - ) - model - - OnModeExit mode -> - if mode == Add || mode == Buy then - -- Redirect to PlayerLoot view - ( model, Nav.pushUrl (Session.key model.session) "/" ) - - else - ( model, Cmd.none ) - - ModeSwitched newMode -> - let - state = - model.state - - -- We chain exit old mode and enter new mode updates - ( exit, exit_cmd ) = - update (OnModeExit model.state.mode) model - - ( entered, enter_cmd ) = - update (OnModeEnter newMode) exit - in - ( { entered | state = { state | mode = newMode } } - , Cmd.batch [ exit_cmd, enter_cmd ] - ) - - ConfirmAction -> - let - items = - getSelectedItems model - - maybeData = - case model.state.mode of - Add -> - Just <| - Api.AddPayload - (Maybe.withDefault - Claims (Ok claims) -> - ( { model | claims = claims }, Cmd.none ) - - GotClaims (Err error) -> - ( setError (Debug.toString error) model, Cmd.none ) - - GotLoot dest (Ok loot) -> - ( let - state = - model.state - in - case dest of - Api.OfPlayer _ -> - { model | state = { state | playerLoot = loot } } - - Api.OfGroup -> - { model | state = { state | groupLoot = loot } } - - Api.OfShop -> - { model | state = { state | merchantLoot = loot } } - , Cmd.none - ) - - GotLoot _ (Err error) -> - ( setError (Debug.toString error) model, Cmd.none ) - - -setNotification : Maybe String -> Model -> Model -setNotification notification model = - let - state = - model.state - in - { model - | state = - { state | notification = notification } - } - - - --- ERRORS - - -setError : String -> Model -> Model -setError error model = - let - state = - model.state - - newError = - if error == "" then - Nothing - - else - Just error - in - { model - | state = - { state | error = newError } - } - - -applyUpdate : Api.Update -> Model -> Model -applyUpdate u model = - {- Note: DbUpdates always refer to the active player's loot -} - let - state = - model.state - in - case u of - Api.ItemRemoved item -> - { model - | state = - { state - | playerLoot = - List.filter (\i -> i.id /= item.id) model.state.playerLoot - } - } - - Api.ItemAdded item -> - { model | state = { state | playerLoot = item :: model.state.playerLoot } } - - Api.WealthUpdated diff -> - let - player = - model.state.player - - wealth = - player.wealth - in - { model - | state = - { state - | player = - { player - | wealth = - Api.Player.Wealth - (wealth.cp + diff.cp) - (wealth.sp + diff.sp) - (wealth.gp + diff.gp) - (wealth.pp + diff.pp) - } - } - } - - Api.ClaimAdded claim -> - { model | claims = claim :: model.claims } - - Api.ClaimRemoved claim -> - { model | claims = List.filter (\c -> c.id /= claim.id) model.claims } - - - --- Selection --- Get list of selected items - - -getSelectedItems : Model -> Loot -getSelectedItems model = - selectContent model - |> List.filter (itemInSelection model.selection) - - -itemInSelection : Maybe Selection -> Item -> Bool -itemInSelection selection item = - Maybe.map (Set.member item.id) selection - |> Maybe.withDefault False - - -itemInClaims : Claims -> Item -> Bool -itemInClaims claims item = - List.any (\c -> c.loot_id == item.id) claims - - -switchSelectionState : Int -> Maybe Selection -> Maybe Selection -switchSelectionState id selection = - case selection of - Just s -> - Just <| - case Set.member id s of - True -> - Set.remove id s - - False -> - Set.insert id s - - Nothing -> - Debug.log "ignore switchSelectionState" Nothing - - -selectContent : Model -> List Item -selectContent model = - case model.shown of - NewLoot -> - model.state.newLoot - - MerchantLoot -> - model.state.merchantLoot - - PlayerLoot -> - model.state.playerLoot - - GroupLoot -> - model.state.groupLoot diff --git a/src/Page/Dashboard.elm b/src/Page/Dashboard.elm index 20c5376..7f70747 100644 --- a/src/Page/Dashboard.elm +++ b/src/Page/Dashboard.elm @@ -3,10 +3,10 @@ module Page.Dashboard exposing (Model, Msg(..), getSession, init, update, update import Api import Api.Player as Player exposing (Player, Wealth) import Bulma as B +import Chest exposing (Chest) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Page.Chest as Chest exposing (Chest) import Session exposing (Session) @@ -99,16 +99,34 @@ view model = Chest.View _ -> case data.player.id of 0 -> - buttons [ modeButton "Vendre" (GotChestMsg Chest.sell), modeButton "Ajouter" (GotChestMsg Chest.new) ] + buttons + [ B.btn + (GotChestMsg Chest.sell) + { text = "Vendre" + , icon = "fas fa-coins" + , color = "is-primary" + } + , B.btn + (GotChestMsg Chest.new) + { text = "Nouveau loot" + , icon = "fas fa-plus" + , color = "is-primary" + } + ] _ -> - modeButton "Vendre" (GotChestMsg Chest.sell) + B.btn + (GotChestMsg Chest.sell) + { text = "Vendre" + , icon = "fas fa-coins" + , color = "is-primary" + } Chest.Sell _ -> - buttons [ modeButton "Ok" ConfirmSell, modeButton "Annuler" toShow ] + B.confirmButtons ConfirmSell toShow Chest.New _ -> - buttons [ modeButton "Ok" ConfirmAdd, modeButton "Annuler" toShow ] + B.confirmButtons ConfirmAdd toShow _ -> text "" @@ -126,7 +144,12 @@ view model = Admin (AdminConfig session players playerForm) -> ( case playerForm of Nothing -> - B.btn (AdminViewer EditPlayer) { text = "Ajouter un joueur", icon = "fas fa-plus", color = "is-primary" } + B.btn + (AdminViewer EditPlayer) + { text = "Ajouter un joueur" + , icon = "fas fa-plus" + , color = "is-primary" + } Just _ -> B.confirmButtons ConfirmNewPlayer CloseEdit diff --git a/src/Page/GroupChest.elm b/src/Page/GroupChest.elm index 25605bf..df38783 100644 --- a/src/Page/GroupChest.elm +++ b/src/Page/GroupChest.elm @@ -2,10 +2,10 @@ module Page.GroupChest exposing (Model, Msg(..), init, update, view) import Api exposing (HttpResult, Loot) import Bulma as B +import Chest exposing (Chest) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Page.Chest as Chest exposing (Chest) import Session exposing (Session, User(..)) diff --git a/src/Page/LoggedOut.elm b/src/Page/LoggedOut.elm deleted file mode 100644 index 103d528..0000000 --- a/src/Page/LoggedOut.elm +++ /dev/null @@ -1,7 +0,0 @@ -module Page.LoggedOut exposing (view) - -import Html exposing (..) -import Html.Attributes exposing (..) - -view = - p [ class "header is-1" ] [ text "Loot-a-lot" ] diff --git a/src/Page/Shop.elm b/src/Page/Shop.elm index bb40377..8da455d 100644 --- a/src/Page/Shop.elm +++ b/src/Page/Shop.elm @@ -2,11 +2,11 @@ module Page.Shop exposing (Model, Msg(..), init, update, view) import Api exposing (HttpResult, Item, Loot) import Bulma as B +import Chest exposing (Chest) +import Chest.NewFromInventory as NewChest import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Page.Chest as Chest exposing (Chest) -import Page.Chest.NewFromInventory as NewChest import Session exposing (Session, getSession) @@ -44,7 +44,7 @@ view model = ( Html.map Internal <| case ( model.chest, Session.user model.session ) of ( Chest.View _, Session.Admin _ ) -> - B.btn (GotChestMsg Chest.new) { text = "Remplacer", icon = "fas fa-refresh", color = "is-primary" } + B.btn (GotChestMsg Chest.new) { text = "Remplacer", icon = "fas fa-sync-alt", color = "is-primary" } ( Chest.View _, Session.Player _ ) -> B.btn (GotChestMsg Chest.buy) { text = "Acheter", icon = "fas fa-coins", color = "is-primary" }