module Page.Chest exposing (..) import Api exposing ( ActionMode(..) , Claims , HttpResult , Item , Loot , RequestData(..) , Wealth , confirmAction ) import Browser.Navigation as Nav import Dict exposing (Dict) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (onCheck, onClick, onInput) import Route exposing (ChestContent(..)) import Session exposing (Session(..)) import Set exposing (Set) import Utils exposing (..) -- MODEL type alias State = { menuOpen : Bool , mode : ActionMode , error : Maybe String , notification : Maybe String -- Buy/Sell loot , priceModifiers : Dict Int Int -- AddLoot , showModal : Bool , autoComplete : Loot , newItem : Maybe Item , sourceName : Maybe String , itemList : Maybe (List String) -- Fetched on init , player : Api.Player , playerLoot : Loot , groupLoot : Loot , merchantLoot : Loot , newLoot : Loot } type alias Selection = Set Int type alias Model = { navKey : Nav.Key , state : State , shown : Route.ChestContent , selection : Maybe Selection , searchText : String , claims : Claims } init (Player navKey playerId) = ( Model navKey (State False View Nothing Nothing Dict.empty False [] Nothing Nothing Nothing Api.blankPlayer [] [] [] [] ) Route.PlayerLoot Nothing "" [] , Cmd.batch [ Api.fetchPlayer GotPlayer playerId , Api.fetchClaims 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 [] [ 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 "" ] -- DEBUG SECTION viewDebugSection : Model -> Html Msg viewDebugSection model = div [ class "panel is-danger" ] [ p [ class "panel-heading" ] [ text "Debug" ] , p [ class "panel-block has-text-danger" ] [ text <| Maybe.withDefault "" model.state.error ] , p [ class "panel-block" ] [ text ("Shown content : " ++ Debug.toString model.shown) ] , p [ class "panel-block" ] [ text ("Active Mode : " ++ Debug.toString model.state.mode) ] , p [ class "panel-block" ] [ text ("Selection : " ++ Debug.toString model.selection) ] , p [ class "panel-block" ] [ text ("Claims : " ++ Debug.toString model.claims) ] , p [] debugSandbox ] stackedIcon name = span [ class "icon is-medium" ] [ span [ class "fa-stack" ] [ i [ class "fas fa-circle fa-stack-2x" ] [] , i [ class (name ++ " fa-inverse fa-stack-1x") ] [] , text "" ] ] debugSandbox = [ stackedIcon "fas fa-coins" , stackedIcon "fab fa-d-and-d" , stackedIcon "fas fa-praying-hands" , stackedIcon "fas fa-gem" , stackedIcon "fas fa-pen" , stackedIcon "fas fa-percentage" , stackedIcon "fas fa-store-alt" , stackedIcon "fas fa-cart-plus" , stackedIcon "fas fa-angry" , stackedIcon "fas fa-plus" , stackedIcon "fas fa-tools" , stackedIcon "fas fa-search" ] -- HEADER SECTION viewHeaderBar : String -> Model -> Html Msg viewHeaderBar title model = nav [ class "navbar", class "is-transparent" ] [ div [ class "navbar-brand" ] [ a [ class "navbar-item", href "/" ] [ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" } , span [ class "title is-4", style "padding-left" "0.4em" ] [ text title ] ] , a [ class "navbar-burger" , classList [ ( "is-active", model.state.menuOpen ) ] , onClick SwitchMenuOpen ] [ span [ attribute "aria-hidden" "true" ] [] , span [ attribute "aria-hidden" "true" ] [] , span [ attribute "aria-hidden" "true" ] [] ] ] , div [ class "navbar-menu", classList [ ( "is-active", model.state.menuOpen ) ] ] [ div [ class "navbar-end" ] [ a [ class "navbar-item", href "/marchand" ] [ renderIcon { icon = "fas fa-store-alt", ratio = "1x", size = "medium" } , span [] [ text "Marchand" ] ] , a [ class "navbar-item" , href (if model.state.player.id == 0 then "/nouveau-tresor" else "/coffre" ) ] [ renderIcon { icon = "fas fa-gem", ratio = "1x", size = "medium" } , span [] [ text (if model.state.player.id == 0 then "Nouveau loot" else "Coffre de groupe" ) ] ] ] ] ] -- PLAYER BAR viewPlayerBar : Api.Player -> List (Html Msg) -> Html Msg viewPlayerBar player actionControls = section [ class "hero is-dark is-bold" ] [ div [ class "hero-body" ] [ div [ class "level container is-mobile" ] [ div [ class "level-left" ] ([ div [ class "level-item" ] [ p [ class "title is-3" ] [ text player.name ] ] , div [ class "level-item" ] [ span [ class "icon is-large" ] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ] ] ] ++ viewWealth player.wealth ++ [ span [ class "icon has-text-danger" ] [ i [ class "fas fa-tools" ] [] ] ] ++ (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 [] ) ) , div [ class "level-right" ] actionControls ] ] ] viewWealth : Wealth -> List (Html Msg) viewWealth wealth = [ showWealthField "pp" <| String.fromInt wealth.pp , showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp , showWealthField "sp" <| String.fromInt wealth.sp , showWealthField "cp" <| String.fromInt wealth.cp ] showWealthField : String -> String -> Html Msg showWealthField name value = div [ class "level-item" ] [ p [ class "has-text-right" ] [ strong [ class "heading is-marginless has-text-white" ] [ text name ] , span [ class <| "is-size-4" ] [ text value ] ] ] -- 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.shown of -- Claim controls for Group chest GroupLoot -> 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 (Debug.log "maybeMod" (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 [ viewHeaderBar "Mon coffre" model , viewPlayerBar model.state.player renderControls , main_ [ class "container" ] [ viewNotification model , article [ class "section" ] (case model.state.mode of Add -> [ 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 Msg 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 Msg 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 Msg = ApiMsg Api.Msg | ClearNotification | SwitchMenuOpen | SetContent ChestContent | SetSelection (Maybe Selection) | SwitchSelectionState Int | GotLoot Api.ToChest (HttpResult Loot) | GotClaims (HttpResult Claims) | GotPlayer (HttpResult Api.Player) | SearchTextChanged String | ModeSwitched ActionMode | OnModeEnter ActionMode | OnModeExit ActionMode | ConfirmAction | NewItemAdded Item | NewItemNameChanged String | NewItemPriceChanged String | SourceNameChanged String | SetNewItem Item | OpenModal | FromListChanged String | FromListConfirmed | NewItemsFromList Loot (Maybe String) | PriceModifierChanged Int String insensitiveContains : String -> String -> Bool insensitiveContains substring string = String.contains (String.toLower substring) (String.toLower string) update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of 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 ) SwitchMenuOpen -> let state = model.state in ( { model | state = { state | menuOpen = not model.state.menuOpen } } , Cmd.none ) 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 } }, 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 (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 (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 then -- Redirect to PlayerLoot view ( model, Nav.pushUrl model.navKey "/" ) 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 "nouveau loot" model.state.sourceName ) (selectContent model) Buy -> let modList = List.map (\item -> Dict.get item.id model.state.priceModifiers |> Maybe.map (\i -> toFloatingMod i) ) items in Just <| Api.BuyPayload items Nothing modList Sell -> let modList = List.map (\item -> Dict.get item.id model.state.priceModifiers |> Maybe.map (\i -> toFloatingMod i) ) items in Just <| Api.SellPayload items Nothing modList [] Grab -> Just <| Api.GrabPayload items View -> Nothing in ( model , case maybeData of Just data -> Cmd.map ApiMsg <| Api.confirmAction (String.fromInt model.state.player.id) data Nothing -> Cmd.none ) ClearNotification -> ( setNotification Nothing model, Cmd.none ) SwitchSelectionState id -> ( { model | selection = switchSelectionState id model.selection }, Cmd.none ) SetSelection new -> ( { model | selection = new }, Cmd.none ) SearchTextChanged search -> ( { model | searchText = search }, Cmd.none ) GotClaims (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 = 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