oysteikt/google-handwriting-api-elm
oysteikt
/
google-handwriting-api-elm
1
0
Fork 0
Code Issues Pull Requests Activity

Initial commit

This commit is contained in:
Oystein Kristoffer Tveit 2021-10-11 22:32:48 +02:00
commit f6f53d565c
9 changed files with 577 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitignore vendored Normal file
View File

@ -0,0 +1,5 @@
elm-stuff
node_modules
dist/app.js
yarn.lock
package-lock.json

4
Makefile Normal file
View File

@ -0,0 +1,4 @@
default: app.js
app.js: src
elm make src/Main.elm --output=dist/app.js

20
dist/app.html vendored Normal file
View File

@ -0,0 +1,20 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="UTF-8">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
<title>Test</title>
<link rel="stylesheet" href="style.css">
<script src="app.js"></script>
</head>
<body>
<script src="https://unpkg.com/elm-canvas/elm-canvas.js"></script>
<script>
var app = Elm.Main.init({
flags: {
userAgent: navigator.userAgent
}
});
</script>
</body>
</html>

86
dist/style.css vendored Normal file
View File

@ -0,0 +1,86 @@
body {
text-align: center;
}
#canvas * {
border: solid black 2px;
border-radius: 10px;
background-color: wheat;
margin: 2em;
}
#toggleButtons {
margin-bottom: 2em;
}
#toggleButtons * {
padding: 0.2em 0.4em;
margin: 0em 0.2em;
border-radius: 10px;
color: white;
font-size: 2em;
}
#response {
font-size: 2em;
margin-bottom: 1em;
}
#clear {
font-size: 1.4em;
padding: 0.5em 1em;
border-radius: 10px;
color: white;
background-color: #222222;
}
#clear:hover {
background-color: #464646;
}
.activatedButton {
background-color: #4d9e2a;
}
.activatedButton:hover {
background-color: #2d5e19;
}
.deactivatedButton {
background-color: #fa2b2b;
}
.deactivatedButton:hover {
background-color: #a11d1d;
}
@media screen and (max-width: 600px) {
body {
margin: 0;
}
#canvas {
border: solid black 2px;
border-radius: 10px;
background-color: wheat;
margin: 1em 0;
width: 80%;
}
#toggleButtons {
margin-bottom: 1em;
}
#toggleButtons * {
font-size: 1em;
}
#response {
font-size: 1em;
margin-bottom: 0.5em;
}
#clear{
font-size: 0.7em;
}
}

31
elm.json Normal file
View File

@ -0,0 +1,31 @@
{
"type": "application",
"source-directories": [
"src"
],
"elm-version": "0.19.1",
"dependencies": {
"direct": {
"avh4/elm-color": "1.0.0",
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/html": "1.0.0",
"elm/http": "2.0.0",
"elm/json": "1.1.3",
"elm/regex": "1.0.0",
"elm/time": "1.0.0",
"joakin/elm-canvas": "4.2.1",
"mpizenberg/elm-pointer-events": "4.0.2"
},
"indirect": {
"elm/bytes": "1.0.8",
"elm/file": "1.0.5",
"elm/url": "1.0.0",
"elm/virtual-dom": "1.0.2"
}
},
"test-dependencies": {
"direct": {},
"indirect": {}
}
}

130
src/Api.elm Normal file
View File

