That made sense but I still didn't know how to fix it. A workmate then
suggested to set 'pointer-events: none' on the draggable so the mouse
events pass through. Below is a version of this working.
```
import Html exposing (..)
import Html.App as Html
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Json.Decode as Json exposing ((:=))
import Mouse exposing (Position)
main =
Html.program
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}
-- MODEL
type alias Model =
{ position : Position
, drag : Maybe Drag
}
type alias Drag =
{ start : Position
, current : Position
}
init : ( Model, Cmd Msg )
init =
( Model (Position 200 200) Nothing, Cmd.none )
-- UPDATE
type Msg
= DragStart Position
| DragAt Position
| DragEnd Position
| Crash
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
( updateHelp msg model, Cmd.none )
updateHelp : Msg -> Model -> Model
updateHelp msg ({position, drag} as model) =
case msg of
DragStart xy ->
Model position (Just (Drag xy xy))
DragAt xy ->
Model position (Maybe.map (\{start} -> Drag start xy) drag)
DragEnd _ ->
Model (getPosition model) Nothing
Crash ->
let _ = Debug.log "Mouseover" 1 in
model
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
case model.drag of
Nothing ->
Sub.none
Just _ ->
Sub.batch [ Mouse.moves DragAt, Mouse.ups DragEnd ]
-- VIEW
(=>) = (,)
view : Model -> Html Msg
view model =
let
realPosition =
getPosition model
pointerEvent =
case model.drag of
Just _ -> "none"
Nothing -> "inherit"
in
div [] [
div [on "mouseover" (Json.succeed Crash)][ text "Drag over me and it
should crash!" ]
, div [ onMouseDown
, style
[ "background-color" => "#3C8D2F"
, "cursor" => "move"
, "width" => "100px"
, "height" => "100px"
, "border-radius" => "4px"
, "position" => "absolute"
, "left" => px realPosition.x
, "top" => px realPosition.y
, "color" => "white"
, "display" => "flex"
, "align-items" => "center"
, "justify-content" => "center"
, "pointer-events" => pointerEvent
]
] [ text "Drag Me!" ]
]
px : Int -> String
px number =
toString number ++ "px"
getPosition : Model -> Position
getPosition {position, drag} =
case drag of
Nothing ->
position
Just {start,current} ->
Position
(position.x + current.x - start.x)
(position.y + current.y - start.y)
onMouseDown : Attribute Msg
onMouseDown =
on "mousedown" (Json.map DragStart Mouse.position)
```
On Thursday, 9 June 2016 02:52:50 UTC+10, besuikerd wrote:
>
> The reason the mouseover event is not fired is because the dragged object
> is in the way. Browser events bubble up from children to parent but in your
> example the two elements are siblings.
>
> Op woensdag 8 juni 2016 14:21:29 UTC+2 schreef joseph ni:
>>
>> I'm working off the elm-lang.org/examples/drag and trying to do a
>> 'mouseover' action whilst I've got the green box being dragged. However,
>> the 'mouseover' does not fire while the box is being dragged.
>>
>> I've reproduced this by making some minimal changes to the example code.
>> If you copy/paste this over the example, everything should be the same
>> except for this text at the top: Drag over me and it should crash!
>> The only difference is that this text has a 'mouseover' that fires off a
>> 'Crash' message which causes the update function to do a Debug.crash
>>
>> If you move your mouse over it, it will cause elm to crash (in the
>> console).
>> But if you drag the box over it, elm doesn't crash because it doesn't
>> register the 'mouseover' message.
>>
>> ```
>> import Html exposing (..)
>> import Html.App as Html
>> import Html.Attributes exposing (..)
>> import Html.Events exposing (on)
>> import Json.Decode as Json exposing ((:=))
>> import Mouse exposing (Position)
>>
>>
>>
>> main =
>> Html.program
>> { init = init
>> , view = view
>> , update = update
>> , subscriptions = subscriptions
>> }
>>
>>
>> -- MODEL
>>
>>
>> type alias Model =
>> { position : Position
>> , drag : Maybe Drag
>> }
>>
>>
>> type alias Drag =
>> { start : Position
>> , current : Position
>> }
>>
>>
>> init : ( Model, Cmd Msg )
>> init =
>> ( Model (Position 200 200) Nothing, Cmd.none )
>>
>>
>>
>> -- UPDATE
>>
>>
>> type Msg
>> = DragStart Position
>> | DragAt Position
>> | DragEnd Position
>> | Crash
>>
>>
>> update : Msg -> Model -> ( Model, Cmd Msg )
>> update msg model =
>> ( updateHelp msg model, Cmd.none )
>>
>>
>> updateHelp : Msg -> Model -> Model
>> updateHelp msg ({position, drag} as model) =
>> case msg of
>> DragStart xy ->
>> Model position (Just (Drag xy xy))
>>
>> DragAt xy ->
>> Model position (Maybe.map (\{start} -> Drag start xy) drag)
>>
>> DragEnd _ ->
>> Model (getPosition model) Nothing
>>
>> Crash -> Debug.crash "Crashed!"
>>
>>
>>
>> -- SUBSCRIPTIONS
>>
>>
>> subscriptions : Model -> Sub Msg
>> subscriptions model =
>> case model.drag of
>> Nothing ->
>> Sub.none
>>
>> Just _ ->
>> Sub.batch [ Mouse.moves DragAt, Mouse.ups DragEnd ]
>>
>>
>>
>> -- VIEW
>>
>>
>> (=>) = (,)
>>
>>
>> view : Model -> Html Msg
>> view model =
>> let
>> realPosition =
>> getPosition model
>> in
>> div [] [
>> div
>> [ onMouseDown
>> , style
>> [ "background-color" => "#3C8D2F"
>> , "cursor" => "move"
>>
>> , "width" => "100px"
>> , "height" => "100px"
>> , "border-radius" => "4px"
>> , "position" => "absolute"
>> , "left" => px realPosition.x
>> , "top" => px realPosition.y
>>
>> , "color" => "white"
>> , "display" => "flex"
>> , "align-items" => "center"
>> , "justify-content" => "center"
>> ]
>> ]
>> [ text "Drag Me!"
>> ],
>> div [on "mouseover" (Json.succeed Crash)][ text "Drag over me and
>> it should crash!" ]
>> ]
>>
>> px : Int -> String
>> px number =
>> toString number ++ "px"
>>
>>
>> getPosition : Model -> Position
>> getPosition {position, drag} =
>> case drag of
>> Nothing ->
>> position
>>
>> Just {start,current} ->
>> Position
>> (position.x + current.x - start.x)
>> (position.y + current.y - start.y)
>>
>>
>> onMouseDown : Attribute Msg
>> onMouseDown =
>> on "mousedown" (Json.map DragStart Mouse.position)
>> ```
>>
>
--
You received this message because you are subscribed to the Google Groups "Elm
Discuss" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to [email protected].
For more options, visit https://groups.google.com/d/optout.
