[graph] implement node scaling when label is scaled

src/Gargantext/Components/GraphExplorer/Toolbar/Controls.purs

@@ -273,6 +273,7 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
             -- search button
             -- search topics
             labelSizeButton { forceAtlasState
+                            , graph
                             , sigmaRef
                             , state: labelSize }
           ]

src/Gargantext/Components/GraphExplorer/Toolbar/SlideButton.purs

@@ -6,6 +6,8 @@ module Gargantext.Components.GraphExplorer.Toolbar.SlideButton
   , mouseSelectorSizeSlider
   ) where
 
+import Data.Array as A
+import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Number as DN
 import Prelude
@@ -15,7 +17,10 @@ import Reactix.DOM.HTML as H
 import Toestand as T
 
 import Gargantext.Components.Bootstrap.Types (ComponentStatus(Disabled))
+import Gargantext.Components.GraphExplorer.Types as GET
+import Gargantext.Components.GraphExplorer.Utils as GEU
 import Gargantext.Hooks.Sigmax as Sigmax
+import Gargantext.Hooks.Sigmax.Graphology as Graphology
 import Gargantext.Hooks.Sigmax.Sigma as Sigma
 import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
 import Gargantext.Utils.Reactix as R2
@@ -68,6 +73,7 @@ sizeButtonCpt = here.component "sizeButton" cpt where
 
 type LabelSizeButtonProps =
   ( forceAtlasState :: T.Box SigmaxTypes.ForceAtlasState
+  , graph           :: T.Box SigmaxTypes.SGraph
   , sigmaRef        :: R.Ref Sigmax.Sigma
   , state           :: T.Box Number)
 
@@ -76,13 +82,19 @@ labelSizeButton = R2.leaf labelSizeButtonCpt
 labelSizeButtonCpt :: R.Component LabelSizeButtonProps
 labelSizeButtonCpt = here.component "labelSizeButton" cpt
   where
