init : ( Model, Cmd Msg ) update : Msg -> Model -> ( Model, Cmd Msg ) view : Model -> Html Msg subscriptions : Model -> Sub Msg main = Html.program { init = init , view = view , update = update , subscriptions = subscriptions }
type alias Model = { x : Float , y : Float -- , dir : Float -- , , connected : Bool -- , ws : String -- URL websocket, rosbridge -- ROS -- , -- url ws://localhost:9090/ , topic : String -- , , -- /turtle1/cmd_vel , input : String -- JSON , -- , messages : List String -- rosbridge -- -- } init : ( Model, Cmd Msg ) init = ( Model 50 50 0 False "ws://192.168.56.101:9090/" "/turtle1/cmd_vel" "" [] , Cmd.none )
type Msg = Send String | NewMessage String | EnterUrl String | EnterTopic String | Connect | Input String
update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of EnterTopic newInput -> ( { model | topic = newInput }, Cmd.none ) EnterUrl newInput -> ( { model | ws = newInput }, Cmd.none ) Connect -> ( { model | connected = True }, WebSocket.send model.ws (subscr model.topic) ) Input newInput -> ( { model | input = newInput }, Cmd.none ) Send data -> ( { model | input = "" }, WebSocket.send model.ws data ) NewMessage str -> case Decode.decodeString (decodePublish decodeTwist) str of Err _ -> ( { model | messages = str :: model.messages }, Cmd.none ) Ok t -> let ( r, a ) = turtleMove t.msg dir = model.dir + a in ( { model | x = model.x + r * sin dir , y = model.y + r * cos dir , dir = dir , messages = str :: model.messages } , Cmd.none )
view : Model -> Html Msg view model = div [] <| if model.connected then let x = toString model.x y = toString model.y dirx = toString (model.x + 5 * sin model.dir) diry = toString (model.y + 5 * cos model.dir) in [ svg [ viewBox "0 0 100 100", Svg.Attributes.width "300px" ] [ circle [ cx x, cy y, r "4" ] [] , line [ x1 x, y1 y, x2 dirx, y2 diry, stroke "red" ] [] ] , br [] [] , button [ onClick <| Send <| pub model.topic 0 1 ] [ Html.text "Left" ] , button [ onClick <| Send <| pub model.topic 1 0 ] [ Html.text "Forward" ] , button [ onClick <| Send <| pub model.topic -1 0 ] [ Html.text "Back" ] , button [ onClick <| Send <| pub model.topic 0 -1 ] [ Html.text "Rigth" ] , br [] [] , input [ Html.Attributes.type_ "textaria", onInput Input ] [] , button [ onClick (Send model.input) ] [ Html.text "Send" ] , div [] (List.map viewMessage model.messages) ] else [ Html.text "WS: " , input [ Html.Attributes.type_ "text" , Html.Attributes.value model.ws , onInput EnterUrl ] [] , Html.text "Turtlr topic: " , input [ Html.Attributes.type_ "text" , Html.Attributes.value model.topic , onInput EnterTopic ] [] , br [] [] , button [ onClick Connect ] [ Html.text "Connect" ] ] viewMessage : String -> Html msg viewMessage msg = div [] [ Html.text msg ]
Html.Attributes.type_ : String -> Html.Attribute msg
sets the type in tags such as imput, and Html.Events.onClick : msg -> Html.Attribute msg
sets the event that should occur when you click on this item.
onClick <| Send <| pub model.topic 0 1
onClick (Send (pub model.topic 0 1))
<|
- This is an operator of applying a function to an argument (in Haskell it is called '$'), which allows the use of fewer brackets.
onClick
is the creation of the attribute already considered, its parameter is the generated event.
Send
is one of the constructors of the Msg type, its patmeter is a string that we want to send to the websocket later.
pub model.topic 0 1
- call the function of creating a request to send a message about the movement of the turtle to the topic. The topic is taken from the model, and 0 and 1 - move and rotate.
subscr : String -> String subscr topic = "{\"op\":\"subscribe\",\"topic\":\"" ++ topic ++ "\"}" pub : String -> Float -> Float -> String pub topic mr = "{\"topic\":\"" ++ topic ++ "\",\"msg\":{\"linear\":{\"y\":0.0,\"x\":" ++ toString m ++ ",\"z\": 0.0},\"angular\":{\"y\":0.0,\"x\":0.0,\"z\":" ++ toString r ++ "}},\"op\":\"publish\"}"
ros:~$ rosmsg info geometry_msgs/Twist geometry_msgs/Vector3 linear float64 x float64 y float64 z geometry_msgs/Vector3 angular float64 x float64 y float64 z
type alias Vector3 = ( Float, Float, Float ) type alias Twist = { linear : Vector3, angular : Vector3 } decodV3 : Decode.Decoder Vector3 decodV3 = Decode.map3 (,,) (Decode.at [ "x" ] Decode.float) (Decode.at [ "y" ] Decode.float) (Decode.at [ "z" ] Decode.float) decodeTwist : Decode.Decoder Twist decodeTwist = Decode.map2 Twist (Decode.at [ "linear" ] decodV3) (Decode.at [ "angular" ] decodV3) type alias Publish a = { msg : a, topic : String, op : String } decodePublish : Decode.Decoder a -> Decode.Decoder (Publish a) decodePublish decMsg = Decode.map3 (\tmo -> { msg = m, topic = t, op = o }) (Decode.at [ "topic" ] Decode.string) (Decode.at [ "msg" ] decMsg) (Decode.at [ "op" ] Decode.string)
Decode.map3 (,,)
applies three decoders passed to it in parameters and creates a tuple of three decoded elements using the (,,)
operation.
Decode.at
decodes the value extracted along a given path in Json by a given decoder.
(\tmo -> { msg = m, topic = t, op = o })
function (t,m,o) { return {"msg":m, "t":t, "op":p} }
Source: https://habr.com/ru/post/340534/