SlideButton.purs 6.13 KB
Newer Older
arturo's avatar
arturo committed
1
module Gargantext.Components.GraphExplorer.Toolbar.SlideButton
2 3 4
  ( Props
  , sizeButton
  , labelSizeButton
5
  , labelRenderedSizeThresholdButton
6
  , mouseSelectorSizeSlider
7 8
  ) where

9
import Data.Map as Map
10 11
import Data.Maybe (Maybe(..))
import Data.Number as DN
12
import Prelude
13
import Effect (Effect)
14 15
import Reactix as R
import Reactix.DOM.HTML as H
16
import Toestand as T
17

18
import Gargantext.Components.Bootstrap.Types (ComponentStatus(Disabled))
19
import Gargantext.Hooks.Sigmax as Sigmax
20
import Gargantext.Hooks.Sigmax.Graphology as Graphology
21
import Gargantext.Hooks.Sigmax.Sigma as Sigma
22
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
23 24
import Gargantext.Utils.Reactix as R2

25
here :: R2.Here
arturo's avatar
arturo committed
26
here = R2.here "Gargantext.Components.GraphExplorer.Toolbar.SlideButton"
27

28
type Props =
29 30 31 32 33 34
  ( caption         :: String
  , forceAtlasState :: T.Box SigmaxTypes.ForceAtlasState
  , min             :: Number
  , max             :: Number
  , onChange        :: forall e. e -> Effect Unit
  , state           :: T.Box Number
35
  )
36 37 38 39

sizeButton :: Record Props -> R.Element
sizeButton props = R.createElement sizeButtonCpt props []
sizeButtonCpt :: R.Component Props
40
sizeButtonCpt = here.component "sizeButton" cpt where
41
  cpt { state, caption, forceAtlasState, min, max, onChange } _ = do
42
    defaultValue <- T.useLive T.unequal state
43 44 45
    forceAtlasState' <- R2.useLive' forceAtlasState

    let status = SigmaxTypes.forceAtlasComponentStatus forceAtlasState'
arturo's avatar
arturo committed
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65

    pure $

      H.span
      { className: "range-simple" }
      [
        H.label
        { className: "range-simple__label" }
        [ H.text caption ]
      ,
        H.span
        { className: "range-simple__field" }
        [
          H.input
          { type: "range"
          , min: show min
          , max: show max
          , defaultValue
          , on: { input: onChange }
          , className: "range-simple__input"
66
          , disabled: status == Disabled
arturo's avatar
arturo committed
67 68 69
          }
        ]
      ]
70

71 72
type LabelSizeButtonProps =
  ( forceAtlasState :: T.Box SigmaxTypes.ForceAtlasState
73
  , graph           :: T.Box SigmaxTypes.SGraph
74 75
  , sigmaRef        :: R.Ref Sigmax.Sigma
  , state           :: T.Box Number)
76 77 78 79 80 81

labelSizeButton :: R2.Leaf LabelSizeButtonProps
labelSizeButton = R2.leaf labelSizeButtonCpt
labelSizeButtonCpt :: R.Component LabelSizeButtonProps
labelSizeButtonCpt = here.component "labelSizeButton" cpt
  where
82 83 84 85 86 87 88
    cpt { forceAtlasState, graph, sigmaRef, state} _ = do
      graph' <- T.useLive T.unequal graph

      let minLabelSize = 1.0
      let maxLabelSize = 30.0
      let defaultLabelSize = 14.0

89 90 91 92
      pure $ sizeButton {
          state
        , caption: "Label size"
        , forceAtlasState
93 94
        , min: minLabelSize
        , max: maxLabelSize
95 96 97 98 99 100 101
        , onChange: \e -> do
          let sigma = R.readRef sigmaRef
          let newValue' = DN.fromString $ R.unsafeEventValue e
          case newValue' of
            Nothing -> pure unit
            Just newValue ->
              Sigmax.dependOnSigma sigma "[labelSizeButton] sigma: Nothing" $ \s -> do
102 103 104 105 106 107 108 109 110
                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 }

111 112 113 114
                Sigma.setSettings s {
                    defaultLabelSize: newValue
                  , drawLabels: true
                  , labelSize: newValue
115
                  -- , maxNodeSize: newValue / 2.5
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
                    --, labelSizeRatio: newValue / 2.5
                  }
                T.write_ newValue state
        }

type LabelRenderedSizeThresholdButtonProps =
  ( forceAtlasState :: T.Box SigmaxTypes.ForceAtlasState
  , sigmaRef :: R.Ref Sigmax.Sigma
  , state    :: T.Box Number)

labelRenderedSizeThresholdButton :: R2.Leaf LabelRenderedSizeThresholdButtonProps
labelRenderedSizeThresholdButton = R2.leaf labelRenderedSizeThresholdButtonCpt
labelRenderedSizeThresholdButtonCpt :: R.Component LabelRenderedSizeThresholdButtonProps
labelRenderedSizeThresholdButtonCpt = here.component "labelRenderedSizeThresholdButton" cpt
  where
    cpt { forceAtlasState, sigmaRef, state} _ = do
      pure $ sizeButton {
        state
        , caption: "Label rendered size threshold"
        , forceAtlasState
        , min: 0.0
        , max: 10.0
        , onChange: \e -> do
          let sigma = R.readRef sigmaRef
          let newValue' = DN.fromString $ R.unsafeEventValue e
          case newValue' of
            Nothing -> pure unit
            Just newValue ->
              Sigmax.dependOnSigma sigma "[labelRenderdSizeThresholdButton] sigma: Nothing" $ \s -> do
                Sigma.setSettings s {
                  labelRenderedSizeThreshold: newValue
                  }
                T.write_ newValue state
        }
150

151 152 153 154
type MouseSelectorSizeSliderProps =
  ( forceAtlasState :: T.Box SigmaxTypes.ForceAtlasState
  , sigmaRef :: R.Ref Sigmax.Sigma
  , state    :: T.Box Number)
155

156 157 158 159 160 161 162 163 164 165
mouseSelectorSizeSlider :: R2.Leaf MouseSelectorSizeSliderProps
mouseSelectorSizeSlider = R2.leaf mouseSelectorSizeSliderCpt
mouseSelectorSizeSliderCpt :: R.Component MouseSelectorSizeSliderProps
mouseSelectorSizeSliderCpt = here.component "mouseSelectorSizeSlider" cpt
  where
    cpt { forceAtlasState, sigmaRef, state } _ = do
      pure $ sizeButton {
          caption: "Selector size (Shift + wheel)"
        , forceAtlasState
        , min: 1.0
166
        , max: 100.0
167 168 169 170 171 172 173 174 175 176 177 178 179
        , onChange: \e -> do
          let sigma = R.readRef sigmaRef
          let newValue' = DN.fromString $ R.unsafeEventValue e
          case newValue' of
            Nothing -> pure unit
            Just newValue ->
              Sigmax.dependOnSigma sigma "[mouseSelectorSizeButton] sigma: Nothing" $ \s -> do
                Sigma.setSettings s {
                  mouseSelectorSize: newValue
                  }
                T.write_ newValue state
        , state
        }