diff --git a/elm/src/Auto/ClientUpdate.elm b/elm/src/Auto/ClientUpdate.elm index 0adbe1a..771fa76 100644 --- a/elm/src/Auto/ClientUpdate.elm +++ b/elm/src/Auto/ClientUpdate.elm @@ -16,7 +16,7 @@ type ClientUpdate | InputBool String Bool | InputNumber String Float | InputText String String - | SubmitInput String + | SubmitInput String String encode : ClientUpdate -> Json.Encode.Value @@ -48,5 +48,6 @@ encode a = Json.Encode.object [ ("InputText" , Json.Encode.list identity [ Json.Encode.string b , Json.Encode.string c ]) ] - SubmitInput b -> - Json.Encode.object [("SubmitInput" , Json.Encode.string b)] \ No newline at end of file + SubmitInput b c -> + Json.Encode.object [ ("SubmitInput" , Json.Encode.list identity [ Json.Encode.string b + , Json.Encode.string c ]) ] \ No newline at end of file diff --git a/elm/src/Main.elm b/elm/src/Main.elm index 552b541..a2b8378 100644 --- a/elm/src/Main.elm +++ b/elm/src/Main.elm @@ -224,7 +224,9 @@ viewElement model element = viewIndicator element.name x Element.Input x -> - viewInput element.name x + viewInput element.name x <| + withDefault "" <| + Dict.get element.name model.layout.texts Element.Empty -> stack [] @@ -415,14 +417,14 @@ viewIndicator _ ind = |> styled1 ind.colour -viewInput : String -> Input -> Collage Msgs -viewInput name inp = +viewInput : String -> Input -> String -> Collage Msgs +viewInput name inp val = html (both toFloat ( inp.width, inp.height )) [] <| form [ style "display" "flex" , style "width" "100%" , style "height" "100%" - , H.map List.singleton <| onSubmit <| ClientUpdate <| SubmitInput name + , onSubmit [ ClientUpdate <| SubmitInput name val, TextSet name "" ] ] [ input ([ H.type_ <| @@ -436,6 +438,7 @@ viewInput name inp = InputType.Text _ -> "text" , style "flex" "auto" + , onInput <| List.singleton << TextSet name , H.map List.singleton <| case inp.inputType of InputType.CheckBox () -> @@ -464,6 +467,12 @@ viewInput name inp = InputType.Text style -> textStyle style ) + ++ (if val == "" then + [ H.value val ] + + else + [] + ) ) [] ] @@ -539,6 +548,7 @@ type alias LayoutState = , stickPos : Dict String Vec2 , sliderPos : Dict String Float , pointerCallbacks : Dict Int PointerCallbacks -- keys are the ids of the pointers currently held down + , texts : Dict String String } @@ -555,6 +565,7 @@ type Msg | GoFullscreen | FullscreenChange Bool | ConsoleLog String + | TextSet String String type alias PointerCallbacks = @@ -607,6 +618,7 @@ loadLayout layout = , pointerCallbacks = Dict.empty , pressed = Set.empty , sliderPos = Dict.empty + , texts = Dict.empty } @@ -642,7 +654,7 @@ update msg model = InputText _ _ -> model - SubmitInput _ -> + SubmitInput _ _ -> model in ( model1, sendUpdate u ) @@ -679,6 +691,9 @@ update msg model = ConsoleLog s -> ( model, consoleLog s ) + TextSet name s -> + ( { model | layout = { layoutState | texts = Dict.insert name s layoutState.texts } }, Cmd.none ) + serverUpdate : ServerUpdate -> Model -> ( Model, Cmd Msgs ) serverUpdate u model = diff --git a/haskell/src/Monpad.hs b/haskell/src/Monpad.hs index 5de0355..6083bbb 100644 --- a/haskell/src/Monpad.hs +++ b/haskell/src/Monpad.hs @@ -117,7 +117,7 @@ data ClientUpdate | InputBool ElementID Bool | InputNumber ElementID Double | InputText ElementID Text - | SubmitInput ElementID -- for number and text inputs + | SubmitInput ElementID Text -- for number and text inputs deriving (Eq, Ord, Show, Generic) deriving (FromJSON) via CustomJSON Opts.JSON ClientUpdate