Elm：向 SVG 元素添加点击事件不起作用——这可能吗？

Question

我一直在尝试向 Elm 中的 SVG 元素添加 on "click" 事件，以确定鼠标单击在该元素中的相对位置。

下面给出了一个代码示例，您可以在 http://elm-lang.org/try 处尝试运行以显示 HTML 元素上的点击事件似乎如何按预期工作，但在 SVG 元素上却没有。

在示例中，使用 Html.on "click" 而不是 Html.onClick 以允许从事件中解码位置数据，如 this discussion 中所述。

阅读文档和源代码后，我希望将 on "click" 事件添加到 SVG 元素时，其工作方式与将事件添加到 HTML 相同元素。但是，完成此操作后，单击 SVG 元素不会触发事件，也不会向更新函数发送任何消息。

在此示例中，在黑色 SVG rect 内单击应该会触发更新功能并更改白色 rect 的位置，但点击会被忽略。这可以通过打开控制台并注意未调用 Debug.log 来确认。 HTML div 放置在下方，具有相同的点击事件，当在该 div 中注册点击时，白色 rect 改变位置。

这是 Elm 中的预期行为吗？是否有任何解决方法？

有人在 Whosebug 上提出了类似的问题，但这是指 canvas 形状，据我所知，这是一个完全独立的问题（虽然我可能错了).

代码示例：

import Html exposing (Html, div)
import Html.App as App
import Html.Attributes
import Html.Events exposing (on)
import Json.Decode as Json exposing (object2, int, at)
import Mouse exposing (Position)
import Svg exposing (svg, rect)
import Svg.Attributes exposing (..)

main =
  App.beginnerProgram
    { model = model
    , view = view
    , update = update
    }

type alias Model =
  Position

type Msg
  = ChangePosition Position

model : Model
model =
  Position 0 0

update : Msg -> Model -> Model
update msg _ =
  case Debug.log "msg" msg of
    ChangePosition position ->
      position

view : Model -> Html Msg
view model =
  div []
    [ svg
        [ width "400"
        , height "100"
        , viewBox "0 0 400 100"
        ]
        [ rect
            [ onClickLocation -- this should work but does nothing
            , width "400"
            , height "100"
            , x "0"
            , y "0"
            , fill "#000"
            , cursor "pointer"
            ]
            []
        , rect
            [ width "50"
            , height "50"
            , x (toString model.x)
            , y "20"
            , fill "#fff"
            ]
            []
        ]
    , div
        [ onClickLocation -- this works
        , Html.Attributes.style
            [ ( "background-color", "white" )
            , ( "border", "2px solid black" )
            , ( "width", "400px" )
            , ( "height", "100px" )
            , ( "position", "absolute" )
            , ( "left", "0px" )
            , ( "top", "150px" )
            , ( "color", "black" )
            , ( "cursor", "pointer" )
            ]
        ]
        [ div [] [ Html.text "Click in here to move x position of white svg square. Relative click coordinates shown below (y coordinate ignored)." ]
        , div [] [ Html.text (toString model) ]
        ]
    ]

onClickLocation : Html.Attribute Msg
onClickLocation =
  on "click"
    (Json.map
      ChangePosition
      (object2
        Position
        (object2 (-)
          (at [ "pageX" ] int)
          (at [ "target", "offsetLeft" ] int)
        )
        (object2 (-)
          (at [ "pageY" ] int)
          (at [ "target", "offsetTop" ] int)
        )
      )
    )

Answer 1

Json 解码器不工作的原因很明显，因为 offsetLeft 的 none 或 offsetTop 存在于事件对象。

有些混乱，因为这些属性可用用于 Html DOM 的点击事件，但不适用于 SVG DOM。（我的建议是在 Elm 中实现事件解码器是附加临时的浏览器调试器控制台中的事件处理程序并研究实际的事件对象。 Elm 的解码器无声地失败并且很难知道为什么解码器不工作。 )

在这里，我实现了一种替代方法，您可以使用 port 来获取使用 javascript 的父位置（不使用任何社区图书馆）。

port module Main exposing (main)

import Html exposing (Html, div)
import Html.App as App
import Html.Attributes
import Html.Events exposing (on)
import Json.Decode as Json exposing (object2, object1, int, at)
import Mouse exposing (Position)
import Svg exposing (svg, rect)
import Svg.Attributes exposing (..)

main : Program Never
main =
  App.program
    { init = (initmodel, getParentPos ())
    , view = view
    , update = update
    , subscriptions = subscriptions
    }

type alias Model =
  { position : Position
  , parentPosition : Position
  }

type Msg
  = ChangePosition Position
  | UpdateParentPosition { top : Int, left : Int }

initmodel : Model
initmodel =
  { position = Position 0 0
  , parentPosition = Position 0 0
  }

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case Debug.log "msg" msg of
    ChangePosition position ->
      let
        relativepos = Position
          ( position.x - model.parentPosition.x )
          ( position.y - model.parentPosition.y )
      in ({ model | position = relativepos } , Cmd.none)
    UpdateParentPosition {top, left} ->
      ({ model | parentPosition = Position top left }, Cmd.none)

