Merge pull request #33 from zaboco/32-custom-mouse-trigger

Custom mouse trigger, close #32

README.md

@@ -161,3 +161,34 @@ dragConfig =
 ```
 
 There is actually [an example right for this use-case](https://github.com/zaboco/elm-draggable/blob/master/examples/PanAndZoomExample.elm)
+
+#### Custom mouse trigger
+There are cases when we need some additional information (e.g. mouse offset) about the `mousedown` event which triggers the drag. For these cases, there is an advanced `customMouseTrigger` which also takes a JSON `Decoder` for the [`MouseEvent`](https://developer.mozilla.org/en-US/docs/Web/API/MouseEvent).
+
+```elm
+import Json.Decode as Decode exposing (Decoder)
+
+type Msg
+    = CustomMouseDown Draggable.Msg (Float, Float)
+--  | ...
+
+update msg model =
+    case msg of
+        CustomMouseDown dragMsg startPoint ->
+            { model | startPoint = startPoint }
+                |> Draggable.update dragConfig dragMsg
+
+view { scene } =
+    Svg.svg
+        [ Draggable.customMouseTrigger mouseOffsetDecoder CustomMouseDown
+--      , ...        
+        ]
+        []
+
+mouseOffsetDecoder : Decoder (Float, Float)
+mouseOffsetDecoder =
+    Decode.map2 (,)
+        (Decode.field "offsetX" Decode.float)
+        (Decode.field "offsetY" Decode.float)
+```
+[Full example](https://github.com/zaboco/elm-draggable/blob/master/examples/FreeDrawingExample.elm)

examples/FreeDrawingExample.elm

@@ -0,0 +1,139 @@
+module FreeDrawingExample exposing (main)
+
+import Draggable exposing (Delta)
+import Draggable.Events exposing (onDragBy, onMouseDown)
+import Html exposing (Html)
+import Json.Decode as Decode exposing (Decoder)
+import Svg exposing (Svg)
+import Svg.Attributes as Attr
+
+
+type alias Model =
+    { scene : Scene
+    , drag : Draggable.State
+    }
+
+
+type Scene
+    = Path Position (List Delta)
+    | Empty
+
+
+type alias Position =
+    { x : Float
+    , y : Float
+    }
+
+
+type Msg
+    = DragMsg Draggable.Msg
+    | StartPathAndDrag Draggable.Msg Position
+    | AddNewPointAtDelta Draggable.Delta
+
+
+init : ( Model, Cmd msg )
+init =
+    ( { scene = Empty, drag = Draggable.init }, Cmd.none )
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        DragMsg dragMsg ->
+            Draggable.update dragConfig dragMsg model
+
+        StartPathAndDrag dragMsg startPoint ->
+            { model | scene = Path startPoint [] }
+                |> Draggable.update dragConfig dragMsg
+
+        AddNewPointAtDelta delta ->
+            case model.scene of
+                Empty ->
+                    model ! []
+
+                Path startPoint deltasSoFar ->
+                    { model | scene = Path startPoint (delta :: deltasSoFar) } ! []
+
+
+dragConfig : Draggable.Config Msg
+dragConfig =
+    Draggable.customConfig
+        [ onDragBy AddNewPointAtDelta
+        ]
+
+
+subscriptions : Model -> Sub Msg
+subscriptions { drag } =
+    Draggable.subscriptions DragMsg drag
+
+
+view : Model -> Html Msg
+view { scene } =
+    Svg.svg
+        [ Attr.style "height: 100vh; width: 100vw; margin: 100px;"
+        , Attr.fill "none"
+        , Attr.stroke "black"
+        , Draggable.customMouseTrigger mouseOffsetDecoder StartPathAndDrag
+        ]
+        [ background
+        , sceneView scene
+        ]
+
+
+mouseOffsetDecoder : Decoder Position
+mouseOffsetDecoder =
+    Decode.map2 Position
+        (Decode.field "offsetX" Decode.float)
+        (Decode.field "offsetY" Decode.float)
+
+
+sceneView : Scene -> Svg msg
+sceneView scene =
+    case scene of
+        Empty ->
+            Svg.text ""
+
+        Path firstPoint deltas ->
+            pathView firstPoint deltas
+
+
+pathView : Position -> List Delta -> Svg msg
+pathView firstPoint reverseDeltas =
+    let
+        deltas =
+            List.reverse reverseDeltas
+
+        deltasString =
+            deltas
+                |> List.map (\( dx, dy ) -> " l " ++ (toString dx) ++ " " ++ (toString dy))
+                |> String.join ""
+
+        firstPointString =
+            "M " ++ (toString firstPoint.x) ++ " " ++ (toString firstPoint.y)
+
+        pathString =
+            firstPointString ++ deltasString
+    in
+        Svg.path [ Attr.d pathString ] []
+
+
+background : Svg msg
+background =
+    Svg.rect
+        [ Attr.x "0"
+        , Attr.y "0"
+        , Attr.width "100%"
+        , Attr.height "100%"
+        , Attr.fill "#eee"
+        ]
+        []
+
+
+main : Program Never Model Msg
+main =
+    Html.program
+        { init = init
+        , update = update
+        , subscriptions = subscriptions
+        , view = view
+        }

examples/README.md

@@ -21,3 +21,6 @@ Dragging on a scaled viewport.
 
 ### Multiple Targets Example
 Multiple DOM elements' dragging state can be tracked at once.
+
+### Free Drawing Example
+Showcasing `customMouseTrigger` with `mouseOffsetDecoder` 

src/Draggable.elm

@@ -8,6 +8,7 @@ module Draggable
         , basicConfig
         , customConfig
         , mouseTrigger
+        , customMouseTrigger
         , init
         , update
         , subscriptions
@@ -32,15 +33,15 @@ An element is considered to be dragging when the mouse is pressed **and** moved
 @docs update, subscriptions
 
 # DOM trigger
-@docs mouseTrigger
+@docs mouseTrigger, customMouseTrigger
 
 # Definitions
 @docs Delta, State, Msg, Config, Event
 -}
 
 import Cmd.Extra
 import Internal
-import Json.Decode
+import Json.Decode as Decode exposing (Decoder)
 import Mouse exposing (Position)
 import VirtualDom
 
@@ -120,21 +121,38 @@ subscriptions envelope (State drag) =
 -}
 mouseTrigger : String -> (Msg -> msg) -> VirtualDom.Property msg
 mouseTrigger key envelope =
-    let
-        ignoreDefaults =
-            VirtualDom.Options True True
-    in
-        VirtualDom.onWithOptions "mousedown"
-            ignoreDefaults
-            (whenLeftMouseButtonPressed <|
-                Json.Decode.map (envelope << Msg << Internal.StartDragging key) Mouse.position
-            )
+    VirtualDom.onWithOptions "mousedown"
+        ignoreDefaults
+        (Decode.map envelope (positionDecoder key))
+
+
+{-| DOM event handler to start dragging on mouse down and also sending custom information about the `mousedown` event. It does so by using a custom `Decoder` for the [`MouseEvent`](https://developer.mozilla.org/en-US/docs/Web/API/MouseEvent).
+
+    div [ mouseTrigger offsetDecoder CustomDragMsg ] [ text "Drag me" ]
+-}
+customMouseTrigger : Decoder a -> (Msg -> a -> msg) -> VirtualDom.Property msg
+customMouseTrigger customDecoder customEnvelope =
+    VirtualDom.onWithOptions "mousedown"
+        ignoreDefaults
+        (Decode.map2 customEnvelope (positionDecoder "") customDecoder)
+
+
+positionDecoder : String -> Decoder Msg
+positionDecoder key =
+    Mouse.position
+        |> Decode.map (Msg << Internal.StartDragging "")
+        |> whenLeftMouseButtonPressed
+
+
+ignoreDefaults : VirtualDom.Options
+ignoreDefaults =
+    VirtualDom.Options True True
 
 
-whenLeftMouseButtonPressed : Json.Decode.Decoder a -> Json.Decode.Decoder a
+whenLeftMouseButtonPressed : Decoder a -> Decoder a
 whenLeftMouseButtonPressed decoder =
-    Json.Decode.field "button" Json.Decode.int
-        |> Json.Decode.andThen
+    Decode.field "button" Decode.int
+        |> Decode.andThen
             (\button ->
                 case button of
                     -- https://www.w3.org/TR/DOM-Level-2-Events/events.html#Events-MouseEvent
@@ -143,7 +161,7 @@ whenLeftMouseButtonPressed decoder =
                         decoder
 
                     _ ->
-                        Json.Decode.fail "Event is only relevant when the main mouse button was pressed."
+                        Decode.fail "Event is only relevant when the main mouse button was pressed."
             )