elm/lootalot-client
1
0
Fork 0
Code Issues 3 Pull Requests Releases Wiki Activity

decided to internalize modes inside Chest.elm

Browse Source
This commit is contained in:
Arthur Gerbaud
2019-12-04 19:16:16 +01:00
parent 976fbe6b4b
commit b97be8c321
9 changed files with 332 additions and 242 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/Main.elm
View File

@@ -7,10 +7,8 @@ import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
import Json.Encode as E import Json.Encode as E
import Page exposing (Page) import Page exposing (Page)
import Page.Chest as Chest exposing (Msg)
import Route exposing (..) import Route exposing (..)
import Session exposing (..) import Session exposing (..)
import Set exposing (Set)
import Svg.Attributes import Svg.Attributes
import Url import Url
import Utils exposing (..) import Utils exposing (..)
@@ -100,7 +98,7 @@ navLink icon linkText url =
viewHeaderBar : String -> List (Html Msg) -> Navbar -> Html Msg viewHeaderBar : String -> List (Html Msg) -> Navbar -> Html Msg
viewHeaderBar navbarTitle navbarLinks navbar = viewHeaderBar navbarTitle navbarLinks navbar =
nav [ class "navbar", class "is-transparent" ] nav [ class "navbar container is-transparent is-spaced " ]
[ div [ class "navbar-brand" ] [ div [ class "navbar-brand" ]
[ a [ class "navbar-item", href "/" ] [ a [ class "navbar-item", href "/" ]
[ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" } [ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" }
@@ -164,21 +162,21 @@ update msg model =
( UrlChanged url, from ) -> ( UrlChanged url, from ) ->
-- Handle routing according to current page -- Handle routing according to current page
case Route.fromUrl url of case Route.fromUrl url of
Just (Route.Home Route.MerchantLoot) -> Just Route.Merchant ->
let let
( shopPage, cmd ) = ( shopPage, cmd ) =
Page.gotoShop from Page.gotoShop from
in in
( model |> setPage shopPage, Cmd.map PageMsg cmd ) ( model |> setPage shopPage, Cmd.map PageMsg cmd )
Just (Route.Home Route.PlayerLoot) -> Just Route.Home ->
let let
( shopPage, cmd ) = ( shopPage, cmd ) =
Page.gotoHome from Page.gotoHome from
in in
( model |> setPage shopPage, Cmd.map PageMsg cmd ) ( model |> setPage shopPage, Cmd.map PageMsg cmd )
Just (Route.Home Route.GroupLoot) -> Just Route.GroupChest ->
let let
( page, cmd ) = ( page, cmd ) =
Page.gotoGroupChest from Page.gotoGroupChest from

158
src/Page.elm
View File

@@ -5,16 +5,17 @@ import Api.Player
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
import Page.Dashboard as Dashboard import Page.Dashboard as Home
import Page.GroupChest as GroupChest import Page.GroupChest as GroupChest
import Page.Shop as Shop import Page.Shop as Shop
import Route
import Session exposing (Session) import Session exposing (Session)
import Utils exposing (renderIcon) import Utils exposing (renderIcon)
import Wealth import Wealth
type Page type Page
= Dashboard Dashboard.Model = Home Home.Model
| GroupChest GroupChest.Model | GroupChest GroupChest.Model
| Shop Shop.Model | Shop Shop.Model
| About | About
@@ -25,14 +26,16 @@ init =
Loading Loading
mapMsg toMsg = mapPageMsg toMsg ( controls, content ) =
List.map (Html.map toMsg) ( Html.map toMsg controls
, List.map (Html.map toMsg) content
)
maybeSession page = maybeSession page =
case page of case page of
Dashboard model -> Home model ->
Just <| Dashboard.getSession model Just <| Home.getSession model
GroupChest model -> GroupChest model ->
Just <| Session.getSession model Just <| Session.getSession model
@@ -48,35 +51,37 @@ view page =
let let
( title, ( controls, content ) ) = ( title, ( controls, content ) ) =
case page of case page of
Dashboard home -> Home home ->
( "Lootalot" ( "Lootalot"
, Dashboard.view home , Home.view home
|> Tuple.mapBoth |> mapPageMsg GotHomeMsg
(Html.map GotDashboardMsg)
(mapMsg GotDashboardMsg)
) )
GroupChest chest -> GroupChest chest ->
( "Lootalot" ( "Lootalot"
, GroupChest.view chest , GroupChest.view chest
|> Tuple.mapBoth |> mapPageMsg GotGroupChestMsg
(Html.map GotGroupChestMsg)
(mapMsg GotGroupChestMsg)
) )
Shop shop -> Shop shop ->
( "Marchand" ( "Marchand"
, Shop.view shop , Shop.view shop
|> Tuple.mapBoth |> mapPageMsg GotShopMsg
(Html.map GotShopMsg)
(mapMsg GotShopMsg)
) )
About -> About ->
( "Loot-a-lot", ( text "", [ p [] [ text "A propos" ] ] ) ) ( "Loot-a-lot", ( text "", [ p [] [ text "A propos" ] ] ) )
Loading -> Loading ->
( "Loot-a-lot", ( text "", [ p [] [ text "Chargement" ] ] ) ) ( "Loot-a-lot"
, ( text ""
, [ div [ class "hero" ]
[ div [ class "hero-body" ]
[ p [] [ text "Chargement" ] ]
]
]
)
)
navbarTitle = navbarTitle =
case maybeSession page of case maybeSession page of
@@ -96,20 +101,16 @@ view page =
Just session -> Just session ->
case Session.user session of case Session.user session of
Session.Player data -> Session.Player data ->
let [ navLink "fas fa-store-alt" Route.Merchant page
linkWithGem =
navLink "fas fa-gem"
in
[ navLink "fas fa-store-alt" "Marchand" "/marchand"
, if data.player.id /= 0 then , if data.player.id /= 0 then
linkWithGem "Coffre de groupe" "/coffre" navLink "fas fa-gem" Route.GroupChest page
else else
text "" text ""
] ]
Session.Admin -> Session.Admin ->
[ navLink "fas fa-store-alt" "Marchand" "/marchand" ] [ navLink "fas fa-store-alt" Route.Merchant page ]
Nothing -> Nothing ->
[] []
@@ -118,25 +119,44 @@ view page =
, { title = navbarTitle, links = navbarLinks } , { title = navbarTitle, links = navbarLinks }
, [ div [ class "container" ] <| , [ div [ class "container" ] <|
viewSessionBar (maybeSession page) [ controls ] viewSessionBar (maybeSession page) [ controls ]
:: (case Maybe.map Session.notification (maybeSession page) of :: div [ class "section" ]
Just (Just notify) -> [ case Maybe.map Session.notification (maybeSession page) of
div [ class "notification is-success" ] [ text notify ] Just (Just t) ->
viewNotification NotifySuccess t
_ -> _ ->
text "" text ""
) , case Maybe.map Session.error (maybeSession page) of
:: (case Maybe.map Session.error (maybeSession page) of Just (Just t) ->
Just (Just notify) -> viewNotification NotifyError t
div [ class "notification is-danger" ] [ text notify ]
_ -> _ ->
text "" text ""
) ]
:: content :: content
] ]
) )
type NotificationKind
= NotifySuccess
| NotifyError
viewNotification kind content =
let
className =
case kind of
NotifySuccess ->
"is-success"
NotifyError ->
"is-danger"
in
div [ class ("notification " ++ className) ]
[ text content ]
viewSessionBar session controls = viewSessionBar session controls =
let let
user = user =
@@ -149,8 +169,10 @@ viewSessionBar session controls =
Wealth.view data.player.wealth data.wealth Wealth.view data.player.wealth data.wealth
++ (if data.player.debt > 0 then ++ (if data.player.debt > 0 then
[ div [ class "level-item" ] [ div [ class "level-item" ]
[ p [ class "heading is-size-4 has-text-danger" ] [ p [ class "has-text-right has-text-danger" ]
[ text ("Dette : " ++ String.fromInt data.player.debt ++ "po") ] [ strong [ class "heading is-marginless has-text-danger" ] [ text "Dette" ]
, span [ class <| "is-size-4" ] [ text (String.fromInt data.player.debt ++ "po") ]
]
] ]
] ]
@@ -179,10 +201,42 @@ renderLevel left right =
-- PLAYER BAR -- PLAYER BAR
navLink icon linkText url = navLink icon route page =
a [ class "navbar-item", href url ] let
( link, url ) =
case route of
Route.Merchant ->
( "Marchand", "/marchand" )
Route.GroupChest ->
( "Coffre de groupe", "/groupe" )
Route.Home ->
( "Home", "/" )
Route.About ->
( "About", "/" )
isActive =
case ( route, page ) of
( Route.Merchant, Shop _ ) ->
True
( Route.GroupChest, GroupChest _ ) ->
True
( Route.Home, Home _ ) ->
True
( Route.About, About ) ->
True
_ ->
False
in
a [ class "navbar-item", classList [ ( "is-active", isActive ) ], href url ]
[ renderIcon { icon = icon, ratio = "1x", size = "medium" } [ renderIcon { icon = icon, ratio = "1x", size = "medium" }
, span [] [ text linkText ] , span [] [ text link ]
] ]
@@ -194,7 +248,7 @@ navLink icon linkText url =
type PageMsg type PageMsg
= ApiMsg Api.Msg = ApiMsg Api.Msg
| GotGroupChestMsg GroupChest.Msg | GotGroupChestMsg GroupChest.Msg
| GotDashboardMsg Dashboard.Msg | GotHomeMsg Home.Msg
| GotShopMsg Shop.Msg | GotShopMsg Shop.Msg
| Wealth Wealth.Msg | Wealth Wealth.Msg
@@ -210,8 +264,8 @@ map func page =
Just session -> Just session ->
case page of case page of
Dashboard model -> Home model ->
Dashboard <| Dashboard.updateSession model (func session) Home <| Home.updateSession model (func session)
GroupChest model -> GroupChest model ->
GroupChest { model | session = func session } GroupChest { model | session = func session }
@@ -229,7 +283,7 @@ map func page =
closeAction ( page, cmd ) = closeAction ( page, cmd ) =
case page of case page of
Dashboard home -> Home home ->
( page, cmd ) ( page, cmd )
GroupChest chest -> GroupChest chest ->
@@ -244,17 +298,17 @@ closeAction ( page, cmd ) =
update msg page = update msg page =
case ( msg, page, maybeSession page ) of case ( msg, page, maybeSession page ) of
-- Dashboard page -- Home page
-- Capture API messages -- Capture API messages
( GotDashboardMsg (Dashboard.Api apiMsg), Dashboard home, _ ) -> ( GotHomeMsg (Home.Api apiMsg), Home home, _ ) ->
update (ApiMsg apiMsg) page update (ApiMsg apiMsg) page
-- Relay others -- Relay others
( GotDashboardMsg subMsg, Dashboard home, _ ) -> ( GotHomeMsg subMsg, Home home, _ ) ->
Dashboard.update subMsg home Home.update subMsg home
|> updatePage Dashboard GotDashboardMsg |> updatePage Home GotHomeMsg
( GotDashboardMsg _, _, _ ) -> ( GotHomeMsg _, _, _ ) ->
( page, Cmd.none ) ( page, Cmd.none )
-- Group chest -- Group chest
@@ -417,8 +471,8 @@ applyUpdate u user =
initHome session = initHome session =
Dashboard.init session Home.init session
|> updatePage Dashboard GotDashboardMsg |> updatePage Home GotHomeMsg
gotoHome page = gotoHome page =
@@ -427,8 +481,8 @@ gotoHome page =
( page, Cmd.none ) ( page, Cmd.none )
Just session -> Just session ->
Dashboard.init session Home.init session
|> updatePage Dashboard GotDashboardMsg |> updatePage Home GotHomeMsg
gotoShop page = gotoShop page =

141
src/Page/Chest.elm
View File

@@ -1,10 +1,11 @@
module Page.Chest exposing (Chest, Msg, confirmAdd, confirmBuy, confirmGrab, confirmSell, init, initCreate, initSelection, show, update, view) module Page.Chest exposing (Chest(..), IntoMode(..), Msg, confirmAdd, confirmBuy, confirmGrab, confirmSell, init, intoMode, update, view)
import Api exposing (Item, Loot) import Api exposing (Claims, Item, Loot)
import Html exposing (..) import Html exposing (..)
import Page.Chest.NewFromInventory as NewFromInventory import Page.Chest.NewFromInventory as NewFromInventory
import Page.Chest.Selection as Selection import Page.Chest.Selection as Selection
import Table import Table
import Utils
type alias RowRenderer msg = type alias RowRenderer msg =
@@ -27,21 +28,38 @@ type alias RowRenderer msg =
type Chest type Chest
= View (Item -> Html Never) = New NewFromInventory.Model
| Selection Selection.Model | View (Item -> Html Never)
| Create NewFromInventory.Model | Buy Selection.Model
| Sell Selection.Model
| Claim Selection.Model
type IntoMode
= IntoView
| IntoViewWithClaims Claims
| IntoAdd
| IntoBuy
| IntoSell
| IntoClaim Claims
{- {-
Dashboard :
* ViewWithClaims (group)
* View
* Add
* Sell
View : RowRenderer -> Chest.View Shop :
* View
Selection : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.Selection * Refresh
* Buy
NewFromInventory : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.NewFromInventory
GroupChest :
* ViewWithClaims
* Claim
-} -}
@@ -49,19 +67,16 @@ init =
View Table.name View Table.name
intoMode : IntoMode -> Msg
intoMode newMode =
IntoMode newMode
show : Table.ItemRenderer Item Never -> Chest show : Table.ItemRenderer Item Never -> Chest
show renderItem = show renderItem =
View <| Table.renderRowLevel renderItem (\_ -> []) View <| Table.renderRowLevel renderItem (\_ -> [])
initCreate =
Create NewFromInventory.init
initSelection maybeInitial =
Selection <| Selection.init maybeInitial
view : Chest -> Loot -> Html Msg view : Chest -> Loot -> Html Msg
view model loot = view model loot =
case model of case model of
@@ -69,31 +84,95 @@ view model loot =
Table.view renderItem loot Table.view renderItem loot
|> Html.map GotViewMsg |> Html.map GotViewMsg
Selection subModel -> Buy subModel ->
Selection.view subModel loot Selection.view subModel loot
|> Html.map GotSelectionMsg |> Html.map GotSelectionMsg
Create subModel -> Sell subModel ->
Selection.view subModel loot
|> Html.map GotSelectionMsg
New subModel ->
NewFromInventory.view subModel NewFromInventory.view subModel
|> Html.map GotCreateMsg |> Html.map GotNewMsg
Claim subModel ->
Selection.view subModel loot
|> Html.map GotSelectionMsg
type Msg type Msg
= GotCreateMsg NewFromInventory.Msg = GotNewMsg NewFromInventory.Msg
| GotSelectionMsg Selection.Msg | GotSelectionMsg Selection.Msg
| GotViewMsg Never | GotViewMsg Never
| IntoMode IntoMode
update : Msg -> Chest -> ( Chest, Cmd Msg ) update : Msg -> Chest -> ( Chest, Cmd Msg )
update msg model = update msg model =
case ( msg, model ) of case ( msg, model ) of
( GotCreateMsg subMsg, Create subModel ) -> ( GotNewMsg subMsg, New subModel ) ->
NewFromInventory.update subMsg subModel NewFromInventory.update subMsg subModel
|> updateChest GotCreateMsg Create |> updateChest GotNewMsg New
( GotSelectionMsg subMsg, Selection subModel ) -> ( GotNewMsg subMsg, _ ) ->
( model, Cmd.none )
( GotSelectionMsg subMsg, Buy subModel ) ->
Selection.update subMsg subModel Selection.update subMsg subModel
|> updateChest GotSelectionMsg Selection |> updateChest GotSelectionMsg Buy
( GotSelectionMsg subMsg, Sell subModel ) ->
Selection.update subMsg subModel
|> updateChest GotSelectionMsg Sell
( GotSelectionMsg subMsg, Claim subModel ) ->
Selection.update subMsg subModel
|> updateChest GotSelectionMsg Claim
( GotSelectionMsg subMsg, _ ) ->
( model, Cmd.none )
( IntoMode newMode, _ ) ->
case newMode of
IntoView ->
( View Table.name, Cmd.none )
IntoViewWithClaims claims ->
let
isClaimed item =
List.any (\claim -> claim.loot_id == item.id) claims
renderItem item =
[ if isClaimed item then
Utils.renderIcon
{ icon = "fas fa-praying-hands"
, size = "small"
, ratio = "1x"
}
else
text ""
, p [] [ text item.name ]
]
in
( View <| Table.renderRowLevel renderItem (\_ -> []), Cmd.none )
IntoBuy ->
( Buy <| Selection.init Nothing True, Cmd.none )
IntoSell ->
( Sell <| Selection.init Nothing True, Cmd.none )
IntoClaim claims ->
let
initialSelection =
List.map .loot_id claims
in
( Claim <| Selection.init (Just initialSelection) False, Cmd.none )
IntoAdd ->
( New NewFromInventory.init, Cmd.none )
_ -> _ ->
( model, Cmd.none ) ( model, Cmd.none )
@@ -113,7 +192,7 @@ updateChest toMsg toChest ( model, cmd ) =
confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg
confirmBuy playerId model loot = confirmBuy playerId model loot =
case model of case model of
Selection chest -> Buy chest ->
let let
items = items =
Selection.selected chest loot Selection.selected chest loot
@@ -135,7 +214,7 @@ confirmBuy playerId model loot =
confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg
confirmSell playerId model loot players = confirmSell playerId model loot players =
case model of case model of
Selection chest -> Sell chest ->
let let
items = items =
Selection.selected chest loot Selection.selected chest loot
@@ -157,7 +236,7 @@ confirmSell playerId model loot players =
confirmAdd : Int -> String -> Chest -> Cmd Api.Msg confirmAdd : Int -> String -> Chest -> Cmd Api.Msg
confirmAdd playerId sourceName model = confirmAdd playerId sourceName model =
case model of case model of
Create chest -> New chest ->
let let
items = items =
NewFromInventory.allLoot chest NewFromInventory.allLoot chest
@@ -176,7 +255,7 @@ confirmAdd playerId sourceName model =
confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg
confirmGrab playerId loot model = confirmGrab playerId loot model =
case model of case model of
Selection chest -> Claim chest ->
let let
items = items =
Selection.selected chest loot Selection.selected chest loot

111
src/Page/Chest/Selection.elm
View File

@@ -13,16 +13,17 @@ type alias Selection =
Set Int Set Int
type alias Data a = type Data a
Dict Int a = NoData
| Data (Dict Int a)
type Model type Model
= Model Selection (Data Int) = Model Selection (Data Int)
init : Maybe (List Int) -> Model init : Maybe (List Int) -> Bool -> Model
init maybeInitial = init maybeInitial hasData =
Model Model
(case maybeInitial of (case maybeInitial of
Just initial -> Just initial ->
@@ -31,7 +32,13 @@ init maybeInitial =
Nothing -> Nothing ->
Set.empty Set.empty
) )
Dict.empty (case hasData of
True ->
Data Dict.empty
False ->
NoData
)
view : Model -> Loot -> Html Msg view : Model -> Loot -> Html Msg
@@ -40,37 +47,46 @@ view (Model selection data) loot =
isSelected = isSelected =
itemInSelection selection itemInSelection selection
renderItem item = renderRight item =
let case data of
maybeMod = Data inner ->
Dict.get item.id data let
in maybeMod =
[ viewPriceWithModApplied Dict.get item.id inner
(Maybe.map (\i -> toFloatingMod i) maybeMod) in
(toFloat item.base_price) renderItemWithPrice .base_price isSelected maybeMod item
, if isSelected item then
viewPriceModifier item.id <|
case Dict.get item.id data of
Just mod ->
String.fromInt mod
Nothing -> NoData ->
"0" []
else
text ""
]
in in
Table.view Table.view
(Table.renderSelectableRow (Table.renderSelectableRow
(\item -> [ p [] [ text item.name ] ]) (\item -> [ p [] [ text item.name ] ])
(\item -> renderItem item) renderRight
(\item _ -> SwitchSelectionState item.id) (\item _ -> SwitchSelectionState item.id)
isSelected isSelected
) )
loot loot
renderItemWithPrice toPrice isSelected maybeMod item =
[ viewPriceWithModApplied
(Maybe.map (\i -> toFloatingMod i) maybeMod)
(toFloat item.base_price)
, if isSelected item then
viewPriceModifier item.id <|
case maybeMod of
Just mod ->
String.fromInt mod
Nothing ->
"0"
else
text ""
]
toFloatingMod : Int -> Float toFloatingMod : Int -> Float
toFloatingMod percent = toFloatingMod percent =
(100 + Debug.log "toFloat" (toFloat percent)) / 100 (100 + Debug.log "toFloat" (toFloat percent)) / 100
@@ -126,12 +142,17 @@ selected (Model selection data) loot =
modifiers : Model -> Loot -> List (Maybe Float) modifiers : Model -> Loot -> List (Maybe Float)
modifiers (Model selection data) items = modifiers (Model selection data) items =
List.map case data of
(\item -> Data inner ->
Dict.get item.id data List.map
|> Maybe.map (\i -> toFloatingMod i) (\item ->
) Dict.get item.id inner
items |> Maybe.map (\i -> toFloatingMod i)
)
items
NoData ->
[]
itemInSelection : Selection -> Item -> Bool itemInSelection : Selection -> Item -> Bool
@@ -166,18 +187,24 @@ update : Msg -> Model -> ( Model, Cmd Msg )
update msg (Model selection data) = update msg (Model selection data) =
case msg of case msg of
PriceModifierChanged id value -> PriceModifierChanged id value ->
( Model selection ( Model selection <|
(Dict.insert case data of
id Data inner ->
(case String.toInt value of Data
Just i -> (Dict.insert
i id
(case String.toInt value of
Just i ->
i
Nothing -> Nothing ->
0 0
) )
data inner
) )
NoData ->
data
, Cmd.none , Cmd.none
) )

2
src/Page/Dashboard.elm
View File

@@ -302,7 +302,7 @@ update msg model =
(Cmd.map GotChestMsg) (Cmd.map GotChestMsg)
IntoSell -> IntoSell ->
( Player (PlayerConfig session (Sell <| Chest.initSelection Nothing)), Cmd.none ) ( Player (PlayerConfig session (Sell <| Chest.initSelection Nothing True)), Cmd.none )
IntoAdd -> IntoAdd ->
( Player (PlayerConfig session (Add Chest.initCreate)), Cmd.none ) ( Player (PlayerConfig session (Add Chest.initCreate)), Cmd.none )

110
src/Page/GroupChest.elm
View File

@@ -8,29 +8,16 @@ import Page.Chest as Chest exposing (Chest)
import Session exposing (Session, User(..)) import Session exposing (Session, User(..))
import Set import Set
import Table import Table
import Utils exposing (renderIcon)
type alias Model = type alias Model =
{ session : Session { session : Session
, loot : State , loot : State
, mode : Mode , chest : Chest
} }
type Mode
= View Chest
| Grab Chest
mapChest fn mode =
case mode of
View chest ->
fn chest
Grab chest ->
fn chest
type State type State
= Loading = Loading
| LoadError String | LoadError String
@@ -52,7 +39,13 @@ getClaimsFromSession session =
init session = init session =
( Model session Loading (View <| showClaims (getClaimsFromSession session)), Cmd.map Internal <| Api.fetchLoot GotLoot Api.OfGroup ) ( Model session
Loading
(Tuple.first <|
Chest.update (Chest.intoMode (Chest.IntoViewWithClaims <| getClaimsFromSession session)) Chest.init
)
, Cmd.map Internal <| Api.fetchLoot GotLoot Api.OfGroup
)
view : Model -> ( Html Msg, List (Html Msg) ) view : Model -> ( Html Msg, List (Html Msg) )
@@ -79,21 +72,25 @@ view model =
Session.Player data -> Session.Player data ->
( True, data.player.id == 0 ) ( True, data.player.id == 0 )
in in
case model.mode of case ( model.chest, isPlayer && not isGroup ) of
View _ -> ( Chest.View _, True ) ->
if isPlayer && not isGroup then button
button [ class "button", onClick IntoGrab ] [ text "Demander" ] [ class "button"
, onClick
(GotChestMsg
(Chest.intoMode <|
Chest.IntoClaim (getClaimsFromSession model.session)
)
)
]
[ text "Demander" ]
else ( Chest.Claim _, True ) ->
text "" button [ class "button", onClick ConfirmGrab ] [ text "Valider" ]
Grab _ -> ( _, _ ) ->
if isPlayer && not isGroup then text ""
button [ class "button", onClick ConfirmGrab ] [ text "Valider" ] , [ Chest.view model.chest loot
else
text ""
, [ mapChest (\c -> Chest.view c loot) model.mode
|> Html.map (Internal << GotChestMsg) |> Html.map (Internal << GotChestMsg)
] ]
) )
@@ -107,34 +104,11 @@ type Msg
type InnerMsg type InnerMsg
= GotLoot Api.ToChest (HttpResult Loot) = GotLoot Api.ToChest (HttpResult Loot)
| GotChestMsg Chest.Msg | GotChestMsg Chest.Msg
| IntoGrab
| IntoView
| ConfirmGrab | ConfirmGrab
showClaims claims =
let
itemClaimed item =
List.any (\c -> c.loot_id == item.id) claims
in
Chest.show
(\item ->
[ p []
[ text <|
(if itemClaimed item then
"C"
else
""
)
++ item.name
]
]
)
refresh model = refresh model =
{ model | mode = View <| showClaims (getClaimsFromSession model.session) } update (Internal <| GotChestMsg (Chest.intoMode (Chest.IntoViewWithClaims (getClaimsFromSession model.session)))) model
update : Msg -> Model -> ( Model, Cmd Msg ) update : Msg -> Model -> ( Model, Cmd Msg )
@@ -144,13 +118,13 @@ update msg model =
( model, Cmd.none ) ( model, Cmd.none )
Internal ConfirmGrab -> Internal ConfirmGrab ->
case ( Session.user model.session, model.loot, model.mode ) of case ( Session.user model.session, model.loot, model.chest ) of
( Session.Player data, Loaded loot, Grab chest ) -> ( Session.Player data, Loaded loot, Chest.Claim _ ) ->
( model ( model
, Chest.confirmGrab , Chest.confirmGrab
data.player.id data.player.id
loot loot
chest model.chest
|> Cmd.map Api |> Cmd.map Api
) )
@@ -166,24 +140,9 @@ update msg model =
( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none ) ( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none )
GotChestMsg chestMsg -> GotChestMsg chestMsg ->
mapChest (Chest.update chestMsg) model.mode Chest.update chestMsg model.chest
|> updateChest model |> updateChest model
IntoGrab ->
let
claimedIds =
case Session.user model.session of
Player data ->
List.map .loot_id data.claims
Admin ->
[]
in
( { model | mode = Grab <| Chest.initSelection (Just claimedIds) }, Cmd.none )
IntoView ->
( refresh model, Cmd.none )
_ -> _ ->
( model, Cmd.none ) ( model, Cmd.none )
) )
@@ -191,11 +150,6 @@ update msg model =
updateChest model ( chestModel, chestCmd ) = updateChest model ( chestModel, chestCmd ) =
( case model.mode of ( { model | chest = chestModel }
View _ ->
{ model | mode = View chestModel }
Grab _ ->
{ model | mode = Grab chestModel }
, Cmd.map GotChestMsg chestCmd , Cmd.map GotChestMsg chestCmd
) )