@ -0,0 +1,130 @@
module Api exposing (Msg(..), update)
import Http exposing (expectJson)
import List exposing (map)
import Json.Decode as D exposing (Value)
import Json.Encode as E
import DrawingBoard exposing (Stroke)
api : String
api = "https://inputtools.google.com/request?itc=ja-t-i0-handwrit&app=translate"
type alias APIRequest = {
app_version : Float
, api_level : String
, device : String
, input_type : Int
, options : String
, requests : List Request
}
apiRequestEncoder : APIRequest -> Value
apiRequestEncoder request =
E.object
[ ("app_version", E.float request.app_version)
, ("api_level", E.string request.api_level)
, ("device", E.string request.device)
, ("input_type", E.int request.input_type)
, ("options", E.string request.options)
, ("requests", E.list requestEncoder request.requests)
]
type alias Request = {
writing_guide: WritingGuide
, pre_context: String
, max_num_results: Int
, max_completions: Int
, language: String
, ink: List RealStroke
}
strokeEncoder : RealStroke -> Value
strokeEncoder = E.list(E.list(E.float))
requestEncoder : Request -> Value
requestEncoder request =
E.object
[ ("writing_guide", writingGuideEncoder request.writing_guide)
, ("pre_context", E.string request.pre_context)
, ("max_num_results", E.int request.max_num_results)
, ("max_completions", E.int request.max_completions)
, ("language", E.string request.language)
, ("ink", E.list strokeEncoder request.ink)
]
type alias WritingGuide = {
writing_area_width: Int
, writing_area_height: Int
}
writingGuideEncoder : WritingGuide -> Value
writingGuideEncoder writingGuide=
E.object
[ ("writing_area_width", E.int writingGuide.writing_area_width)
, ("writing_area_height", E.int writingGuide.writing_area_height)
]
type Msg = SendRequest
| GotResponse (Result Http.Error (List String))
update : Msg -> List Stroke -> String -> (List String, Cmd Msg)
update msg strokes userAgent =
case msg of
SendRequest -> ([], sendKanjiRequest strokes userAgent)
GotResponse result ->
case result of
Ok kanji -> Debug.log "OK: " (kanji, Cmd.none)
Err e -> Tuple.second (Debug.log "ERR: " e, ([], Cmd.none))
kanjiDecoder : D.Decoder (List String)
kanjiDecoder = D.index 1
<| D.index 0
<| D.index 1
<| D.list
<| D.oneOf [D.string]
sendKanjiRequest : List Stroke -> String -> Cmd Msg
sendKanjiRequest strokes userAgent = Http.post
{ body = generateRequestData strokes userAgent
|> apiRequestEncoder
|> Http.jsonBody
, expect = expectJson GotResponse kanjiDecoder
, url = api
}
type alias RealStroke = List (List Float)
convertStrokeToRealStroke : Stroke -> RealStroke
convertStrokeToRealStroke stroke = [ stroke.xs
, stroke.ys
, (map (\t -> t - stroke.startTime) stroke.times)
]
mockWritingGuide : WritingGuide
mockWritingGuide =
{ writing_area_width = 500
, writing_area_height = 500
}
max_results : Int
max_results = 10
generateRequestData : List Stroke -> String -> APIRequest
generateRequestData strokes userAgent =
{ app_version = 0.4
, api_level = "537.36"
, device = userAgent
, input_type = 0
, options = "enable_pre_space"
, requests =
[
{ writing_guide = mockWritingGuide
, pre_context = ""
, max_num_results = max_results
, max_completions = 0
, language = "ja"
, ink = (map convertStrokeToRealStroke strokes)
}
]
}

119
src/DrawingBoard.elm Normal file
View File

