Merge pull request #131 from statebox/79/dont-hardcode-svg-element

79/dont hardcode svg element

Author: marcosh

src/Svg/Util.js

@@ -21,23 +21,19 @@ exports._beginElements = function (cssSelectorStr) {
   };
 }
 
-var svg;
+exports.domToSvgCoordinates = function (svg) {
+  return function (point) {
+    const svgPoint = svg.createSVGPoint();
 
-exports.domToSvgCoordinates = function (point) {
-  if (typeof svg === 'undefined') {
-    svg = document.getElementsByTagName('svg')[0];
-  }
+    svgPoint.x = point.x;
+    svgPoint.y = point.y;
 
-  const svgPoint = svg.createSVGPoint();
+    const svgCoordPoint = svgPoint.matrixTransform(svg.getScreenCTM().inverse());
 
-  svgPoint.x = point.x;
-  svgPoint.y = point.y;
-
-  const svgCoordPoint = svgPoint.matrixTransform(svg.getScreenCTM().inverse());
-
-  return {
-    x: svgCoordPoint.x,
-    y: svgCoordPoint.y,
-    z: 0
+    return {
+      x: svgCoordPoint.x,
+      y: svgCoordPoint.y,
+      z: 0
+    };
   };
 }

src/Svg/Util.purs

@@ -4,6 +4,7 @@ import Data.Vec3 (Vec3)
 import Prelude ((<<<))
 import Effect.Aff (Aff)
 import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
+import Web.HTML (HTMLElement)
 
 type CssSelector = String
 
@@ -12,4 +13,4 @@ foreign import _beginElements :: CssSelector -> EffectFnAff Int
 beginElements :: CssSelector -> Aff Int
 beginElements = fromEffectFnAff <<< _beginElements
 
-foreign import domToSvgCoordinates :: Vec3 Int -> Vec3 Int
+foreign import domToSvgCoordinates :: HTMLElement -> Vec3 Int -> Vec3 Int

src/View/Diagram/DiagramEditor.purs

@@ -2,30 +2,25 @@ module View.Diagram.DiagramEditor where
 
 import Prelude hiding (div)
 
-import Data.Bifunctor (bimap)
-import Data.Int (floor, round)
 import Data.Maybe
 import Data.Traversable (traverse)
 import Data.Tuple.Nested ((/\))
-import Data.Vec3 (vec2, vec3)
-import Effect.Aff.Class (class MonadAff, liftAff)
-import Effect (Effect)
-import Foreign (Foreign)
+import Data.Vec3 (vec2)
+import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen (ComponentDSL, HalogenM)
 import Halogen.HTML as HH
-import Halogen.HTML (HTML, div, br)
+import Halogen.HTML (HTML, div)
 import Halogen.HTML.Core (ClassName(..))
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
 import Halogen.HTML.Properties (classes)
-import Halogen.Query (getHTMLElementRef)
 import Svg.Elements as SE
 import Svg.Attributes as SA
 import Unsafe.Coerce (unsafeCoerce)
 import Web.DOM (Element)
 import Web.HTML.HTMLElement as HTMLElement
-import Web.HTML.HTMLElement (HTMLElement, DOMRect, getBoundingClientRect)
+import Web.HTML.HTMLElement (HTMLElement, getBoundingClientRect)
 
 import View.Diagram.Model
 import View.Diagram.Update as Update
@@ -46,35 +41,27 @@ initialState ops =
     , dragStart:     DragNotStarted
     }
   , msg: ""
-  , boundingClientRectMaybe: Nothing
+  , componentElemMaybe: Nothing
   }
 
 ui :: ∀ m. MonadAff m => H.Component HTML Query Operators Msg m