2
src/Page/Shop.elm
View File

@@ -210,7 +210,7 @@ update msg model =
IntoBuy -> IntoBuy ->
case Session.user (getSession model) of case Session.user (getSession model) of
Session.Player _ -> Session.Player _ ->
( { model | chest = Buy <| Chest.initSelection Nothing }, Cmd.none ) ( { model | chest = Buy <| Chest.initSelection Nothing True }, Cmd.none )
_ -> _ ->
( model, Cmd.none ) ( model, Cmd.none )

34
src/Route.elm
View File

@@ -8,41 +8,19 @@ import Url.Parser as P exposing ((</>), Parser, oneOf, s)
-- ROUTES -- ROUTES
type ChestContent
= PlayerLoot
| MerchantLoot
| GroupLoot
| NewLoot
type Route type Route
= Home ChestContent = Home -- Either PlayerChest or Admin depending on Session
| About | About
| Merchant
| GroupChest
{-
We could flatten this :
type Route
= Home -- Either PlayerChest or Admin depending on Session
| About
| Merchant
| GroupChest
| NewLoot
-}
parser : P.Parser (Route -> a) a parser : P.Parser (Route -> a) a
parser = parser =
oneOf oneOf
[ P.map (Home PlayerLoot) P.top [ P.map Home P.top
, P.map (Home GroupLoot) (P.s "coffre") , P.map GroupChest (P.s "groupe")
, P.map (Home MerchantLoot) (P.s "marchand") , P.map Merchant (P.s "marchand")
, P.map (Home NewLoot) (P.s "nouveau-tresor")
, P.map About (P.s "about") , P.map About (P.s "about")
] ]

6
src/Wealth.elm
View File

@@ -15,11 +15,10 @@ init =
View View
view : Wealth -> Model -> List (Html Msg)
view wealth model = view wealth model =
div [ class "level-item" ] div [ class "level-item" ]
[ span [ class "icon is-large" ] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ] [ span [ class "icon is-large" ] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ] ]
, span [ class "icon", onClick StartEdit ] [ i [ class "fas fa-tools" ] [] ]
]
:: (case model of :: (case model of
View -> View ->
viewWealth wealth viewWealth wealth
@@ -27,6 +26,7 @@ view wealth model =
Edit amount -> Edit amount ->
viewUpdateWealth amount viewUpdateWealth amount
) )
++ [ span [ class "icon", onClick StartEdit ] [ i [ class "fas fa-tools" ] [] ] ]
viewUpdateWealth amount = viewUpdateWealth amount =