RangeSlider.purs 8.79 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
-- data Axis = X | Y

32
type Bounds = Range.NumberRange
33
type Epsilon = Number
34

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

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

data Knob = MinKnob | MaxKnob

data RangeUpdate = SetMin Number | SetMax Number

55
rangeSliderCpt :: R.Component Props
56 57 58
rangeSliderCpt = R.hooksComponent "RangeSlider" cpt
  where
    cpt props _ = do
59 60 61
      -- 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

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

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

76
      -- the handler functions for trapping mouse events, so they can be removed
77 78
      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)))
79 80 81 82 83
      let destroy = \_ -> do
            destroyEventHandler "mousemove" mouseMoveHandler
            destroyEventHandler "mouseup" mouseUpHandler
            R.setRef mouseMoveHandler $ Nothing
            R.setRef mouseUpHandler $ Nothing
84

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

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

94
            let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do
95
                  case reproject drag scalePos props.bounds props.epsilon (R2.domMousePosition event) of
96
                    Just val -> do
97
                      setKnob knob setValue value val
98
                      props.onChange $ knobSetter knob value val
99
                    Nothing -> destroy unit
100
            let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do
101
                  --props.onChange $ knobSetter knob value val
102 103
                  setDragKnob $ const Nothing
                  destroy unit
104 105
            EL.addEventListener document "mousemove" onMouseMove
            EL.addEventListener document "mouseup" onMouseUp
106 107
            R.setRef mouseMoveHandler $ Just onMouseMove
            R.setRef mouseUpHandler $ Just onMouseUp
108
          Nothing -> destroy unit
109
      pure $ H.div { className, aria }
110
        [ renderScale scaleElem props value
111
        , renderScaleSel scaleSelElem props value
112 113
        , renderKnob MinKnob lowElem  value props.bounds setDragKnob precision
        , renderKnob MaxKnob highElem value props.bounds setDragKnob precision
114 115 116 117
        ]
    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." }

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

128
setKnob :: Knob -> R2.Setter Range.NumberRange -> Range.NumberRange -> Number -> Effect Unit
129 130 131 132 133
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
134

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

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

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)) <> "%"

165

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

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

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

203
initialValue :: Record Props -> Range.NumberRange
204
initialValue props = roundRange props.epsilon props.bounds props.initialValue
205

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

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