extracts Chest module, pulling out Route and Utils
This commit is contained in:
184
src/Main.elm
184
src/Main.elm
@@ -7,13 +7,15 @@ import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
import Svg.Attributes
|
||||
import Url.Parser as P exposing (Parser, (</>), oneOf, s)
|
||||
import Set exposing (Set)
|
||||
import Json.Encode as E
|
||||
|
||||
import Api exposing (Player, Loot, Wealth, Item, Claim, Claims)
|
||||
import Modes exposing (ViewMode)
|
||||
|
||||
import Route exposing (..)
|
||||
import Chest
|
||||
import Chest exposing (Msg)
|
||||
import Utils exposing (..)
|
||||
-- Main
|
||||
|
||||
main : Program () Model Msg
|
||||
@@ -29,20 +31,19 @@ main =
|
||||
|
||||
-- Model
|
||||
|
||||
type alias Selection = Set Int
|
||||
|
||||
type alias State =
|
||||
{ navKey : Nav.Key
|
||||
, route : Route
|
||||
, error : String
|
||||
, menuOpen : Bool
|
||||
, selection : Maybe Selection
|
||||
, activeMode : Maybe ViewMode
|
||||
}
|
||||
|
||||
type alias Model =
|
||||
{ state : State
|
||||
, player: Player
|
||||
, chest : Chest.Model
|
||||
, claims : Claims
|
||||
, notification : Maybe String
|
||||
, loot: Maybe Loot
|
||||
@@ -53,13 +54,14 @@ type alias Model =
|
||||
init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
|
||||
init flags url key =
|
||||
let
|
||||
route = case P.parse routeParser url of
|
||||
route = case routeParser url of
|
||||
Just r -> r
|
||||
Nothing -> PlayerChest
|
||||
in
|
||||
( Model
|
||||
(State key route "" False Nothing Nothing)
|
||||
(State key route "" False Nothing)
|
||||
Api.blankPlayer
|
||||
Chest.init
|
||||
[]
|
||||
Nothing
|
||||
Nothing
|
||||
@@ -89,8 +91,8 @@ type Msg
|
||||
= LinkClicked Browser.UrlRequest
|
||||
| UrlChanged Url.Url
|
||||
| ApiMsg Api.Msg
|
||||
| ChestMsg Chest.Msg
|
||||
| PlayerChanged Int
|
||||
| LootViewItemSwitched Int
|
||||
| ModeSwitched (Maybe ViewMode)
|
||||
| ConfirmAction
|
||||
| UndoLastAction
|
||||
@@ -110,7 +112,7 @@ update msg model =
|
||||
|
||||
UrlChanged url ->
|
||||
let
|
||||
route = P.parse routeParser url
|
||||
route = routeParser url
|
||||
state = model.state
|
||||
in
|
||||
case route of
|
||||
@@ -128,6 +130,12 @@ update msg model =
|
||||
PlayerChanged newId ->
|
||||
( { model | player = Api.blankPlayer }, initPlayer newId )
|
||||
|
||||
ChestMsg chestMsg ->
|
||||
let
|
||||
(chest, _) = Chest.update chestMsg model.chest
|
||||
in
|
||||
( { model | chest = chest }, Cmd.none )
|
||||
|
||||
ApiMsg apiMsg -> case apiMsg of
|
||||
Api.GotActionResult response ->
|
||||
case response of
|
||||
@@ -173,32 +181,28 @@ update msg model =
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
LootViewItemSwitched id ->
|
||||
let
|
||||
state = model.state
|
||||
in
|
||||
( { model | state =
|
||||
{ state | selection = Debug.log "new selection"
|
||||
<| switchSelectionState id state.selection }}
|
||||
, Cmd.none )
|
||||
|
||||
ModeSwitched newMode ->
|
||||
let
|
||||
state = model.state
|
||||
in
|
||||
( { model | state =
|
||||
{ state | activeMode = newMode
|
||||
, selection =
|
||||
case newMode of
|
||||
Nothing ->
|
||||
Nothing
|
||||
{ state | activeMode = newMode }
|
||||
, chest =
|
||||
let
|
||||
(newChest, _) = Chest.update (Chest.SetSelection
|
||||
(case newMode of
|
||||
Nothing ->
|
||||
Nothing
|
||||
|
||||
Just Modes.Grab -> -- Currently claimed object are initially selected
|
||||
Just ( Set.fromList <| List.map (\c -> c.loot_id) model.claims)
|
||||
Just Modes.Grab -> -- Currently claimed object are initially selected
|
||||
Just ( Set.fromList <| List.map (\c -> c.loot_id) model.claims)
|
||||
|
||||
Just others ->
|
||||
Just Set.empty
|
||||
}}
|
||||
Just others ->
|
||||
Just Set.empty
|
||||
))
|
||||
model.chest
|
||||
in newChest
|
||||
}
|
||||
, Cmd.none )
|
||||
|
||||
ConfirmAction ->
|
||||
@@ -208,7 +212,7 @@ update msg model =
|
||||
|
||||
Just mode ->
|
||||
let items = targetItemsFor mode model
|
||||
|> List.filter (itemInSelection model.state.selection)
|
||||
|> List.filter (Chest.itemInSelection model.chest.selection)
|
||||
in
|
||||
( model
|
||||
, Cmd.map ApiMsg
|
||||
@@ -274,15 +278,6 @@ setError error model =
|
||||
|
||||
-- STATE Utils
|
||||
|
||||
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
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
--
|
||||
subscriptions : Model -> Sub Msg
|
||||
@@ -335,33 +330,28 @@ view model =
|
||||
Header controls are inserted in the PlayerBar
|
||||
and rowControls to the right side of every item rows
|
||||
-}
|
||||
(headerControls, rowControls) =
|
||||
headerControls =
|
||||
case model.state.activeMode of
|
||||
Just mode ->
|
||||
( controlsWhenModeActive mode, Just (rowControlsForMode mode isSelected))
|
||||
Just mode -> controlsWhenModeActive mode
|
||||
Nothing -> -- Buttons to enter mode
|
||||
( actionButton UndoLastAction "Annuler action" "backspace" "danger"
|
||||
:: controlsWhenRoute model.state.route
|
||||
-- Claim controls for Group chest
|
||||
, case model.state.route of
|
||||
GroupLoot -> Just (renderIfClaimed <| itemInClaims model.claims)
|
||||
_ -> Nothing
|
||||
)
|
||||
|
||||
-- TODO: should we extract the Maybe conversion
|
||||
-- and represent cannotSelect with Nothing ??
|
||||
isSelected =
|
||||
itemInSelection model.state.selection
|
||||
actionButton UndoLastAction "Annuler action" "backspace" "danger"
|
||||
:: controlsWhenRoute model.state.route
|
||||
in
|
||||
{ title = "Loot-a-lot in ELM"
|
||||
, body =
|
||||
[ viewHeaderBar model
|
||||
, viewPlayerBar model.player model.notification headerControls
|
||||
, article [class "section container"]
|
||||
[ p [class "heading"] [text header]
|
||||
, viewSearchBar
|
||||
, viewChest isSelected rowControls shownLoot
|
||||
]
|
||||
, article
|
||||
[ class "section container" ]
|
||||
[ viewNotification model.notification
|
||||
, p [class "heading"] [text header]
|
||||
, viewSearchBar
|
||||
, Chest.view
|
||||
model.state.activeMode
|
||||
model.state.route
|
||||
model.chest
|
||||
|> Html.map ChestMsg
|
||||
]
|
||||
, hr [] []
|
||||
, section [class "container"] [viewDebugSection model]
|
||||
]
|
||||
@@ -377,64 +367,10 @@ viewNotification notification =
|
||||
|
||||
-- LOOT Views
|
||||
|
||||
itemInSelection : Maybe Selection -> Item -> Bool
|
||||
itemInSelection selection item =
|
||||
Maybe.map (Set.member item.id) selection
|
||||
|> Maybe.withDefault False
|
||||
|
||||
itemInClaims : List Claim -> Item -> Bool
|
||||
itemInClaims claims item =
|
||||
List.any (\c -> c.loot_id == item.id) claims
|
||||
|
||||
renderIfClaimed : (Item -> Bool) -> Item -> Html Msg
|
||||
renderIfClaimed isClaimed item =
|
||||
case isClaimed item of
|
||||
True -> renderIcon "fas fa-praying-hands" "1x"
|
||||
False -> text ""
|
||||
|
||||
viewChest : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Loot -> Html Msg
|
||||
viewChest isSelected rowControls items =
|
||||
table [ class "table is-fullwidth is-hoverable"]
|
||||
[ thead [ class "table-header" ]
|
||||
[ th [] [ text "Nom" ] ]
|
||||
, tbody [] <| List.map (viewItemTableRow isSelected rowControls) items
|
||||
]
|
||||
|
||||
-- Renders controls for a specific mode
|
||||
rowControlsForMode : ViewMode -> (Item -> Bool) -> Item -> Html Msg
|
||||
rowControlsForMode mode isSelected item =
|
||||
let
|
||||
itemInfo = case mode of
|
||||
Modes.Buy -> p [class "level-item"] [ text (String.fromInt item.base_price ++ "po")]
|
||||
Modes.Sell -> p [class "level-item"] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po")]
|
||||
Modes.Grab -> p [class "level-item"] [ text "Grab" ]
|
||||
Modes.Add -> p [class "level-item"] [ text "New !" ]
|
||||
in
|
||||
div [ class "level-right" ]
|
||||
<| itemInfo
|
||||
:: if Modes.canSelectIn mode then
|
||||
[input [ class "checkbox level-item"
|
||||
, type_ "checkbox"
|
||||
, checked <| isSelected item
|
||||
, onCheck (\v -> LootViewItemSwitched item.id)
|
||||
] [] ]
|
||||
else
|
||||
[]
|
||||
|
||||
|
||||
viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg
|
||||
viewItemTableRow isSelected rowControls item =
|
||||
tr [ classList [ ("is-selected", isSelected item) ] ]
|
||||
[ td []
|
||||
[ label [ class "level checkbox" ]
|
||||
<| div [ class "level-left" ]
|
||||
[ p [class "level-item"] [ text item.name ]]
|
||||
:: case rowControls of
|
||||
Just render -> List.singleton (render item)
|
||||
Nothing -> []
|
||||
]
|
||||
]
|
||||
|
||||
-- DEBUG SECTION
|
||||
|
||||
viewDebugSection : Model -> Html Msg
|
||||
@@ -445,7 +381,7 @@ viewDebugSection model =
|
||||
, p [class "panel-block has-text-danger"] [text model.state.error]
|
||||
, p [class "panel-block"] [text ("Route : " ++ Debug.toString model.state.route)]
|
||||
, p [class "panel-block"] [text ("Active Mode : " ++ Debug.toString model.state.activeMode)]
|
||||
, p [class "panel-block"] [text ("Selection : " ++ Debug.toString model.state.selection)]
|
||||
, p [class "panel-block"] [text ("Selection : " ++ Debug.toString model.chest.selection)]
|
||||
, p [class "panel-block"] [text ("Claims : " ++ Debug.toString model.claims)]
|
||||
, p [] debugSandbox
|
||||
]
|
||||
@@ -483,10 +419,6 @@ debugSwitchPlayers =
|
||||
]
|
||||
|
||||
|
||||
renderIcon name size =
|
||||
span [ class <| "icon is-medium"]
|
||||
[ i [ class <| name ++ " fa-" ++ size] [] ]
|
||||
|
||||
|
||||
-- HEADER SECTION
|
||||
|
||||
@@ -572,23 +504,3 @@ showWealthField name value =
|
||||
viewSearchBar : Html Msg
|
||||
viewSearchBar =
|
||||
input [class "input"] []
|
||||
|
||||
---
|
||||
-- ROUTES
|
||||
---
|
||||
|
||||
type Route
|
||||
= PlayerChest
|
||||
| Merchant
|
||||
| GroupLoot
|
||||
| NewLoot
|
||||
|
||||
routeParser : Parser (Route -> a) a
|
||||
routeParser =
|
||||
oneOf
|
||||
[ P.map GroupLoot (P.s "coffre")
|
||||
, P.map PlayerChest P.top
|
||||
, P.map Merchant (P.s "marchand")
|
||||
, P.map NewLoot (P.s "nouveau-tresor")
|
||||
]
|
||||
|
||||
|
||||
Reference in New Issue
Block a user