subscribe position only when it is needed

src/elm/Page/Map/CanvasView.elm

@@ -4,13 +4,13 @@ import Dict exposing (..)
 import Maybe
 import Json.Decode as Decode
 
-import ContextMenu
-
+import Mouse
 import Html exposing (..)
 import Html.Attributes as Attributes exposing (..)
 import Html.Events exposing (..)
 import Html.Keyed as Keyed
 import Html.Lazy exposing (..)
+import ContextMenu
 
 import Component.ObjectNameInput as ObjectNameInput
 import View.Styles as S
@@ -82,7 +82,7 @@ objectView {mode, scale, selected, isGhost, object, rect, contextMenuDisabled, d
           noEvents = ObjectView.noEvents
         in
           { noEvents |
-            onMouseDown = Just (ShowDetailForObject id)
+            onMouseDown = Just (always <| ShowDetailForObject id)
           }
       else
         { onContextMenu =
@@ -146,7 +146,7 @@ view model =
       in
         div
           [ style (S.canvasContainer (Mode.isPrintMode model.mode) isRangeSelectMode)
-          , onWithOptions "mousedown" { stopPropagation = False, preventDefault = False } (Decode.succeed MouseDownOnCanvas)
+          , on "mousedown" Mouse.position |> Attributes.map MouseDownOnCanvas
           , onWithOptions "mouseup" { stopPropagation = True, preventDefault = False } (Decode.succeed MouseUpOnCanvas)
           , onMouseEnter_ EnterCanvas
           , onMouseLeave_ LeaveCanvas

src/elm/Page/Map/Msg.elm

@@ -54,10 +54,10 @@ type Msg
   | EnterCanvas
   | LeaveCanvas
   | MouseUpOnCanvas
-  | MouseDownOnCanvas
-  | MouseDownOnObject Id
+  | MouseDownOnCanvas Position
+  | MouseDownOnObject Id Position
   | MouseUpOnObject Id
-  | MouseDownOnResizeGrip Id
+  | MouseDownOnResizeGrip Id Position
   | StartEditObject Id
   | KeyCodeMsg Bool Int
   | SelectBackgroundColor String

src/elm/Page/Map/Update.elm

@@ -83,7 +83,11 @@ subscriptions tokenRemoved undo redo clipboard model =
     , undo (always Undo)
     , redo (always Redo)
     , clipboard PasteFromClipboard
-    , Mouse.moves MouseMove
+    , if model.draggingContext == NoDragging then
+        Sub.none
+      else
+        Mouse.moves MouseMove
+    , Mouse.downs MouseMove
     , Mouse.ups (always MouseUp)
     , Sub.map ContextMenuMsg (ContextMenu.subscriptions model.contextMenu)
     , Sub.map HeaderMsg (Header.subscriptions)
@@ -416,25 +420,28 @@ update removeToken setSelectionStart msg model =
               model.draggingContext
       } ! []
 
-    MouseDownOnObject lastTouchedId ->
+    MouseDownOnObject lastTouchedId mousePosition ->
       let
+        model0 =
+          { model | mousePosition = mousePosition }
+
         canvasPosition =
-          Model.canvasPosition model
+          Model.canvasPosition model0
 
         (model_, cmd) =
-          if ObjectNameInput.isEditing model.objectNameInput then
+          if ObjectNameInput.isEditing model0.objectNameInput then
             let
               (objectNameInput, ev) =
-                ObjectNameInput.forceFinish model.objectNameInput
+                ObjectNameInput.forceFinish model0.objectNameInput
             in
               case ev of
                 Just (id, name) ->
-                  updateOnFinishNameInput False id name { model | objectNameInput = objectNameInput }
+                  updateOnFinishNameInput False id name { model0 | objectNameInput = objectNameInput }
 
                 Nothing ->
-                  { model | objectNameInput = objectNameInput } ! []
+                  { model0 | objectNameInput = objectNameInput } ! []
           else
-            model ! []
+            model0 ! []
 
         -- TODO
         help model =
@@ -485,24 +492,27 @@ update removeToken setSelectionStart msg model =
       in
         newModel ! [ cmd1, cmd2 ]
 
-    MouseDownOnCanvas ->
+    MouseDownOnCanvas mousePosition ->
       let
+        model0 =
+          { model | mousePosition = mousePosition }
+
         canvasPosition =
-          Model.canvasPosition model
+          Model.canvasPosition model0
 
         selectorRect =
-          if Mode.isSelectMode model.mode then
+          if Mode.isSelectMode model0.mode then
             let
               fitted =
-                ObjectsOperation.fitPositionToGrid model.gridSize <|
-                  Model.screenToImageWithOffset model.scale canvasPosition model.offset
+                ObjectsOperation.fitPositionToGrid model0.gridSize <|
+                  Model.screenToImageWithOffset model0.scale canvasPosition model0.offset
             in
-              Just (fitted.x, fitted.y, model.gridSize, model.gridSize)
+              Just (fitted.x, fitted.y, model0.gridSize, model0.gridSize)
           else
-            model.selectorRect
+            model0.selectorRect
 
         draggingContext =
-          case Mode.currentEditMode model.mode of
+          case Mode.currentEditMode model0.mode of
             Just Mode.Label ->
               NoDragging
 
@@ -513,21 +523,21 @@ update removeToken setSelectionStart msg model =
               PenFromScreenPos canvasPosition
 
             Just Select ->
-              if model.keys.ctrl then
+              if model0.keys.ctrl then
                 Selector
               else
-                ShiftOffset model.mousePosition
+                ShiftOffset model0.mousePosition
 
             Nothing ->
-              ShiftOffset model.mousePosition
+              ShiftOffset model0.mousePosition
 
         (model_, cmd) =
-          case ObjectNameInput.forceFinish model.objectNameInput of
+          case ObjectNameInput.forceFinish model0.objectNameInput of
             (objectNameInput, Just (id, name)) ->
-              updateOnFinishNameInput False id name { model | objectNameInput = objectNameInput }
+              updateOnFinishNameInput False id name { model0 | objectNameInput = objectNameInput }
 
             (objectNameInput, _) ->
-              { model | objectNameInput = objectNameInput } ! []
+              { model0 | objectNameInput = objectNameInput } ! []
 
         (model__, cmd2) =
           if Mode.isLabelMode model.mode then
@@ -544,20 +554,23 @@ update removeToken setSelectionStart msg model =
       in
         newModel ! [ cmd, cmd2 ]
 
-    MouseDownOnResizeGrip id ->
+    MouseDownOnResizeGrip id mousePosition ->
       let
+        model0 =
+          { model | mousePosition = mousePosition }
+
         (model_, cmd) =
-          case ObjectNameInput.forceFinish model.objectNameInput of
+          case ObjectNameInput.forceFinish model0.objectNameInput of
             (objectNameInput, Just (id, name)) ->
-              updateOnFinishNameInput False id name { model | objectNameInput = objectNameInput }
+              updateOnFinishNameInput False id name { model0 | objectNameInput = objectNameInput }
 
             (objectNameInput, _) ->
-              { model | objectNameInput = objectNameInput } ! []
+              { model0 | objectNameInput = objectNameInput } ! []
 
         newModel =
           { model_ |
             selectedObjects = []
-          , draggingContext = ResizeFromScreenPos id (Model.canvasPosition model)
+          , draggingContext = ResizeFromScreenPos id (Model.canvasPosition model_)
           }
       in
         newModel ! [ cmd ]

src/elm/View/ObjectView.elm

@@ -1,24 +1,26 @@
 module View.ObjectView exposing (noEvents, viewDesk, viewLabel)
 
+import Json.Decode as Decode
 import Html exposing (..)
-import Html.Attributes exposing (..)
+import Html.Attributes as Attributes exposing (..)
 import Html.Events exposing (..)
-import Json.Decode as Decode
+import Mouse exposing (Position)
+
+
 import View.Styles as S
 import View.Icons as Icons
 import Model.Scale as Scale exposing (Scale)
 
 
-
 type alias Id = String
 
 
 type alias EventOptions msg =
-  { onMouseDown : Maybe msg
+  { onMouseDown : Maybe (Position -> msg)
   , onMouseUp : Maybe msg
   , onStartEditingName : Maybe msg
   , onContextMenu : Maybe (Attribute msg)
-  , onStartResize : Maybe msg
+  , onStartResize : Maybe (Position -> msg)
   }
 
 
@@ -80,7 +82,7 @@ viewInternal selected eventOptions styles nameView personMatchIcon =
       ) ++
       ( case eventOptions.onMouseDown of
           Just msg ->
-            [ onWithOptions "mousedown" { stopPropagation = True, preventDefault = True } (Decode.succeed msg)
+            [ onWithOptions "mousedown" { stopPropagation = True, preventDefault = True } Mouse.position |> Attributes.map msg
               -- onWithOptions "mousedown" { stopPropagation = True, preventDefault = True } <|
               --   ( Decode.field "buttton" Decode.int
               --     |> Decode.andThen (\value ->
@@ -114,13 +116,13 @@ viewInternal selected eventOptions styles nameView personMatchIcon =
       ]
 
 
-resizeGripView : Bool -> Maybe msg -> Html msg
+resizeGripView : Bool -> Maybe (Position -> msg) -> Html msg
 resizeGripView selected onStartResize =
   case onStartResize of
     Just msg ->
       div
         [ style (S.deskResizeGrip selected)
-        , onWithOptions "mousedown" { stopPropagation = True, preventDefault = False } (Decode.succeed msg)
+        , onWithOptions "mousedown" { stopPropagation = True, preventDefault = False } Mouse.position |> Attributes.map msg
         ]
         []
     Nothing ->