@ -0,0 +1,119 @@
module DrawingBoard exposing (Point, Stroke, Msg(..), update, viewCanvas, addPendingPointToStrokes)
import Html exposing (Html)
import Html.Attributes exposing (id)
import Html.Events.Extra.Mouse as Mouse
import Canvas exposing (..)
import Canvas.Settings as CS
import Canvas.Settings.Line as CS
import Color
import List exposing (map, map2, head, tail, reverse)
import Tuple exposing (pair)
import Maybe as M
import Time
import Task
type alias Point = (Float, Float)
type alias Stroke = {
xs : List Float
, ys : List Float
, times : List Float
, startTime : Float
}
emptyStroke : Stroke
emptyStroke = {xs = [], ys = [], times = [], startTime = 0}
type Msg = AddStroke Point
| UpdatePending Point
| EndStroke
| GotStartTime Time.Posix Stroke
| GotPendingPointTime Time.Posix Point
{-| Update the stroke list based on mouse/touch events -}
update : Msg -> List Stroke -> Maybe Point -> ((List Stroke, Maybe Point), Cmd Msg)
update msg strokes pendingPoint =
case msg of
AddStroke point -> addEmptyStroke point strokes
UpdatePending point ->
case pendingPoint of
Just _ -> ((strokes, Just point), Cmd.none)
Nothing -> ((strokes, Nothing), Cmd.none)
EndStroke -> ((strokes, Nothing), Cmd.none)
GotStartTime time stroke -> ((strokes ++ [addStartTimeToStroke time stroke], pendingPoint), Cmd.none)
GotPendingPointTime time point -> ((updateStrokeWithTime strokes point time, pendingPoint), Cmd.none)
applyToLastStroke : (Stroke -> Stroke) -> List Stroke -> List Stroke
applyToLastStroke func strokes =
let
reverseStrokes = reverse strokes
lastStroke = head reverseStrokes
strokesWithoutLastStroke = Maybe.map reverse <| tail reverseStrokes
in
(M.withDefault [] strokesWithoutLastStroke) ++ [func (M.withDefault emptyStroke lastStroke)]
addEmptyStroke : Point -> List Stroke -> ((List Stroke, Maybe Point), Cmd Msg)
addEmptyStroke point strokes =
((strokes, Just point), Task.perform (\t -> GotStartTime t emptyStroke) Time.now)
processTime : Time.Posix -> Float
processTime time = toFloat <| (Time.posixToMillis time) // 1000
addStartTimeToStroke : Time.Posix -> Stroke -> Stroke
addStartTimeToStroke time stroke = {stroke | startTime = processTime time}
updateStrokeWithTime : List Stroke -> Point -> Time.Posix -> List Stroke
updateStrokeWithTime strokes (x,y) time =
let
updateLastStroke stroke =
{ stroke |
xs = stroke.xs ++ [x]
, ys = stroke.ys ++ [y]
, times = stroke.times ++ [processTime time]
}
in
applyToLastStroke updateLastStroke strokes
addPendingPointToStrokes : Maybe Point -> Cmd Msg
addPendingPointToStrokes point =
case point of
(Nothing) -> Cmd.none
(Just (x,y)) -> Task.perform (\t -> GotPendingPointTime t (x,y)) Time.now
{-| Convert a stroke into a viewable shape for the canvas -}
strokeToPath : Stroke -> Shape
strokeToPath {xs, ys} =
let
start : Point
start = M.map2 pair (head xs) (head ys)
|> M.withDefault (0, 0)
rest : List PathSegment
rest = M.map2 pair (tail xs) (tail ys)
|> M.map (\(list1, list2) -> map2 pair list1 list2)
|> M.withDefault []
|> map lineTo
in
path start rest
{-| Settings for all strokes to be drawn on the canvas -}
strokeStyle : List CS.Setting
strokeStyle = [ CS.stroke Color.black
, CS.lineWidth 2.0
, CS.lineCap CS.RoundCap
, CS.lineJoin CS.RoundJoin
]
{-| Generate a canvas based on the current strokes -}
viewCanvas : List Stroke -> Html Msg
viewCanvas strokes = Canvas.toHtml (500, 500)
[ id "canvas"
, Mouse.onDown (\e -> AddStroke e.offsetPos)
, Mouse.onMove (\e -> UpdatePending e.offsetPos)
, Mouse.onUp (\_ -> EndStroke)
]
[ clear (0,0) 500 500
, shapes strokeStyle (map strokeToPath strokes)
]

116
src/Main.elm Normal file
View File

@ -0,0 +1,116 @@
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

66
src/ResultFiltering.elm Normal file
View File

@ -0,0 +1,66 @@
module ResultFiltering exposing (FilterState, Filter, Msg(..), initFilterState, filterUpdate, postProcess)
import Regex as R
import Tuple exposing (first, second)
import List exposing (filter, head)
import Maybe as M
import List exposing (foldl)
type alias CharRange = String
type alias Filter = (Bool, CharRange)
type alias FilterState = {
kanji : Filter
, hiragana : Filter
, katakana : Filter
, all : Filter
}
initFilterState : FilterState
initFilterState = {
kanji = (True, "一-龯")
, hiragana = (True, "ぁ–ゟ")
, katakana = (True, "゠-ヿ")
, all = (False, ".+")
}
toggleFilterState : Filter -> Filter
toggleFilterState (b, r) = (not b, r)
type Msg = Kanji
| Hiragana
| Katakana
| All
| Reset
{-| Handle updates regarding the filter -}
filterUpdate : Msg -> FilterState -> FilterState
filterUpdate msg filters=
case msg of
Kanji -> { filters | kanji = toggleFilterState filters.kanji }
Hiragana -> { filters | hiragana = toggleFilterState filters.hiragana }
Katakana -> { filters | katakana = toggleFilterState filters.katakana }
All -> { filters | all = toggleFilterState filters.all }
Reset -> initFilterState
{-| Filter out different kanji based on the current filters -}
postProcess : List String -> FilterState -> List String
postProcess xs filterState =
let
regex =
(if first filterState.all
then second filterState.all
else [ filterState.kanji, filterState.hiragana, filterState.katakana ]
|> List.map (\(b,r) -> if b then r else "")
|> foldl (++) ""
|> \s -> "^[" ++ s ++ "]*$")
|> R.fromString
|> M.withDefault R.never
matchesRegex : String -> Bool
matchesRegex x = head (R.find regex x)
|> Maybe.map .match
|> Maybe.withDefault ""
|> (==) x
in
filter matchesRegex xs