RangeSlider.purs 8.86 KB
Newer Older
1 2 3 4 5 6 7 8 9
-- | The RangeSlider is a slider component with two knobs, allowing
-- | the user to specify both a minimum and maximum value to filter
-- | data by. It may be dragged with the mouse or moved with the
-- | keyboard like a regular slider component.  The RangeSlider is
-- | designed to let the user adjust in multiples of a provided
-- | epsilon (smallest difference)
module Gargantext.Components.RangeSlider where

import Prelude
10 11
import Data.Int (fromNumber)
import Data.Maybe (Maybe(..), fromMaybe)
12
import Data.Nullable (Nullable, null)
13
import Data.Traversable (traverse_)
14
import Data.Tuple.Nested ((/\))
15
import DOM.Simple as DOM
16
import DOM.Simple.Document (document)
17
import DOM.Simple.Event as Event
18
import DOM.Simple.EventListener as EL
19
import DOM.Simple (DOMRect)
20
import Global (toFixed)
21
import Effect (Effect)
22
import Effect.Uncurried (mkEffectFn1)
23
import Math as M
24
import Reactix as R
25
import Reactix.DOM.HTML as H
26 27 28 29

import Gargantext.Utils.Math (roundToMultiple)
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
30 31

thisModule = "Gargantext.Components.RangeSlider"
32 33
-- data Axis = X | Y

34
type Bounds = Range.NumberRange
35
type Epsilon = Number
36

37 38 39 40
-- To avoid overloading the terms 'min' and 'max' here, we treat 'min'
-- and 'max' as being the bounds of the scale and 'low' and 'high' as
-- being the selected values
type Props =
41
  ( bounds :: Bounds                  -- The minimum and maximum values it is possible to select
42
  , initialValue :: Range.NumberRange -- The user's selection of minimum and maximum values
43 44 45
  , epsilon :: Number                 -- The smallest possible change (for mouse)
  , step :: Number                    -- The 'standard' change (for keyboard)
  -- , axis :: Axis                   -- Which direction to move in
46 47
  , width :: Number
  , height :: Number
48
  , onChange :: Range.NumberRange -> Effect Unit )
49

50 51
rangeSlider :: Record Props -> R.Element
rangeSlider props = R.createElement rangeSliderCpt props []
52 53 54 55 56

data Knob = MinKnob | MaxKnob

data RangeUpdate = SetMin Number | SetMax Number

57
rangeSliderCpt :: R.Component Props
58
rangeSliderCpt = R.hooksComponentWithModule thisModule "rangeSlider" cpt
59 60
  where
    cpt props _ = do
61 62 63
      -- rounding precision (i.e. how many decimal digits are in epsilon)
      let precision = fromMaybe 0 $ fromNumber $ max 0.0 $ - M.floor $ (M.log props.epsilon) / M.ln10

64
      -- scale bar
65
      scaleElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
66 67
      -- scale sel bar
      scaleSelElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
68
      -- low knob
69
      lowElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the low knob
70
      -- high knob
71
      highElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the high knob
72
      -- The value of the user's selection
73
      value /\ setValue <- R.useState' $ initialValue props
74 75

      -- the knob we are currently in a drag for. set by mousedown on a knob
76
      dragKnob /\ setDragKnob <- R.useState' $ (Nothing :: Maybe Knob)
77

78
      -- the handler functions for trapping mouse events, so they can be removed
79 80
      mouseMoveHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
      mouseUpHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
81 82 83 84 85
      let destroy = \_ -> do
            destroyEventHandler "mousemove" mouseMoveHandler
            destroyEventHandler "mouseup" mouseUpHandler
            R.setRef mouseMoveHandler $ Nothing
            R.setRef mouseUpHandler $ Nothing
86

87
      R2.useLayoutEffect1' dragKnob $ \_ -> do
88 89 90
        let scalePos = R2.readPositionRef scaleElem
        let lowPos = R2.readPositionRef lowElem
        let highPos = R2.readPositionRef highElem
91

92 93
        case dragKnob of
          Just knob -> do
94
            let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange
95

96
            let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do
97
                  case reproject drag scalePos props.bounds props.epsilon (R2.domMousePosition event) of
98
                    Just val -> do
99
                      setKnob knob setValue value val
100
                      props.onChange $ knobSetter knob value val
101
                    Nothing -> destroy unit
102
            let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do
103
                  --props.onChange $ knobSetter knob value val
104 105
                  setDragKnob $ const Nothing
                  destroy unit
106 107
            EL.addEventListener document "mousemove" onMouseMove
            EL.addEventListener document "mouseup" onMouseUp
108 109
            R.setRef mouseMoveHandler $ Just onMouseMove
            R.setRef mouseUpHandler $ Just onMouseUp
110
          Nothing -> destroy unit
111
      pure $ H.div { className, aria }
