RangeSlider.purs 9.07 KB
Newer Older
1 2 3 4 5 6 7 8
-- | 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

9
import Data.Generic.Rep (class Generic)
10
import Data.Eq.Generic (genericEq)
11 12
import Data.Int (fromNumber)
import Data.Maybe (Maybe(..), fromMaybe)
13
import Data.Number as DN
14
import Data.Nullable (Nullable, null)
15
import Data.Traversable (traverse_)
16
import DOM.Simple as DOM
17
import DOM.Simple.Document (document)
18
import DOM.Simple.Event as Event
19
import DOM.Simple.EventListener as EL
20
import DOM.Simple (DOMRect)
21
import Global (toFixed)
22
import Effect (Effect)
23
import Reactix as R
24
import Reactix.DOM.HTML as H
25 26 27
import Toestand as T

import Gargantext.Prelude
28 29 30 31

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

33
here :: R2.Here
34
here = R2.here "Gargantext.Components.RangeSlider"
35 36
-- data Axis = X | Y

37
type Bounds = Range.NumberRange
38
type Epsilon = Number
39

40 41 42 43
-- 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 =
44
  ( bounds :: Bounds                  -- The minimum and maximum values it is possible to select
45
  , initialValue :: Range.NumberRange -- The user's selection of minimum and maximum values
46 47 48
  , epsilon :: Number                 -- The smallest possible change (for mouse)
  , step :: Number                    -- The 'standard' change (for keyboard)
  -- , axis :: Axis                   -- Which direction to move in
49 50
  , width :: Number
  , height :: Number
51
  , onChange :: Range.NumberRange -> Effect Unit )
52

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

data Knob = MinKnob | MaxKnob
57 58
derive instance Generic Knob _
instance Eq Knob where
59
  eq = genericEq
60 61 62

data RangeUpdate = SetMin Number | SetMax Number

63
rangeSliderCpt :: R.Component Props
64
rangeSliderCpt = here.component "rangeSlider" cpt
65 66
  where
    cpt props _ = do
67
      -- rounding precision (i.e. how many decimal digits are in epsilon)
68
      let precision = fromMaybe 0 $ fromNumber $ max 0.0 $ - DN.floor $ (DN.log props.epsilon) / DN.ln10
69

70
      -- scale bar
71
      scaleElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
72 73
      -- scale sel bar
      scaleSelElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
74
      -- low knob
75
      lowElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the low knob
76
      -- high knob
77
      highElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the high knob
78
      -- The value of the user's selection
79 80
      value <- T.useBox $ initialValue props
      value' <- T.useLive T.unequal value
81 82

      -- the knob we are currently in a drag for. set by mousedown on a knob
83 84
      dragKnob <- T.useBox (Nothing :: Maybe Knob)
      dragKnob' <- T.useLive T.unequal dragKnob
85

86
      -- the handler functions for trapping mouse events, so they can be removed
87 88
      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)))
89 90 91 92 93
      let destroy = \_ -> do
            destroyEventHandler "mousemove" mouseMoveHandler
            destroyEventHandler "mouseup" mouseUpHandler
            R.setRef mouseMoveHandler $ Nothing
            R.setRef mouseUpHandler $ Nothing
94

95
      R2.useLayoutEffect1' dragKnob' $ \_ -> do
96 97 98
        let scalePos = R2.readPositionRef scaleElem
        let lowPos = R2.readPositionRef lowElem
        let highPos = R2.readPositionRef highElem
99

100
        case dragKnob' of
101
          Just knob -> do
102
            let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange
103

104
            let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do
105
                  case reproject drag scalePos props.bounds props.epsilon (R2.domMousePosition event) of
106
                    Just val -> do
107 108
                      setKnob knob value value' val
                      props.onChange $ knobSetter knob value' val
109
                    Nothing -> destroy unit
110
            let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do
111
                  --props.onChange $ knobSetter knob value val
112
                  T.write_ Nothing dragKnob
113
                  destroy unit
114 115
            EL.addEventListener document "mousemove" onMouseMove
            EL.addEventListener document "mouseup" onMouseUp
116 117
            R.setRef mouseMoveHandler $ Just onMouseMove
            R.setRef mouseUpHandler $ Just onMouseUp
118
          Nothing -> destroy unit
119
      pure $ H.div { className, aria }
120 121 122 123
        [ renderScale scaleElem props value'
        , renderScaleSel scaleSelElem props value'
        , renderKnob MinKnob lowElem  value' props.bounds dragKnob precision
        , renderKnob MaxKnob highElem value' props.bounds dragKnob precision
124 125 126 127
        ]
    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." }

128 129 130 131
destroyEventHandler
  :: forall e
  .  Event.IsEvent e
  => String -> R.Ref (Maybe (EL.Callback e)) -> Effect Unit
132
destroyEventHandler name ref = traverse_ destroy $ R.readRef ref
133 134 135 136
  where
    destroy handler = do
      EL.removeEventListener document name handler
      R.setRef ref Nothing
137

138 139
setKnob :: Knob -> T.Box Range.NumberRange -> Range.NumberRange -> Number -> Effect Unit
setKnob knob value r val = T.write_ (knobSetter knob r val) value
140 141 142 143

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

145
getDragScale :: Knob -> Maybe DOMRect -> Maybe DOMRect -> Maybe DOMRect -> Maybe Range.NumberRange
146
getDragScale knob scalePos lowPos highPos = do
147 148 149 150
  scale <- scalePos
  low <- lowPos
  high <- highPos
  pure $ Range.Closed { min: min knob scale low, max: max knob scale high }
151
  where
152 153 154 155
    min MinKnob scale _ = scale.left
    min MaxKnob _ low = low.left
    max MinKnob _ high = high.left
    max MaxKnob scale _ = scale.right
156

157 158
renderScale :: R.Ref (Nullable DOM.Element) -> Record Props -> Range.NumberRange -> R.Element
renderScale ref {width,height} (Range.Closed {min, max}) =
159
   H.div { ref, className, width, height, aria } []
160
  where
arturo's avatar
arturo committed
161
    className = "range-slider__scale"
162
    aria = { label: "Scale running from " <> show min <> " to " <> show max }
163 164 165 166 167

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
arturo's avatar
arturo committed
168
    className = "range-slider__scale-sel"
169 170 171 172 173 174
    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)) <> "%"

175

176
renderKnob :: Knob -> R.Ref (Nullable DOM.Element) -> Range.NumberRange -> Bounds -> T.Box (Maybe Knob) -> Int -> R.Element
177
renderKnob knob ref (Range.Closed value) bounds set precision =
178
  H.div { ref, tabIndex, className, aria, on: { mouseDown: onMouseDown }, style } [
arturo's avatar
arturo committed
179
      H.div { className: "range-slider__placeholder" }
180 181 182
        [
          H.text $ text $ toFixed precision val
        ]
183
  ]
184
  where
185
    text (Just num) = num
186
    text Nothing = "error"
187
    tabIndex = 0
arturo's avatar
arturo committed
188
    className = "range-slider__knob"
189 190 191
    aria = { label: labelPrefix knob <> "value: " <> show val }
    labelPrefix MinKnob = "Minimum "
    labelPrefix MaxKnob = "Maximum "
192
    onMouseDown _ = T.write_ (Just knob) set
193 194
    percOffset = Range.normalise bounds val
    style = { left: (show $ 100.0 * percOffset) <> "%" }
195 196 197
    val = case knob of
      MinKnob -> value.min
      MaxKnob -> value.max
198

199
-- TODO round to nearest epsilon
200 201
reproject :: Maybe Range.NumberRange -> Maybe DOMRect -> Bounds -> Epsilon -> R2.Point -> Maybe Number
reproject drag scalePos bounds epsilon (R2.Point mousePos) = do
202
  drag_ <- drag
203
  scale_ <- rectRange <$> scalePos
204
  let normal = Range.normalise scale_ (Range.clamp drag_ mousePos.x)
205 206
  let val = Range.projectNormal bounds normal
  pure $ round epsilon bounds val
207

208
rectRange :: DOMRect -> Range.NumberRange
209 210 211
rectRange rect = Range.Closed { min, max }
  where min = rect.left
        max = rect.right
212

213
initialValue :: Record Props -> Range.NumberRange
214
initialValue props = roundRange props.epsilon props.bounds props.initialValue
215

216
round :: Epsilon -> Bounds -> Number -> Number
217 218
round epsilon bounds = roundToMultiple epsilon <<< Range.clamp bounds

219
roundRange :: Epsilon -> Bounds -> Range.NumberRange -> Range.NumberRange
220 221 222
roundRange epsilon bounds (Range.Closed initial) = Range.Closed { min, max }
  where min = round epsilon bounds initial.min
        max = round epsilon bounds initial.max