Bot-Man-Toe/elm/Program.elm

301 lines
8.1 KiB
Elm

module Program exposing (Px, ViewBox, document, element)
import Browser
import Color
import Element exposing (Element)
import Element.Background
import Element.Events
import Element.Font
import Html
import Json.Decode as D
import Layout
import Pixels exposing (Pixels)
import Quantity exposing (Quantity)
import ScreenSize exposing (ScreenSize)
import Svg
import Svg.Attributes
import Theme
import Widget.Icon
type alias Model model =
{ content : model
, flavor : Theme.Flavor
, size : ScreenSize
}
type Msg msg
= OnContent msg
| OnFlavor Theme.Flavor
| OnScreenSize ScreenSize
type alias Px =
Quantity Int Pixels
type alias ViewBox model =
{ flavor : Theme.Flavor, model : model, size : ScreenSize }
element :
{ flagsDecoder : D.Decoder flags
, init : Result D.Error flags -> ( model, Cmd msg )
, subscriptions : model -> Sub msg
, update : msg -> model -> ( model, Cmd msg )
, view : ViewBox model -> Element msg
}
-> Program D.Value (Model model) (Msg msg)
element data =
Browser.element
{ init = init { f = data.init, d = data.flagsDecoder }
, subscriptions = subscriptions data.subscriptions
, update = update data.update
, view =
view
{ body = data.view
, headers = always []
}
}
document :
{ flagsDecoder : D.Decoder flags
, headers : model -> List { icon : Widget.Icon.Icon msg, onPress : msg }
, init : Result D.Error flags -> ( model, Cmd msg )
, subscriptions : model -> Sub msg
, title : model -> String
, update : msg -> model -> ( model, Cmd msg )
, view : ViewBox model -> Element msg
}
-> Program D.Value (Model model) (Msg msg)
document data =
Browser.document
{ init = init { f = data.init, d = data.flagsDecoder }
, subscriptions = subscriptions data.subscriptions
, update = update data.update
, view =
\model ->
{ title = data.title model.content
, body = [ view { body = data.view, headers = data.headers } model ]
}
}
-- INIT
init :
{ f : Result D.Error flags -> ( model, Cmd msg )
, d : D.Decoder flags
}
-> D.Value
-> ( Model model, Cmd (Msg msg) )
init data blob =
case data.f (D.decodeValue data.d blob) of
( mdl, msg ) ->
( { content = mdl
, flavor = Theme.Frappe
, size = ScreenSize.init
}
, Cmd.batch
[ Cmd.map OnContent msg
, ScreenSize.updateScreenSize OnScreenSize
]
)
-- UPDATE
update :
(msg -> model -> ( model, Cmd msg ))
-> Msg msg
-> Model model
-> ( Model model, Cmd (Msg msg) )
update f msg model =
case msg of
OnContent m ->
case f m model.content of
( newMdl, newMsg ) ->
( { model | content = newMdl }
, Cmd.map OnContent newMsg
)
OnFlavor flavor ->
( { model | flavor = flavor }, Cmd.none )
OnScreenSize size ->
( { model | size = size }, Cmd.none )
-- SUBSCRIPTIONS
subscriptions : (model -> Sub msg) -> Model model -> Sub (Msg msg)
subscriptions f model =
Sub.batch
[ Sub.map OnContent <| f model.content
, ScreenSize.onResize OnScreenSize
]
-- VIEW
view :
{ body : ViewBox model -> Element msg
, headers : model -> List { icon : Widget.Icon.Icon msg, onPress : msg }
}
-> Model model
-> Html.Html (Msg msg)
view data model =
let
preferredNavBarHeight =
Pixels.pixels 40
showNavBar =
preferredNavBarHeight
|> Quantity.multiplyBy 6
|> Quantity.lessThanOrEqualTo model.size.height
contentHeight =
if showNavBar then
model.size.height |> Quantity.minus preferredNavBarHeight
else
model.size.height
in
[ viewNavBar
{ headers = data.headers model.content
, iconHeight = preferredNavBarHeight
, model = model
}
, data.body
{ flavor = model.flavor
, model = model.content
, size = { height = contentHeight, width = model.size.width }
}
|> Element.map OnContent
]
|> Element.column [ Element.width Element.fill ]
|> Element.layout
[ Element.Background.color (Theme.baseUI model.flavor)
, Element.Font.color (Theme.textUI model.flavor)
, Element.width <| Element.px <| Pixels.inPixels model.size.width
]
viewFlavorPicker :
{ currentFlavor : Theme.Flavor
, flavorToPick : Theme.Flavor
, onClick : Theme.Flavor -> msg
, size : Px
}
-> Element msg
viewFlavorPicker data =
Layout.svg
{ aspectRatio = 1 / 1
, height = Pixels.inPixels data.size
, svg =
Svg.circle
[ Svg.Attributes.cx "5"
, Svg.Attributes.cy "5"
, Svg.Attributes.r "4"
, Svg.Attributes.strokeWidth "1"
, Svg.Attributes.fill (Color.toCssString <| Theme.base data.flavorToPick)
, Svg.Attributes.stroke (Color.toCssString <| Theme.crust data.currentFlavor)
]
[]
, viewMinY = 0
, viewMaxY = 10
, viewMinX = 0
, viewMaxX = 10
, width = Pixels.inPixels data.size
}
|> (if data.currentFlavor /= data.flavorToPick then
Element.el [ Element.Events.onClick (data.onClick data.flavorToPick) ]
else
identity
)
viewNavBar :
{ headers : List { icon : Widget.Icon.Icon msg, onPress : msg }
, iconHeight : Px
, model : Model model
}
-> Element (Msg msg)
viewNavBar data =
let
heightAttr =
Quantity.twice data.iconHeight
|> Pixels.inPixels
|> Element.px
|> Element.height
widthAttr =
Quantity.twice data.iconHeight
|> Pixels.inPixels
|> Element.px
|> Element.width
in
Element.row
[ Element.Background.color <| Theme.mantleUI data.model.flavor
, Element.width Element.fill
]
[ data.headers
|> List.map
(viewNavBarIcon
{ flavor = data.model.flavor
, height = Quantity.twice data.iconHeight
, heightIcon = data.iconHeight
}
)
|> Element.row []
, Element.el [ heightAttr, Element.width Element.fill ] Element.none
, [ Theme.Latte, Theme.Frappe, Theme.Macchiato, Theme.Mocha ]
|> List.map
(\flavor ->
viewFlavorPicker
{ currentFlavor = data.model.flavor
, flavorToPick = flavor
, onClick = OnFlavor
, size = data.iconHeight
}
|> Element.el [ Element.centerX, Element.centerY ]
|> Element.el [ heightAttr, widthAttr ]
)
|> Element.row []
]
viewNavBarIcon :
{ flavor : Theme.Flavor
, height : Px
, heightIcon : Px
}
-> { icon : Widget.Icon.Icon msg, onPress : msg }
-> Element (Msg msg)
viewNavBarIcon { flavor, height, heightIcon } { icon, onPress } =
-- TODO: Implement coloring for hover + onclick
icon { color = Theme.text flavor, size = Pixels.inPixels heightIcon }
|> Element.el
[ Element.centerX
, Element.centerY
, Element.height <| Element.px <| Pixels.inPixels heightIcon
, Element.width <| Element.px <| Pixels.inPixels heightIcon
]
|> Element.el
[ Element.Events.onClick onPress
, Element.height <| Element.px <| Pixels.inPixels height
, Element.width <| Element.px <| Pixels.inPixels height
]
|> Element.map OnContent