[sidebar] tag cloud for neighbour badges

Rescale the font-size according to the log of node.size (node.score).

src/Gargantext/Components/GraphExplorer/Sidebar.purs

@@ -33,6 +33,7 @@ import Gargantext.Sessions (Session)
 import Gargantext.Types (CTabNgramType, FrontendError(..), NodeID, TabSubType(..), TabType(..), TermList(..), modeTabType)
 import Gargantext.Utils.Reactix as R2
 import Gargantext.Utils.Toestand as T2
+import Math as Math
 import Partial.Unsafe (unsafePartial)
 import Reactix as R
 import Reactix.DOM.HTML as H
@@ -182,6 +183,8 @@ selectedNodesCpt = here.component "selectedNodes" cpt
       { selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
       selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
 
+      let badges' = neighbourBadges graph selectedNodeIds'
+
       pure $ R2.row
         [ R2.col 12
           [ RH.ul { className: "nav nav-tabs d-flex justify-content-center"
@@ -191,9 +194,7 @@ selectedNodesCpt = here.component "selectedNodes" cpt
               [ RH.div { className: "d-flex flex-wrap justify-content-center"
                        , role: "tabpanel" }
                 ( Seq.toUnfoldable
-                  $ ( Seq.map (badge selectedNodeIds)
-                      (badges graph selectedNodeIds')
-                    )
+                  $ ( Seq.map (\node -> badge { node, selectedNodeIds }) badges')
                 )
               , H.br {}
               ]
@@ -225,15 +226,15 @@ neighborhoodCpt = here.component "neighborhood" cpt
       { selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
       selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
 
+      let badges' = neighbourBadges graph selectedNodeIds'
+
       pure $ RH.div { className: "tab-content", id: "myTabContent" }
         [ RH.div { -- className: "flex-space-around d-flex justify-content-center"
              className: "d-flex flex-wrap flex-space-around"
              , id: "home"
              , role: "tabpanel"
              }
-          (Seq.toUnfoldable $ Seq.map (badge selectedNodeIds)
-           $ neighbourBadges graph selectedNodeIds'
-          )
+          (Seq.toUnfoldable $ Seq.map (\node -> badge { node, selectedNodeIds }) badges')
         ]
 
 
@@ -284,15 +285,26 @@ updateTermButtonCpt = here.component "updateTermButton" cpt
           T.write_ SigmaxT.emptyNodeIds selectedNodeIds
 
 
-
-badge :: T.Box SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
-badge selectedNodeIds {id, label} =
-  RH.a { className: "badge badge-pill badge-light"
-       , on: { click: onClick }
-       } [ RH.h6 {} [ RH.text label ] ]
-  where
-    onClick _ = do
-      T.write_ (Set.singleton id) selectedNodeIds
+type BadgeProps =
+  ( node :: Record SigmaxT.Node
+  , selectedNodeIds :: T.Box SigmaxT.NodeIds )
+
+badge :: R2.Leaf BadgeProps
+badge props = R.createElement badgeCpt props []
+badgeCpt :: R.Component BadgeProps
+badgeCpt = here.component "badge" cpt where
+  cpt { node: { id, label, size }, selectedNodeIds } _ = do
+    let scale = Math.max 1.0 (Math.log size)
+    let style = {
+          fontSize: show scale <> "em"
+          }
+    
+    pure $ RH.a { className: "badge badge-pill badge-light"
+                , on: { click: onClick }
+                } [ RH.h6 { style } [ RH.text label ] ]
+    where
+      onClick _ = do
+        T.write_ (Set.singleton id) selectedNodeIds
 
 badges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
 badges graph selectedNodeIds = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds