RangeSlider.purs 9.96 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
import Data.Foldable (maximum)
12 13
import Data.Int (fromNumber)
import Data.Maybe (Maybe(..), fromMaybe)
14
import Data.Number as DN
15
import Data.Number.Format as DNF
16
import Data.Nullable (Nullable, null)
17
import Data.Traversable (traverse_)
18
import DOM.Simple as DOM
19
import DOM.Simple.Document (document)
20
import DOM.Simple.Event as Event
21
import DOM.Simple.EventListener as EL
22
import DOM.Simple (DOMRect)
23
import Effect (Effect)
24
import Reactix as R
25
import Reactix.DOM.HTML as H
26 27 28
import Toestand as T

import Gargantext.Prelude
29

30
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
31 32 33
import Gargantext.Utils.Math (roundToMultiple)
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
34

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

39
type Bounds = Range.NumberRange
40
type Epsilon = Number
41

42 43 44 45
-- 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 =
46
  ( bounds       :: Bounds                  -- The minimum and maximum values it is possible to select
47
  , initialValue :: Range.NumberRange -- The user's selection of minimum and maximum values
48 49 50 51 52 53 54
  , epsilon      :: Number                 -- The smallest possible change (for mouse)
  , step         :: Number                    -- The 'standard' change (for keyboard)
  -- , axis      :: Axis                   -- Which direction to move in
  , width        :: Number
  , height       :: Number
  , onChange     :: Range.NumberRange -> Effect Unit
  , status       :: ComponentStatus )
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 64
rangeSlider :: Record Props -> R.Element
rangeSlider props = R.createElement rangeSliderCpt props []
65
rangeSliderCpt :: R.Component Props
66
rangeSliderCpt = here.component "rangeSlider" cpt
67 68
  where
    cpt props _ = do
69
      -- rounding precision (i.e. how many decimal digits are in epsilon)
70 71 72 73 74 75 76 77 78 79 80
      let (Range.Closed { min: minR, max: maxR }) = props.initialValue
      let decPrecision num =
            -- int digits
            (fromMaybe 0 $ fromNumber $ DN.ceil $ (DN.log num) / DN.ln10)
            -- float digits
            + (fromMaybe 0 $ fromNumber $ DN.ceil $ -(DN.log (num - (DN.floor num))) / DN.ln10)
      let epsilonPrecision = decPrecision props.epsilon
      let minPrecision = decPrecision minR
      let maxPrecision = decPrecision maxR
      --let precision = fromMaybe 0 $ fromNumber $ max 0.0 epsilonPrecision
      let precision = fromMaybe 0 $ maximum [0, epsilonPrecision, minPrecision, maxPrecision]
81

82
      -- scale bar
83
      scaleElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
84 85
      -- scale sel bar
      scaleSelElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
86
      -- low knob
87
      lowElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the low knob
88
      -- high knob
89
      highElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the high knob
90
      -- The value of the user's selection
91 92
      value <- T.useBox $ initialValue props
      value' <- T.useLive T.unequal value
93 94

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

98
      -- the handler functions for trapping mouse events, so they can be removed
99 100
      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)))
101 102 103 104 105
      let destroy = \_ -> do
            destroyEventHandler "mousemove" mouseMoveHandler
            destroyEventHandler "mouseup" mouseUpHandler
            R.setRef mouseMoveHandler $ Nothing
            R.setRef mouseUpHandler $ Nothing
106

107
      R2.useLayoutEffect1' dragKnob' $ \_ -> do
108 109 110
        let scalePos = R2.readPositionRef scaleElem
        let lowPos = R2.readPositionRef lowElem
        let highPos = R2.readPositionRef highElem
111

112
        case dragKnob' of
113
          Just knob -> do
114
            let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange
115

116
            let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do
117
                  case reproject drag scalePos props.bounds props.epsilon (R2.domMousePosition event) of
118
                    Just val -> do
119 120
                      setKnob knob value value' val
                      props.onChange $ knobSetter knob value' val
121
                    Nothing -> destroy unit
122
            let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do
123
                  --props.onChange $ knobSetter knob value val
124
                  T.write_ Nothing dragKnob
125
                  destroy unit
126 127
            EL.addEventListener document "mousemove" onMouseMove
            EL.addEventListener document "mouseup" onMouseUp
128 129
            R.setRef mouseMoveHandler $ Just onMouseMove
            R.setRef mouseUpHandler $ Just onMouseUp
130
          Nothing -> destroy unit
131
      pure $ H.div { className, aria }
132 133
        [ renderScale scaleElem props value'
        , renderScaleSel scaleSelElem props value'
134 135
        , renderKnob MinKnob lowElem  value' props.bounds dragKnob precision props.status
        , renderKnob MaxKnob highElem value' props.bounds dragKnob precision props.status
136 137 138 139
        ]
    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." }

