RangeSlider.purs 8.97 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, toMaybe)
13
import Data.Traversable (traverse_)
14
import Data.Tuple.Nested ((/\))
15
import DOM.Simple as DOM
16
import DOM.Simple.Console (log2)
17
import DOM.Simple.Document (document)
18
import DOM.Simple.Element as Element
19
import DOM.Simple.Event as Event
20
import DOM.Simple.EventListener as EL
21
import DOM.Simple.Types (DOMRect, Element)
22
import Global (toFixed)
23 24 25 26
import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Uncurried (EffectFn1, mkEffectFn1)
--import Global (toFixed)
27
import Math as M
28
import Reactix as R
29
import Reactix.DOM.HTML as H
30
import Reactix.SyntheticEvent as RE
31 32 33 34

import Gargantext.Utils.Math (roundToMultiple)
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
35 36
-- data Axis = X | Y

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

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
  , epsilon :: Epsilon           -- The smallest possible change (for mouse)
47 48 49 50
  , step :: Number              -- The 'standard' change (for keyboard)
  -- , axis :: Axis                -- Which direction to move in
  , 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 57 58 59

data Knob = MinKnob | MaxKnob

data RangeUpdate = SetMin Number | SetMax Number

60
rangeSliderCpt :: R.Component Props
61 62 63
rangeSliderCpt = R.hooksComponent "RangeSlider" cpt
  where
    cpt props _ = do
64 65 66
      -- 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

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

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

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

90
      R2.useLayoutEffect1' dragKnob $ \_ -> do
91 92 93
        let scalePos = R2.readPositionRef scaleElem
        let lowPos = R2.readPositionRef lowElem
        let highPos = R2.readPositionRef highElem
94

95 96
        case dragKnob of
          Just knob -> do
97
            let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange
98

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

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

133
setKnob :: Knob -> R2.StateSetter Range.NumberRange -> Range.NumberRange -> Number -> Effect Unit
134 135 136 137 138
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
139

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

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

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

170

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

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

203
rectRange :: DOMRect -> Range.NumberRange
204 205 206
rectRange rect = Range.Closed { min, max }
  where min = rect.left
        max = rect.right
207

208
initialValue :: Record Props -> Range.NumberRange
209
initialValue props = roundRange props.epsilon props.bounds props.initialValue
210

211
round :: Epsilon -> Bounds -> Number -> Number
212 213
round epsilon bounds = roundToMultiple epsilon <<< Range.clamp bounds

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