116 lines
4.0 KiB
Elm
116 lines
4.0 KiB
Elm
module Main exposing (Flags, Model, Msg, main, init, update, view)
|
|
|
|
import Browser exposing (Document, document)
|
|
import Browser.Events exposing (onAnimationFrameDelta) -- https://github.com/joakin/elm-canvas/blob/master/examples/Drawing.elm#L27
|
|
import Html exposing (Html, div, button, text)
|
|
import Html.Events exposing (onClick)
|
|
import Html.Attributes exposing (id, class)
|
|
import String exposing (String, join)
|
|
|
|
import Api
|
|
import DrawingBoard exposing (Point, Stroke, Msg(..), viewCanvas, addPendingPointToStrokes)
|
|
import ResultFiltering as Filtering exposing (FilterState, Filter, filterUpdate, initFilterState)
|
|
|
|
type alias Flags =
|
|
{ userAgent : String
|
|
}
|
|
|
|
main : Program Flags Model Msg
|
|
main =
|
|
document {
|
|
init = init
|
|
, update = update
|
|
, view = view
|
|
, subscriptions = subscriptions
|
|
}
|
|
|
|
type alias Model = {
|
|
pendingPoint : Maybe Point
|
|
, strokes : List Stroke
|
|
, kanji : List String
|
|
, filters : FilterState
|
|
, userAgent : String
|
|
}
|
|
|
|
type Msg = AnimationFrame Float
|
|
| StrokeUpdate DrawingBoard.Msg
|
|
| FilterUpdate Filtering.Msg
|
|
| ApiUpdate Api.Msg
|
|
| Clear
|
|
|
|
init : Flags -> ( Model, Cmd Msg )
|
|
init flags = (
|
|
{ pendingPoint = Nothing
|
|
, strokes = []
|
|
, filters = initFilterState
|
|
, kanji = []
|
|
, userAgent = flags.userAgent
|
|
}
|
|
, Cmd.none)
|
|
|
|
update : Msg -> Model -> (Model, Cmd Msg)
|
|
update msg model =
|
|
case msg of
|
|
AnimationFrame _ ->
|
|
(model, Cmd.map StrokeUpdate <| addPendingPointToStrokes model.pendingPoint)
|
|
|
|
StrokeUpdate EndStroke ->
|
|
update (ApiUpdate Api.SendRequest) {model | strokes = model.strokes, pendingPoint = Nothing}
|
|
|
|
StrokeUpdate subMsg ->
|
|
DrawingBoard.update subMsg model.strokes model.pendingPoint
|
|
|> updateWith (\(strokes, pendingPoint) m -> {m | strokes = strokes, pendingPoint = pendingPoint}) StrokeUpdate model
|
|
|
|
FilterUpdate subMsg ->
|
|
({model | filters = filterUpdate subMsg model.filters}, Cmd.none)
|
|
|
|
ApiUpdate subMsg ->
|
|
Api.update subMsg model.strokes model.userAgent
|
|
|> updateWith (\kanji m -> {m | kanji = kanji}) ApiUpdate model
|
|
|
|
Clear -> ({model | strokes = [], pendingPoint = Nothing, kanji = []}, Cmd.none)
|
|
|
|
{-| Update with methods to encapsulate the results into a new model and a new msg -}
|
|
updateWith : (subModel -> Model -> Model) -> (subMsg -> Msg) -> Model -> (subModel, Cmd subMsg) -> (Model, Cmd Msg)
|
|
updateWith toModel toMsg model (subModel, subCmd) = (toModel subModel model, Cmd.map toMsg subCmd)
|
|
|
|
{-| Helper function to determine class name based on filter -}
|
|
buttonColor : Filter -> String
|
|
buttonColor (state, _) = if state then "activatedButton" else "deactivatedButton"
|
|
|
|
{-| Helper function to generate a filter button -}
|
|
filterButton : String -> String -> Filter -> Filtering.Msg -> Html Msg
|
|
filterButton idText titleText filter filterMsg =
|
|
button [ id idText
|
|
, class <| buttonColor filter
|
|
, onClick <| FilterUpdate filterMsg
|
|
] [text titleText]
|
|
|
|
{-| Helper function to turn a list of kanji into a string -}
|
|
formatKanji : List String -> String
|
|
formatKanji kanji =
|
|
case kanji of
|
|
[] -> "None ¯\\_(ツ)_/¯"
|
|
_ -> join ", " kanji
|
|
|
|
view : Model -> Document Msg
|
|
view model =
|
|
{ title = "Google Handwriting Api"
|
|
, body = [
|
|
div []
|
|
[ (viewCanvas model.strokes |> (\subMsg -> Html.map StrokeUpdate subMsg))
|
|
, div [id "toggleButtons"]
|
|
[ filterButton "toggleKanji" "Kanji" model.filters.kanji Filtering.Kanji
|
|
, filterButton "toggleHiragana" "Hiragana" model.filters.hiragana Filtering.Hiragana
|
|
, filterButton "toggleKatakana" "Katakana" model.filters.katakana Filtering.Katakana
|
|
, filterButton "toggleAll" "All" model.filters.all Filtering.All
|
|
]
|
|
, div [id "response"] [text (formatKanji <| Filtering.postProcess model.kanji model.filters)]
|
|
, button [id "clear", onClick Clear] [text "Clear"]
|
|
]
|
|
]
|
|
}
|
|
|
|
subscriptions : Model -> Sub Msg
|
|
subscriptions _ =
|
|
onAnimationFrameDelta AnimationFrame |