550 lines
16 KiB
Elm
550 lines
16 KiB
Elm
module Main exposing (..)
|
|
|
|
import Browser
|
|
import Browser.Navigation as Nav
|
|
import Platform.Cmd exposing (Cmd)
|
|
import Url
|
|
import Html exposing (..)
|
|
import Html.Attributes exposing (..)
|
|
import Html.Events exposing (..)
|
|
import Svg.Attributes
|
|
import Http
|
|
import Json.Decode exposing (Decoder, field, list, string, int)
|
|
import Url.Parser as P exposing (Parser, (</>), oneOf, s)
|
|
import Set exposing (Set)
|
|
-- Main
|
|
|
|
main : Program () Model Msg
|
|
main =
|
|
Browser.application
|
|
{ init = init
|
|
, view = view
|
|
, update = update
|
|
, subscriptions = subscriptions
|
|
, onUrlChange = UrlChanged
|
|
, onUrlRequest = LinkClicked
|
|
}
|
|
|
|
-- Model
|
|
|
|
type alias Selection = Set Int
|
|
|
|
emptySelection = []
|
|
|
|
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
|
|
, loot: Maybe Loot
|
|
, groupLoot : Maybe Loot
|
|
, merchantItems : Maybe Loot
|
|
}
|
|
|
|
init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
|
|
init flags url key =
|
|
let
|
|
route = case P.parse routeParser url of
|
|
Just r -> r
|
|
Nothing -> PlayerChest
|
|
in
|
|
( Model (State key route "" False Nothing Nothing) blankPlayer Nothing Nothing Nothing, fetchInitialData 0)
|
|
|
|
|
|
fetchInitialData : Int -> Cmd Msg
|
|
fetchInitialData playerId =
|
|
Cmd.batch [ initPlayer playerId
|
|
, fetchShopInventory
|
|
, fetchGroupLoot
|
|
]
|
|
-- PLAYER
|
|
--
|
|
type alias Player =
|
|
{ id: Int
|
|
, name: String
|
|
, debt: Int
|
|
, wealth: Wealth
|
|
}
|
|
|
|
blankPlayer =
|
|
Player 0 "Loading" 0 (Wealth 0 0 0 0)
|
|
|
|
initPlayer id =
|
|
Cmd.batch [fetchPlayer id, fetchLoot id]
|
|
|
|
fetchPlayer : Int -> Cmd Msg
|
|
fetchPlayer id =
|
|
Http.get
|
|
{ url = "http://localhost:8088/api/players/" ++ (String.fromInt id) ++ "/"
|
|
, expect = Http.expectJson GotPlayer (valueDecoder playerDecoder )
|
|
}
|
|
|
|
playerDecoder : Decoder Player
|
|
playerDecoder =
|
|
Json.Decode.map4 Player
|
|
(field "id" int)
|
|
(field "name" string)
|
|
(field "debt" int)
|
|
wealthDecoder
|
|
|
|
type alias Wealth =
|
|
{ cp: Int
|
|
, sp: Int
|
|
, gp: Int
|
|
, pp: Int
|
|
}
|
|
|
|
wealthDecoder : Decoder Wealth
|
|
wealthDecoder =
|
|
Json.Decode.map4 Wealth
|
|
(field "cp" int)
|
|
(field "sp" int)
|
|
(field "gp" int)
|
|
(field "pp" int)
|
|
|
|
type alias Item =
|
|
{ id: Int
|
|
, name: String
|
|
, base_price: Int
|
|
}
|
|
|
|
itemDecoder =
|
|
Json.Decode.map3 Item
|
|
(field "id" int)
|
|
(field "name" string)
|
|
(field "base_price" int)
|
|
|
|
type alias Loot =
|
|
List Item
|
|
|
|
lootDecoder : Decoder Loot
|
|
lootDecoder =
|
|
Json.Decode.list itemDecoder
|
|
|
|
fetchLoot id =
|
|
Http.get
|
|
{ url = "http://localhost:8088/api/players/" ++ (String.fromInt id) ++ "/loot"
|
|
, expect = Http.expectJson (GotLoot OfPlayer) (valueDecoder lootDecoder)}
|
|
|
|
fetchShopInventory =
|
|
Http.get
|
|
{ url = "http://localhost:8088/api/items"
|
|
, expect = Http.expectJson (GotLoot OfShop) (valueDecoder lootDecoder)}
|
|
|
|
fetchGroupLoot =
|
|
Http.get
|
|
{ url = "http://localhost:8088/api/players/0/loot"
|
|
, expect = Http.expectJson (GotLoot OfGroup) (valueDecoder lootDecoder)}
|
|
|
|
type ToChest
|
|
= OfPlayer
|
|
| OfGroup
|
|
| OfShop
|
|
-- API Response
|
|
--
|
|
valueDecoder : Decoder a -> Decoder a
|
|
valueDecoder thenDecoder =
|
|
field "value" thenDecoder
|
|
|
|
-- UPDATE
|
|
|
|
type Msg
|
|
= LinkClicked Browser.UrlRequest
|
|
| UrlChanged Url.Url
|
|
| PlayerChanged Int
|
|
| GotPlayer (Result Http.Error Player)
|
|
| GotLoot ToChest (Result Http.Error Loot)
|
|
| LootViewItemSwitched Int
|
|
| ModeSwitched (Maybe ViewMode)
|
|
|
|
update : Msg -> Model -> ( Model, Cmd Msg )
|
|
update msg model =
|
|
case msg of
|
|
LinkClicked urlRequest ->
|
|
case urlRequest of
|
|
Browser.Internal url ->
|
|
( model, Nav.pushUrl model.state.navKey (Url.toString url) )
|
|
--( model, Cmd.none )
|
|
|
|
Browser.External href ->
|
|
( setError ("Invalid request '" ++ href ++ "'") model
|
|
, Cmd.none )
|
|
|
|
UrlChanged url ->
|
|
let
|
|
route = P.parse routeParser url
|
|
state = model.state
|
|
in
|
|
case route of
|
|
Just page ->
|
|
{ model | state = { state | route = page }}
|
|
|> update (case page of
|
|
-- Directly enter add mode on NewLoot view
|
|
NewLoot -> ModeSwitched (Just Add)
|
|
other -> ModeSwitched Nothing
|
|
)
|
|
|
|
Nothing ->
|
|
( setError "Invalid route" model, Cmd.none )
|
|
|
|
PlayerChanged newId ->
|
|
( { model | player = blankPlayer }, initPlayer newId )
|
|
|
|
GotPlayer result ->
|
|
case result of
|
|
Ok player ->
|
|
( { model | player = player }
|
|
, Cmd.none
|
|
)
|
|
Err error ->
|
|
( setError ("Fetching player... " ++ printError error) model
|
|
, Cmd.none
|
|
)
|
|
|
|
GotLoot dest result ->
|
|
case result of
|
|
Ok loot ->
|
|
( case dest of
|
|
OfPlayer -> { model | loot = Just loot}
|
|
OfGroup -> { model | groupLoot = Just loot}
|
|
OfShop -> { model | merchantItems = Just loot}
|
|
, Cmd.none
|
|
)
|
|
Err error ->
|
|
( setError ("Fetching loot... " ++ printError error) 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
|
|
|
|
(nextMode, cmd) =
|
|
case newMode of
|
|
Nothing -> -- Cancel action
|
|
(Nothing, Cmd.none)
|
|
new ->
|
|
case new of
|
|
Just Confirm ->
|
|
-- Confirm action and exit
|
|
(Nothing, Cmd.none)
|
|
other ->
|
|
-- Enter mode
|
|
(new, Cmd.none)
|
|
|
|
in
|
|
( { model | state =
|
|
{ state | activeMode = nextMode
|
|
, selection = case nextMode of
|
|
Nothing -> Nothing
|
|
Just _ -> Just Set.empty
|
|
}}
|
|
, cmd)
|
|
|
|
-- ERRORS
|
|
|
|
setError : String -> Model -> Model
|
|
setError error model =
|
|
let
|
|
state = model.state
|
|
in
|
|
{ model | state =
|
|
{ state | error = error }}
|
|
|
|
|
|
printError : Http.Error -> String
|
|
printError error =
|
|
case error of
|
|
Http.NetworkError -> "Le serveur ne répond pas"
|
|
_ -> "Erreur inconnue"
|
|
|
|
-- 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
|
|
subscriptions _ =
|
|
Sub.none
|
|
|
|
|
|
---
|
|
-- VIEWS
|
|
---
|
|
|
|
type ViewMode
|
|
= Sell
|
|
| Buy
|
|
| Grab
|
|
| Add
|
|
| Confirm -- Confirm action and exit mode
|
|
|
|
actionButton mode t icon color =
|
|
button [ class <| "button is-rounded is-" ++ color
|
|
, onClick (ModeSwitched mode) ]
|
|
[ span [ class "icon" ] [ i [ Svg.Attributes.class <| "fas fa-" ++ icon ] [] ]
|
|
]
|
|
|
|
view : Model -> Browser.Document Msg
|
|
view model =
|
|
let
|
|
(header, shownLoot) =
|
|
case model.state.route of
|
|
PlayerChest ->
|
|
("Mon coffre", Maybe.withDefault [] model.loot)
|
|
GroupLoot ->
|
|
("Coffre de groupe", Maybe.withDefault [] model.groupLoot)
|
|
Merchant ->
|
|
("Marchand", Maybe.withDefault [] model.merchantItems)
|
|
NewLoot ->
|
|
("Nouveau trésor :)", [] )
|
|
actionControls =
|
|
case model.state.activeMode of
|
|
Just mode -> -- When a mode is active
|
|
[ div [class "buttons"]
|
|
[actionButton (Just Confirm) "Valider" "plus" "primary"
|
|
, actionButton Nothing "Annuler" "coins" "danger"]
|
|
]
|
|
Nothing -> -- Buttons to enter mode
|
|
case model.state.route of
|
|
PlayerChest -> [actionButton (Just Sell) "" "coins" "danger"]
|
|
GroupLoot -> [actionButton (Just Grab) "Demander" "coins" "primary"]
|
|
Merchant -> [actionButton (Just Buy) "" "coins" "success"]
|
|
NewLoot -> []
|
|
|
|
in
|
|
{ title = "Loot-a-lot in ELM"
|
|
, body =
|
|
[ viewHeaderBar model
|
|
, viewPlayerBar model.player actionControls
|
|
, article [class "section container"]
|
|
[ p [class "heading"] [text header]
|
|
, viewSearchBar
|
|
, viewLoot shownLoot model.state.selection model.state.activeMode
|
|
]
|
|
, hr [] []
|
|
, section [class "container"] [viewDebugSection model]
|
|
]
|
|
}
|
|
|
|
-- LOOT Views
|
|
|
|
isSelected id selection =
|
|
Set.member id selection
|
|
|
|
viewLoot : Loot -> Maybe Selection -> Maybe ViewMode -> Html Msg
|
|
viewLoot items selection activeMode =
|
|
table [ class "table is-fullwidth is-striped is-light"]
|
|
([ thead [class "table-header"]
|
|
[ th [] [text "Nom"] ]
|
|
]
|
|
++ List.map (viewItemTableRow selection activeMode) items
|
|
)
|
|
|
|
controlsRenderer : ViewMode -> Item -> Html Msg
|
|
controlsRenderer 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 !" ]
|
|
Confirm -> text ""
|
|
|
|
viewItemTableRow : Maybe Selection -> Maybe ViewMode -> Item -> Html Msg
|
|
viewItemTableRow selection activeMode item =
|
|
let
|
|
selected =
|
|
case selection of
|
|
Just s ->
|
|
isSelected item.id s
|
|
Nothing ->
|
|
False
|
|
|
|
levelRight =
|
|
case activeMode of
|
|
Nothing -> []
|
|
Just mode -> List.singleton (
|
|
div [ class "level-right" ]
|
|
[ controlsRenderer mode item
|
|
, input [ class "checkbox level-item"
|
|
, type_ "checkbox"
|
|
, onCheck (\v -> LootViewItemSwitched item.id)
|
|
] []
|
|
])
|
|
in
|
|
tr [ classList [ ("is-selected", selected) ] ]
|
|
[ td []
|
|
[ label [ class "level checkbox" ]
|
|
(List.concat [[
|
|
div [ class "level-left" ]
|
|
[ p [class "level-item"] [ text item.name ]]
|
|
]
|
|
, levelRight
|
|
])
|
|
]
|
|
]
|
|
|
|
-- DEBUG SECTION
|
|
|
|
viewDebugSection : Model -> Html Msg
|
|
viewDebugSection model =
|
|
div [class "panel is-danger"]
|
|
[ p [class "panel-heading"] [text "Debug"]
|
|
, debugSwitchPlayers
|
|
, 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 [] debugSandbox
|
|
]
|
|
|
|
stackedIcon name =
|
|
span [class "icon is-large has-text-dark"]
|
|
[ span [ class "fa-stack" ]
|
|
[ i [ class "fas fa-circle fa-stack-2x" ] []
|
|
, i [ class (name ++ " fa-inverse fa-stack-1x") ] []
|
|
, text name ]
|
|
]
|
|
|
|
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"
|
|
]
|
|
|
|
debugSwitchPlayers : Html Msg
|
|
debugSwitchPlayers =
|
|
div [ class "panel-tabs" ]
|
|
[ a [ onClick (PlayerChanged 0) ] [text "Groupe"]
|
|
, a [ onClick (PlayerChanged 1) ] [text "Lomion"]
|
|
, a [ onClick (PlayerChanged 2) ] [text "Fefi"]
|
|
]
|
|
|
|
-- HEADER SECTION
|
|
|
|
viewHeaderBar : Model -> Html Msg
|
|
viewHeaderBar model =
|
|
nav [ class "navbar container", class "is-info" ]
|
|
[ div [ class "navbar-brand" ]
|
|
[ a [ class "navbar-item", href "/"]
|
|
[ text model.player.name ]
|
|
, 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"] [text "Marchand"]
|
|
, a
|
|
[ class "navbar-item"
|
|
, href (if model.player.id == 0
|
|
then
|
|
"/nouveau-tresor"
|
|
else
|
|
"/coffre")
|
|
]
|
|
[text (if model.player.id == 0 then "Nouveau loot" else "Coffre de groupe")]
|
|
]
|
|
]
|
|
|
|
]
|
|
|
|
-- PLAYER BAR
|
|
|
|
viewPlayerBar : 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" ] [] ]]
|
|
]
|
|
++ (showWealth 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
|
|
]
|
|
|
|
|
|
showWealth : Wealth -> List (Html Msg)
|
|
showWealth wealth =
|
|
[ showWealthField "pp" wealth.pp
|
|
, showWealthField "gp" wealth.gp
|
|
, showWealthField "sp" wealth.sp
|
|
, showWealthField "cp" wealth.cp
|
|
]
|
|
|
|
showWealthField : String -> Int -> Html Msg
|
|
showWealthField name value =
|
|
div [ class "level-item" ]
|
|
[ p [ class "is-size-4"] [text (String.fromInt value)]
|
|
, p [class "heading"] [text name]
|
|
]
|
|
|
|
-- Search Bar
|
|
|
|
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")
|
|
]
|
|
|