-    cpt { forceAtlasState, sigmaRef, state} _ = do
+    cpt { forceAtlasState, graph, sigmaRef, state} _ = do
+      graph' <- T.useLive T.unequal graph
+
+      let minLabelSize = 1.0
+      let maxLabelSize = 30.0
+      let defaultLabelSize = 14.0
+
       pure $ sizeButton {
           state
         , caption: "Label size"
         , forceAtlasState
-        , min: 1.0
-        , max: 30.0
+        , min: minLabelSize
+        , max: maxLabelSize
         , onChange: \e -> do
           let sigma = R.readRef sigmaRef
           let newValue' = DN.fromString $ R.unsafeEventValue e
@@ -90,6 +102,15 @@ labelSizeButtonCpt = here.component "labelSizeButton" cpt
             Nothing -> pure unit
             Just newValue ->
               Sigmax.dependOnSigma sigma "[labelSizeButton] sigma: Nothing" $ \s -> do
+                let ratio = (newValue - minLabelSize) / (defaultLabelSize - minLabelSize)
+                let nodes = SigmaxTypes.graphNodes graph'
+                let nodesResized = (\n@{ size } -> n { size = size * ratio }) <$> nodes
+                let nodesMap = SigmaxTypes.idMap nodesResized
+                Graphology.forEachNode (Sigma.graph s) $ \{ id } -> do
+                  case Map.lookup id nodesMap of
+                    Nothing -> pure unit
+                    Just { size } -> Graphology.mergeNodeAttributes (Sigma.graph s) id { size }
+
                 Sigma.setSettings s {
                     defaultLabelSize: newValue
                   , drawLabels: true

src/Gargantext/Hooks/Sigmax/Graphology.js

@@ -18,6 +18,13 @@ export function _mergeNodeAttributes(g, name, attrs) {
   return g.mergeNodeAttributes(name, attrs);
 }
 
+export function _forEachNode(g, fn) {
+  return g.forEachNode(function(_name, attrs) {
+    // NOTE: fn is an effectful function, it wraps `do` in a separate function
+    return fn(attrs)();
+  })
+}
+
 export function _addEdge(g, source, target, e) {
   //return g.addEdge(source, target, e);
 

src/Gargantext/Hooks/Sigmax/Graphology.purs

@@ -27,6 +27,7 @@ foreign import _addNode :: EffectFn3 Graph String (Record Types.Node) String
 foreign import _updateNode :: EffectFn3 Graph String (Record Types.Node -> Record Types.Node) Unit
 foreign import _addEdge :: EffectFn4 Graph String String (Record Types.Edge) String
 foreign import _mergeNodeAttributes :: forall a. EffectFn3 Graph String a Unit
+foreign import _forEachNode :: EffectFn2 Graph (Record Types.Node -> Effect Unit) Unit
 --foreign import _updateEdge :: EffectFn4 Graph String String (Record Types.Edge) String
 foreign import _mapNodes :: forall a. Fn2 Graph (Record Types.Node -> a) (Array a)
 foreign import _filterNodes :: Fn2 Graph (Record Types.Node -> Boolean) (Array Types.NodeId)
@@ -65,9 +66,7 @@ updateNode g node@{ id, borderColor, color, equilateral, hidden, highlighted, ty
 mergeNodeAttributes :: forall a. Graph -> Types.NodeId -> a -> Effect Unit
 mergeNodeAttributes = runEffectFn3 _mergeNodeAttributes
 forEachNode :: Graph -> (Record Types.Node -> Effect Unit) -> Effect Unit
--- TODO Check this: how does FFI translate function of two arguments
--- into PS \x y ?
-forEachNode g fn = pure $ g ... "forEachNode" $ [\_ n -> fn n]
+forEachNode = runEffectFn2 _forEachNode
 mapNodes :: forall a. Graph -> (Record Types.Node -> a) -> Array a
 mapNodes = runFn2 _mapNodes
 filterNodes :: Graph -> (Record Types.Node -> Boolean) -> Array Types.NodeId

src/Gargantext/Hooks/Sigmax/Types.purs

@@ -9,6 +9,7 @@ import Data.Map as Map
 import Data.Maybe (Maybe(..), fromJust)
 import Data.Sequence as Seq
 import Data.Set as Set
+import Data.Traversable (class Traversable)
 import Data.Tuple (Tuple(..))
 import Partial.Unsafe (unsafePartial)
 import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), (<), mod, not)
@@ -107,19 +108,20 @@ graphEdges (Graph {edges}) = edges
 graphNodes :: SGraph -> Seq.Seq (Record Node)
 graphNodes (Graph {nodes}) = nodes
 
+idMap :: forall r t. Traversable t => t { id :: String | r } -> Map.Map String { id :: String | r }
+idMap xs = Map.fromFoldable $ (\x@{ id } -> Tuple id x) <$> xs
+
 edgesGraphMap :: SGraph -> EdgesMap
-edgesGraphMap graph =
-  Map.fromFoldable $ map (\e -> Tuple e.id e) $ graphEdges graph
+edgesGraphMap graph = idMap $ graphEdges graph
 
 edgesFilter :: (Record Edge -> Boolean) -> SGraph -> SGraph
 edgesFilter f (Graph {edges, nodes}) = Graph { edges: Seq.filter f edges, nodes }
 
 nodesMap :: Seq.Seq (Record Node) -> NodesMap
-nodesMap nodes = Map.fromFoldable $ map (\n -> Tuple n.id n) nodes
+nodesMap = idMap
 
 nodesGraphMap :: SGraph -> NodesMap
-nodesGraphMap graph =
-  nodesMap $ graphNodes graph
+nodesGraphMap graph = idMap $ graphNodes graph
 
 nodesFilter :: (Record Node -> Boolean) -> SGraph -> SGraph
 nodesFilter f (Graph {edges, nodes}) = Graph { edges, nodes: Seq.filter f nodes }