112
        [ renderScale scaleElem props value
113
        , renderScaleSel scaleSelElem props value
114 115
        , renderKnob MinKnob lowElem  value props.bounds setDragKnob precision
        , renderKnob MaxKnob highElem value props.bounds setDragKnob precision
116 117 118 119
        ]
    className = "range-slider"
    aria = { label: "Range Slider Control. Expresses filtering data by a minimum and maximum value range through two slider knobs. Knobs can be adjusted with the arrow keys." }

120 121 122 123
destroyEventHandler
  :: forall e
  .  Event.IsEvent e
  => String -> R.Ref (Maybe (EL.Callback e)) -> Effect Unit
124
destroyEventHandler name ref = traverse_ destroy $ R.readRef ref
125 126 127 128
  where
    destroy handler = do
      EL.removeEventListener document name handler
      R.setRef ref Nothing
129

130
setKnob :: Knob -> R.Setter Range.NumberRange -> Range.NumberRange -> Number -> Effect Unit
131 132 133 134 135
setKnob knob setValue r val = setValue $ const $ knobSetter knob r val

knobSetter :: Knob -> Range.NumberRange -> Number -> Range.NumberRange
knobSetter MinKnob = Range.withMin
knobSetter MaxKnob = Range.withMax
136

137
getDragScale :: Knob -> Maybe DOMRect -> Maybe DOMRect -> Maybe DOMRect -> Maybe Range.NumberRange
138
getDragScale knob scalePos lowPos highPos = do
139 140 141 142
  scale <- scalePos
  low <- lowPos
  high <- highPos
  pure $ Range.Closed { min: min knob scale low, max: max knob scale high }
143
  where
144 145 146 147
    min MinKnob scale _ = scale.left
    min MaxKnob _ low = low.left
    max MinKnob _ high = high.left
    max MaxKnob scale _ = scale.right
148

149 150
renderScale :: R.Ref (Nullable DOM.Element) -> Record Props -> Range.NumberRange -> R.Element
renderScale ref {width,height} (Range.Closed {min, max}) =
151
   H.div { ref, className, width, height, aria } []
152 153 154
  where
    className = "scale"
    aria = { label: "Scale running from " <> show min <> " to " <> show max }
155 156 157 158 159 160 161 162 163 164 165 166

renderScaleSel :: R.Ref (Nullable DOM.Element) -> Record Props -> Range.NumberRange -> R.Element
renderScaleSel ref props (Range.Closed {min, max}) =
    H.div { ref, className, style} []
  where
    className = "scale-sel"
    style = {left: computeLeft, width: computeWidth}
    percOffsetMin = Range.normalise props.bounds min
    percOffsetMax = Range.normalise props.bounds max
    computeLeft = (show $ 100.0 * percOffsetMin) <> "%"
    computeWidth = (show $ 100.0 * (percOffsetMax - percOffsetMin)) <> "%"

167

168
renderKnob :: Knob -> R.Ref (Nullable DOM.Element) -> Range.NumberRange -> Bounds -> R.Setter (Maybe Knob) -> Int -> R.Element
169
renderKnob knob ref (Range.Closed value) bounds set precision =
170
  H.div { ref, tabIndex, className, aria, on: { mouseDown: onMouseDown }, style } [
171 172 173 174
      H.div { className: "button" }
        [
          H.text $ text $ toFixed precision val
        ]
175
  ]
176
  where
177
    text (Just num) = num
178
    text Nothing = "error"
179
    tabIndex = 0
180
    className = "knob"
181 182 183
    aria = { label: labelPrefix knob <> "value: " <> show val }
    labelPrefix MinKnob = "Minimum "
    labelPrefix MaxKnob = "Maximum "
184
    onMouseDown _ = set $ const $ Just knob
185 186
    percOffset = Range.normalise bounds val
    style = { left: (show $ 100.0 * percOffset) <> "%" }
187 188 189
    val = case knob of
      MinKnob -> value.min
      MaxKnob -> value.max
190

191
-- TODO round to nearest epsilon
192 193
reproject :: Maybe Range.NumberRange -> Maybe DOMRect -> Bounds -> Epsilon -> R2.Point -> Maybe Number
reproject drag scalePos bounds epsilon (R2.Point mousePos) = do
194
  drag_ <- drag
195
  scale_ <- rectRange <$> scalePos
196
  let normal = Range.normalise scale_ (Range.clamp drag_ mousePos.x)
197 198
  let val = Range.projectNormal bounds normal
  pure $ round epsilon bounds val
199

200
rectRange :: DOMRect -> Range.NumberRange
201 202 203
rectRange rect = Range.Closed { min, max }
  where min = rect.left
        max = rect.right
204

205
initialValue :: Record Props -> Range.NumberRange
206
initialValue props = roundRange props.epsilon props.bounds props.initialValue
207

208
round :: Epsilon -> Bounds -> Number -> Number
209 210
round epsilon bounds = roundToMultiple epsilon <<< Range.clamp bounds

211
roundRange :: Epsilon -> Bounds -> Range.NumberRange -> Range.NumberRange
212 213 214 215
roundRange epsilon bounds (Range.Closed initial) = Range.Closed { min, max }
  where min = round epsilon bounds initial.min
        max = round epsilon bounds initial.max