port getParentPos : () -> Cmd msg

subscriptions : Model -> Sub Msg
subscriptions model =
  parentPos UpdateParentPosition

port parentPos : ({ top : Int, left : Int } -> msg) -> Sub msg

view : Model -> Html Msg
view model =
  div []
    [ svg
        [ width "400"
        , height "100"
        , viewBox "0 0 400 100"
        , id "parent"
        ]
        [ rect
            [ onClickLocation -- this should work but does nothing
            , width "400"
            , height "100"
            , x "0"
            , y "0"
            , fill "#000"
            , cursor "pointer"
            ]
            []
        , rect
            [ width "50"
            , height "50"
            , x (toString model.position.x)
            , y (toString model.position.y)
            , fill "#fff"
            ]
            []
        ]
    , div
        [ onClickLocation -- this works
        , Html.Attributes.style
            [ ( "background-color", "white" )
            , ( "border", "2px solid black" )
            , ( "width", "400px" )
            , ( "height", "100px" )
            , ( "position", "absolute" )
            , ( "left", "0px" )
            , ( "top", "150px" )
            , ( "color", "black" )
            , ( "cursor", "pointer" )
            ]
        ]
        [ div [] [ Html.text "Click in here to move x position of white svg square. Relative click coordinates shown below (y coordinate ignored)." ]
        , div [] [ Html.text (toString model) ]
        ]
    ]

onClickLocation : Html.Attribute Msg
onClickLocation =
  on "click"
    (Json.map
      ChangePosition
      (object2
        Position
          (at [ "pageX" ] int)
          (at [ "pageY" ] int)
      )
    )

javascript:

const app = Elm.Main.fullscreen();

app.ports.getParentPos.subscribe(() => {
  const e = document.querySelector('#parent');
  const rect = e.getBoundingClientRect();
  app.ports.parentPos.send({
    top: Math.round(rect.top),
    left: Math.round(rect.left)
  });
});

Answer 2

这是使用 VirtualDom 的示例的固定版本。我也将它升级到 elm v0.18。请注意，就像接受的答案一样，这只是获得 pageX/pageY 位置而不是相对位置。我没有详细说明。

相关改动从底部开始onClickLocation

import Html exposing (Html, div)
import Html.Attributes
import Html.Events exposing (on)
import Json.Decode as Json exposing (..)
import Svg exposing (svg, rect)
import Svg.Attributes exposing (..)
import VirtualDom

main =
  Html.beginnerProgram
    { model = model
    , view = view
    , update = update
    }

type alias Position =
    { x : Int
    , y : Int
    }

type alias Model =
  Position

type Msg
  = ChangePosition Position

model : Model
model =
  Position 0 0

update : Msg -> Model -> Model
update msg _ =
  case Debug.log "msg" msg of
    ChangePosition position ->
      position

view : Model -> Html Msg
view model =
  div []
    [ svg
        [ width "400"
        , height "100"
        , viewBox "0 0 400 100"
        ]
        [ rect
            [ onClickLocation -- this should work but does nothing
            , width "400"
            , height "100"
            , x "0"
            , y "0"
            , fill "#000"
            , cursor "pointer"
            ]
            []
        , rect
            [ width "50"
            , height "50"
            , x (toString model.x)
            , y "20"
            , fill "#fff"
            ]
            []
        ]
    , div
        [ onClickLocation -- this works
        , Html.Attributes.style
            [ ( "background-color", "white" )
            , ( "border", "2px solid black" )
            , ( "width", "400px" )
            , ( "height", "100px" )
            , ( "position", "absolute" )
            , ( "left", "0px" )
            , ( "top", "150px" )
            , ( "color", "black" )
            , ( "cursor", "pointer" )
            ]
        ]
        [ div [] [ Html.text "Click in here to move x position of white svg square. Relative click coordinates shown below (y coordinate ignored)." ]
        , div [] [ Html.text (toString model) ]
        ]
    ]

onClickLocation : Html.Attribute Msg
onClickLocation =
    mouseClick ChangePosition


offsetPosition : Json.Decoder Position
offsetPosition =
    Json.map2 Position (field "pageX" Json.int) (field "pageY" Json.int)


mouseEvent : String -> (Position -> msg) -> VirtualDom.Property msg
mouseEvent event messager =
    let
        options =
            { preventDefault = True, stopPropagation = True }
    in
        VirtualDom.onWithOptions event options (Json.map messager offsetPosition)


mouseClick : (Position -> msg) -> VirtualDom.Property msg
mouseClick =
    mouseEvent "click"

Elm：向 SVG 元素添加点击事件不起作用——这可能吗？

Elm: adding click events to SVG elements doesn't work – is this possible?

svg

mouseevent

elm

代码示例：