-ui = H.component { initialState: initialState, render, eval, receiver: HE.input UpdateDiagram }
+ui = H.lifecycleComponent { initialState: initialState, render, eval, receiver: HE.input UpdateDiagram, initializer: Just (Initialize unit), finalizer: Nothing }
   where
     render :: State -> HTML Void (Query Unit)
     render state =
       div [ classes [ ClassName "css-diagram-editor" ] ]
           [ div [ classes [] ]
-                [ View.diagramEditorSVG state.model <#> \msg -> MouseAction msg unit
+                [ View.diagramEditorSVG state.componentElemMaybe state.model <#> \msg -> MouseAction msg unit
                 , div [ classes [ ClassName "mt-4", ClassName "rb-2", ClassName "p-4", ClassName "bg-grey-lightest", ClassName "text-grey-dark", ClassName "rounded", ClassName "text-sm" ] ]
                       [ Inspector.view state ]
                 ]
           ]
 
-    -- TODO We shouldn't need to getBoundingClientRect on every single model update, that is incredibly inefficient.
-    --      Doing it just on initialisation and window resizing/layout changes should do.
     eval :: Query ~> ComponentDSL State Query Msg m
     eval = case _ of
       MouseAction msg next -> do
-        componentElemMaybe <- getHTMLElementRef' View.componentRefLabel
-        boundingRectMaybe <- H.liftEffect $ getBoundingClientRect `traverse` componentElemMaybe
-
         state <- H.get
-        let updater = maybe (\     state -> state { msg   = "Could not determine this component's boundingClientRect." })
-                            (\rect state -> state { model = evalModel msg state.model })
-                            boundingRectMaybe
-            state' = (updater <<< _ { boundingClientRectMaybe = boundingRectMaybe }) state
+        let state' = state { model = evalModel msg state.model }
 
             isOperatorClicked = case msg of
               MouseUp _ -> true
@@ -96,6 +83,11 @@ ui = H.component { initialState: initialState, render, eval, receiver: HE.input
         H.modify_ \state -> state { model = state.model { ops = ops } }
         pure next
 
+      Initialize next -> do
+        componentElemMaybe <- getHTMLElementRef' View.componentRefLabel
+        H.modify_ \state -> state { componentElemMaybe = componentElemMaybe }
+        pure next
+
 -- TODO this is generally useful; move elsewhere
 -- This was made because the original implementation from Halogen.Query doesn't seem to work, at least in this case:
 --      getHTMLElementRef = map (HTMLElement.fromElement =<< _) <<< getRef

src/View/Diagram/Inspector.purs

@@ -28,7 +28,6 @@ view state@{model} =
          , prop "valid"       $ show $ isValidDrag model
          , prop "selectedOpId"$ show model.selectedOpId
          , code "-----------------------\n"
-         , prop "bounds"      $ maybe "Nothing" (\r -> "Just " <> viewRect r) state.boundingClientRectMaybe
          ]
     where
       prop :: String -> String -> HTML Void (Query Unit)

src/View/Diagram/Model.purs

@@ -1,7 +1,8 @@
 module View.Diagram.Model where
 
-import Prelude
 import Data.Maybe
+import Prelude
+
 import Data.Tuple.Nested (type (/\), (/\))
 import Data.Vec3 (Vec3, vec3, _x, _y)
 

src/View/Diagram/Update.purs

@@ -3,8 +3,9 @@ module View.Diagram.Update where
 import Prelude
 
 import Data.Maybe
-import Data.Tuple.Nested (type (/\), (/\))
+import Data.Tuple.Nested ((/\))
 import Data.Vec3 (Vec3, _x, _y, _z, vec3)
+import Web.HTML (HTMLElement)
 import Web.HTML.HTMLElement (DOMRect)
 
 import View.Diagram.Model
@@ -13,11 +14,12 @@ import View.Diagram.Common (snap)
 type State =
   { model                   :: Model -- TODO should perhaps be flattened into this record, ie State and Model should be unified
   , msg                     :: String
-  , boundingClientRectMaybe :: Maybe DOMRect -- ^ Allows us to correct mouse coordinates for the component's position.
+  , componentElemMaybe      :: Maybe HTMLElement
   }
 
 data Query a
-  = MouseAction MouseMsg a
+  = Initialize a
+  | MouseAction MouseMsg a
   | UpdateDiagram Operators a
 
 data MouseMsg

src/View/Diagram/View.purs

@@ -8,32 +8,32 @@ import Data.Monoid (guard)
 import Data.Ord (abs)
 import Data.Vec3 (Vec3, _x, _y, _z, vec2, vec3)
 import Halogen as H
-import Halogen.HTML (HTML, div, pre)
+import Halogen.HTML (HTML)
 import Halogen.HTML as HH
-import Halogen.HTML.Events (onMouseOver, onMouseOut)
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
-import Svg.Attributes (Color(RGB, RGBA), FontSize(..), CSSLength(..))
+import Svg.Attributes (CSSLength(..))
 import Svg.Attributes as SA
 import Svg.Elements (rect)
 import Svg.Elements as SE
 import Svg.Util (domToSvgCoordinates)
-import View.Common (styleStr)
 import View.Diagram.Common
 import View.Diagram.Model
 import View.Diagram.Update
+import Web.HTML (HTMLElement)
 import Web.UIEvent.MouseEvent (clientX, clientY)
 
 -- TODO eliminate?
 type Svg a = HTML Void a
 
-diagramEditorSVG :: Model -> Svg MouseMsg
-diagramEditorSVG model =
+-- TODO: if there is no HTMLElement it does not make sense to draw anything
+diagramEditorSVG :: Maybe HTMLElement -> Model -> Svg MouseMsg
+diagramEditorSVG maybeElement model =
   SE.svg [ SA.viewBox sceneLeft sceneTop w h
          , HP.ref componentRefLabel
-         , HE.onMouseMove $ \e -> Just $ MousePos  (svg e)
-         , HE.onMouseDown $ \e -> Just $ MouseDown (svg e)
-         , HE.onMouseUp   $ \e -> Just $ MouseUp   (svg e)
+         , HE.onMouseMove $ \e -> Just $ MousePos  (svg e maybeElement)
+         , HE.onMouseDown $ \e -> Just $ MouseDown (svg e maybeElement)
+         , HE.onMouseUp   $ \e -> Just $ MouseUp   (svg e maybeElement)
          ]
          (ghosts <> operators)
   where
@@ -42,7 +42,7 @@ diagramEditorSVG model =
     w         = toNumber model.config.width
     h         = toNumber model.config.height
     s         = model.config.scale
-    svg e     = domToSvgCoordinates (vec2 (clientX e) (clientY e))
+    svg e     = maybe zero (\el -> domToSvgCoordinates el (vec2 (clientX e) (clientY e)))
 
     -- TODO ???
     sceneLeft = zero