140 141 142 143
destroyEventHandler
  :: forall e
  .  Event.IsEvent e
  => String -> R.Ref (Maybe (EL.Callback e)) -> Effect Unit
144
destroyEventHandler name ref = traverse_ destroy $ R.readRef ref
145 146 147 148
  where
    destroy handler = do
      EL.removeEventListener document name handler
      R.setRef ref Nothing
149

150 151
setKnob :: Knob -> T.Box Range.NumberRange -> Range.NumberRange -> Number -> Effect Unit
setKnob knob value r val = T.write_ (knobSetter knob r val) value
152 153 154 155

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

157
getDragScale :: Knob -> Maybe DOMRect -> Maybe DOMRect -> Maybe DOMRect -> Maybe Range.NumberRange
158
getDragScale knob scalePos lowPos highPos = do
159 160 161 162
  scale <- scalePos
  low <- lowPos
  high <- highPos
  pure $ Range.Closed { min: min knob scale low, max: max knob scale high }
163
  where
164 165 166 167
    min MinKnob scale _ = scale.left
    min MaxKnob _ low = low.left
    max MinKnob _ high = high.left
    max MaxKnob scale _ = scale.right
168

169 170
renderScale :: R.Ref (Nullable DOM.Element) -> Record Props -> Range.NumberRange -> R.Element
renderScale ref {width,height} (Range.Closed {min, max}) =
171
   H.div { ref, className, width, height, aria } []
172
  where
arturo's avatar
arturo committed
173
    className = "range-slider__scale"
174
    aria = { label: "Scale running from " <> show min <> " to " <> show max }
175 176 177 178 179

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
180
    className = "range-slider__scale-sel"
181 182 183
    style = {left: computeLeft, width: computeWidth}
    percOffsetMin = Range.normalise props.bounds min
    percOffsetMax = Range.normalise props.bounds max
184 185 186
    computeLeft = formatter $ 100.0 * percOffsetMin
    computeWidth = formatter $ 100.0 * (percOffsetMax - percOffsetMin)
    formatter n = (DNF.toStringWith (DNF.fixed 0) n) <> "%"
187

188

189 190
renderKnob :: Knob -> R.Ref (Nullable DOM.Element) -> Range.NumberRange -> Bounds -> T.Box (Maybe Knob) -> Int -> ComponentStatus -> R.Element
renderKnob knob ref (Range.Closed value) bounds set precision status =
191
  H.div { ref, tabIndex, className, aria, on: { mouseDown: onMouseDown }, style } [
192
      H.div { className: "range-slider__placeholder " }
193
        [
194
          H.text $ DNF.toStringWith (DNF.precision precision) val
195
        ]
196
  ]
197
  where
198
    tabIndex = 0
199
    className = "range-slider__knob " <> (show status)
200
    aria = { label: labelPrefix knob <> "value: " <> show val }
201
    labelPrefix :: Knob -> String
202 203
    labelPrefix MinKnob = "Minimum "
    labelPrefix MaxKnob = "Maximum "
204 205 206
    onMouseDown _ = case status of
      Disabled -> pure unit
      _ -> T.write_ (Just knob) set
207 208
    percOffset = Range.normalise bounds val
    style = { left: (show $ 100.0 * percOffset) <> "%" }
209
    val :: Number
210 211 212
    val = case knob of
      MinKnob -> value.min
      MaxKnob -> value.max
213

214
-- TODO round to nearest epsilon
215 216
reproject :: Maybe Range.NumberRange -> Maybe DOMRect -> Bounds -> Epsilon -> R2.Point -> Maybe Number
reproject drag scalePos bounds epsilon (R2.Point mousePos) = do
217
  drag_ <- drag
218
  scale_ <- rectRange <$> scalePos
219
  let normal = Range.normalise scale_ (Range.clamp drag_ mousePos.x)
220 221
  let val = Range.projectNormal bounds normal
  pure $ round epsilon bounds val
222

223
rectRange :: DOMRect -> Range.NumberRange
224 225 226
rectRange rect = Range.Closed { min, max }
  where min = rect.left
        max = rect.right
227

228
initialValue :: Record Props -> Range.NumberRange
229
initialValue props = roundRange props.epsilon props.bounds props.initialValue
230

231
round :: Epsilon -> Bounds -> Number -> Number
232 233
round epsilon bounds = roundToMultiple epsilon <<< Range.clamp bounds

234
roundRange :: Epsilon -> Bounds -> Range.NumberRange -> Range.NumberRange
235 236 237
roundRange epsilon bounds (Range.Closed initial) = Range.Closed { min, max }
  where min = round epsilon bounds initial.min
        max = round epsilon bounds initial.max