Initial commit
This commit is contained in:
commit
f6f53d565c
|
|
@ -0,0 +1,5 @@
|
|||
elm-stuff
|
||||
node_modules
|
||||
dist/app.js
|
||||
yarn.lock
|
||||
package-lock.json
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
default: app.js
|
||||
|
||||
app.js: src
|
||||
elm make src/Main.elm --output=dist/app.js
|
||||
|
|
@ -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>
|
||||
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
@ -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": {}
|
||||
}
|
||||
}
|
||||
|
|
@ -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)
|
||||
}
|
||||
]
|
||||
}
|
||||
|
|
@ -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)
|
||||
]
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
Loading…
Reference in New Issue