Files
lootalot-client/src/Page/Chest.elm
2019-11-11 21:57:46 +01:00

836 lines
23 KiB
Elm

module Page.Chest exposing (..)
import Api
exposing
( ActionMode(..)
, Claims
, HttpResult
, Item
, Loot
, Wealth
, confirmAction
)
import Browser.Navigation as Nav
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
-- 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 NoMode Nothing Nothing Api.blankPlayer [] [] [] [])
Route.PlayerLoot
Nothing
""
[]
, Cmd.batch
[ Api.fetchPlayer GotPlayer playerId
, Api.fetchClaims GotClaims playerId
, fetchLoot (OfPlayer playerId)
, fetchLoot OfGroup
, fetchLoot OfShop
]
)
viewNotification : Maybe String -> Html Msg
viewNotification notification =
case notification of
Just t ->
div [ class "notification is-success is-marginless" ]
[ button [ class "delete", onClick ClearNotification ] []
, text t
]
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 container", class "is-info" ]
[ div [ class "navbar-brand" ]
[ a [ class "navbar-item", href "/" ]
[ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" }
, span [] [ text title ]
]
, a [ class "navbar-burger is-active" ]
[ span [ attribute "aria-hidden" "true" ] []
, span [ attribute "aria-hidden" "true" ] []
, span [ attribute "aria-hidden" "true" ] []
]
]
, div [ class "navbar-menu is-active" ]
[ 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 "level container is-mobile box" ]
[ div [ class "level-left" ]
([ div [ class "level-item" ]
[ span [ class "icon is-large" ]
[ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
]
]
++ viewWealth player.wealth
++ (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" ] [ text name ]
, span [ class <| "is-size-4" ] [ text value ]
]
]
-- VIEW
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.shown
isSelected =
itemInSelection model.selection
canSelect =
canSelectIn model.state.mode
rowRenderer =
case model.state.mode of
NoMode ->
case model.shown of
GroupLoot ->
let
isClaimed =
itemInClaims model.claims
in
-- Claim controls for Group chest
Just (claimedItemRenderer isClaimed)
_ ->
Nothing
activeMode ->
Just (rowRendererForMode activeMode)
in
[ viewHeaderBar model.state.player.name model
, viewPlayerBar model.state.player renderControls
, main_
[ class "container" ]
[ viewNotification model.state.notification
-- TODO: viewAddLoot when in Add mode
, case model.state.mode of
Add ->
viewAddLoot model
_ ->
text ""
, viewLoot header model.searchText rowRenderer canSelect isSelected <| shownItems model
]
, hr [] []
, section [ class "container" ] [ viewDebugSection model ]
]
{-
module ActionMode
type Model
= Add
| Sell
| ...
rowRenderer mode =
...
controlButtons mode =
...
cancelAction toMsg mode =
...
confirmAction toMsg items mode =
...
-}
-- VIEW LOOT
viewLoot : String -> String -> Maybe (Item -> Html Msg) -> Bool -> (Item -> Bool) -> Loot -> Html Msg
viewLoot header searchText maybeRowRenderer canSelect isSelected items =
let
filteredItems =
List.filter
(\i -> String.toLower i.name |> String.contains (String.toLower searchText) )
items
in
article
[ class "section" ]
[ div [ class "columns" ]
[ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ]
, div [ class "column" ] [ viewSearchBar searchText ]
]
, table [ class "table is-fullwidth is-striped is-hoverable" ]
[ thead [ class "table-header" ]
[ th [] [ text "Nom" ] ]
, tbody [] <| List.map (viewItemTableRow isSelected canSelect maybeRowRenderer) filteredItems
]
]
-- 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" ] [] ]
]
]
-- Renderers : Item -> Html Msg
claimedItemRenderer : (Item -> Bool) -> Item -> Html Msg
claimedItemRenderer isClaimed item =
case isClaimed item of
True ->
renderIcon
{ icon = "fas fa-praying-hands"
, size = "small"
, ratio = "1x"
}
False ->
text ""
rowRendererForMode : ActionMode -> Item -> Html Msg
rowRendererForMode mode item =
case mode of
Buy ->
p [ class "level-item" ] [ text (String.fromInt item.base_price ++ "po") ]
Sell ->
p [ class "level-item" ] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po") ]
Grab ->
p [ class "level-item" ] [ text "Grab" ]
Add ->
p [ class "level-item" ] [ text "New !" ]
NoMode ->
text ""
viewItemTableRow : (Item -> Bool) -> Bool -> Maybe (Item -> Html Msg) -> Item -> Html Msg
viewItemTableRow isSelected canSelect rowRenderer item =
let
rightLevel =
div [ class "level-right" ]
[ case rowRenderer of
Just render ->
render item
Nothing ->
text ""
, if canSelect then
input
[ class "checkbox level-item"
, type_ "checkbox"
, checked <| isSelected item
, onCheck (\v -> SwitchSelectionState item.id)
]
[]
else
text ""
]
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
--
viewAddLoot : Model -> Html Msg
viewAddLoot model =
let
showCompletionTips = True
newItem = Item 0 "New one #1" 2000
in
div [ class "box is-primary container" ]
[ div [ class "field is-horizontal" ]
[ div [ class "field-label" ]
[ label [ class "label" ] [ text "Nouvel objet" ]]
, div [ class "field-body" ]
[ div [ class "field" ]
[ div [ class "control is-expanded" ]
[ input [ class "input", type_ "text" ] [] ]
, div [ class "dropdown"
, classList [("is-active", showCompletionTips)] ]
[ div [ class "dropdown-menu" ]
[ div [ class "dropdown-content" ]
[ a [ class "dropdown-item" ] [ text "item" ] ]
]
]
]
, div [ class "field is-expanded has-addons" ]
[ p [ class "control" ] [ a [class "button is-static"] [ text "PO" ] ]
, p [ class "control" ]
[ input [ type_ "text"
, class "input"
, classList [ ("is-danger", True) ]]
[]
]
]
, div [ class "field" ]
[ div [ class "control" ]
[ button [ class "button is-primary"
, disabled True
, onClick <| NewItemAdded newItem ]
[ text "Ajouter au coffre" ] ]
]
]
]
, div [ class "field is-horizontal" ]
[ div [ class "field-label" ] [ label [ class "label" ] [ text "ou" ] ]
, div [ class "field-body" ]
[ div [ class "control" ]
[ button [ class "button" ] [ text "Depuis une liste" ] ]
]
]
]
-- ACTION MODES
--
canSelectIn : ActionMode -> Bool
canSelectIn mode =
case mode of
Sell ->
True
Buy ->
True
Grab ->
True
Add ->
False
NoMode ->
False
viewControls : ActionMode -> ChestContent -> List (Html Msg)
viewControls mode content =
case mode of
NoMode ->
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 NoMode) "Annuler" "times" "danger"
]
-- UPDATE
type Msg
= ApiMsg Api.Msg
| ClearNotification
| SetContent ChestContent
| SetSelection (Maybe Selection)
| SearchTextChanged String
| GotLoot ToChest (HttpResult Loot)
| GotClaims (HttpResult Claims)
| GotPlayer (HttpResult Api.Player)
| SwitchSelectionState Int
| ModeSwitched ActionMode
| ConfirmAction
| NewItemAdded Item
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
NewItemAdded item ->
let
state = model.state
in
( { model | state = { state | newLoot = item :: state.newLoot } }, Cmd.none )
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 NoMode)
Err r ->
( setError (Debug.toString r) model, Cmd.none )
SetContent content ->
( { 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
)
ModeSwitched newMode ->
let
state =
model.state
in
{ model | state = { state | mode = newMode } }
|> update
(SetSelection
(case newMode of
NoMode ->
Nothing
Grab ->
-- Currently claimed object are initially selected
Just (Set.fromList <| List.map (\c -> c.loot_id) model.claims)
others ->
Just Set.empty
)
)
ConfirmAction ->
case model.state.mode of
-- This should not happen, so we ignore it
NoMode ->
( model, Cmd.none )
mode ->
let
items =
getSelected model.shown model
in
( model
, Cmd.map ApiMsg <|
Api.confirmAction
mode
(String.fromInt model.state.player.id)
items
)
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
OfPlayer _ ->
{ model | state = { state | playerLoot = loot } }
OfGroup ->
{ model | state = { state | groupLoot = loot } }
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
in
{ model
| state =
{ state | error = Just error }
}
-- DbUpdates always refer to the active player's loot
applyUpdate : Api.Update -> Model -> Model
applyUpdate u model =
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 }
type ToChest
= OfPlayer Int
| OfGroup
| OfShop
fetchLoot : ToChest -> Cmd Msg
fetchLoot dest =
let
url =
case dest of
OfPlayer id ->
"http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
OfShop ->
"http://localhost:8088/api/items"
OfGroup ->
"http://localhost:8088/api/players/0/loot"
in
Api.fetchLoot url (GotLoot dest)
-- Selection
-- Get list of selected items
getSelected : ChestContent -> Model -> Loot
getSelected content model =
selectContent content 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 : ChestContent -> Model -> List Item
selectContent content model =
case content of
NewLoot ->
model.state.newLoot
MerchantLoot ->
model.state.merchantLoot
PlayerLoot ->
model.state.playerLoot
GroupLoot ->
model.state.groupLoot