Commit 57d4d7a3 authored by James Laver's avatar James Laver

Initial successfully compiling Range Slider

parent 250d851d
...@@ -11,8 +11,9 @@ import Reactix as R ...@@ -11,8 +11,9 @@ import Reactix as R
import Data.Traversable (traverse_) import Data.Traversable (traverse_)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import DOM.Simple.Document (document) import DOM.Simple.Document (document)
import DOM.Simple.Element as Element import DOM.Simple.EventListener as EL
import DOM.Simple.Types (DOMRect, Element) import DOM.Simple.Types (DOMRect, Element)
import DOM.Simple.Event as Event
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Uncurried (EffectFn1, mkEffectFn1) import Effect.Uncurried (EffectFn1, mkEffectFn1)
import Gargantext.Utils.Math (roundToMultiple) import Gargantext.Utils.Math (roundToMultiple)
...@@ -21,6 +22,7 @@ import Data.Maybe (Maybe(..)) ...@@ -21,6 +22,7 @@ import Data.Maybe (Maybe(..))
import Data.Nullable (null) import Data.Nullable (null)
import Effect (Effect) import Effect (Effect)
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Reactix.SyntheticEvent as RE
-- data Axis = X | Y -- data Axis = X | Y
type NumberRange = Range.Closed Number type NumberRange = Range.Closed Number
...@@ -28,23 +30,23 @@ type NumberRange = Range.Closed Number ...@@ -28,23 +30,23 @@ type NumberRange = Range.Closed Number
-- and 'max' as being the bounds of the scale and 'low' and 'high' as -- and 'max' as being the bounds of the scale and 'low' and 'high' as
-- being the selected values -- being the selected values
type Props = type Props =
{ bounds :: NumberRange -- The minimum and maximum values it is possible to select ( bounds :: NumberRange -- The minimum and maximum values it is possible to select
, initialValue :: NumberRange -- The user's selection of minimum and maximum values , initialValue :: NumberRange -- The user's selection of minimum and maximum values
, epsilon :: Number -- The smallest possible change (for mouse) , epsilon :: Number -- The smallest possible change (for mouse)
, step :: Number -- The 'standard' change (for keyboard) , step :: Number -- The 'standard' change (for keyboard)
-- , axis :: Axis -- Which direction to move in -- , axis :: Axis -- Which direction to move in
, width :: Number , width :: Number
, height :: Number , height :: Number
, onChange :: NumberRange -> Effect Unit } , onChange :: NumberRange -> Effect Unit )
rangeSlider :: Props -> R.Element rangeSlider :: Record Props -> R.Element
rangeSlider = R.createElement rangeSliderCpt rangeSlider props = R.createElement rangeSliderCpt props []
data Knob = MinKnob | MaxKnob data Knob = MinKnob | MaxKnob
data RangeUpdate = SetMin Number | SetMax Number data RangeUpdate = SetMin Number | SetMax Number
rangeSliderCpt :: Props -> R.Component Props rangeSliderCpt :: R.Component Props
rangeSliderCpt = R.hooksComponent "RangeSlider" cpt rangeSliderCpt = R.hooksComponent "RangeSlider" cpt
where where
cpt props _ = do cpt props _ = do
...@@ -66,25 +68,25 @@ rangeSliderCpt = R.hooksComponent "RangeSlider" cpt ...@@ -66,25 +68,25 @@ rangeSliderCpt = R.hooksComponent "RangeSlider" cpt
-- the bounding box within which the mouse can drag -- the bounding box within which the mouse can drag
dragScale <- R.useRef $ Nothing dragScale <- R.useRef $ Nothing
-- the handler functions for trapping mouse events, so they can be removed -- the handler functions for trapping mouse events, so they can be removed
mouseMoveHandler <- R.useRef $ Nothing mouseMoveHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
mouseUpHandler <- R.useRef $ Nothing mouseUpHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
let destroy =
R.useLayoutEffect1 dragKnob $ \_ -> do do destroyEventHandler "mousemove" mouseMoveHandler
destroyEventHandler "mouseup" mouseUpHandler
R2.useLayoutEffect1' dragKnob $ \_ -> do
case dragKnob of case dragKnob of
Just knob -> do Just knob -> do
let drag = getDragScale knob scalePos lowPos highPos let drag = getDragScale knob scalePos lowPos highPos
R.setRef dragScale drag R.setRef dragScale drag
let onMouseMove = mkEffectFn1 $ \event -> let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) ->
setKnob knob setValue value $ reproject drag scalePos value $ R2.mousePosition event case reproject drag scalePos value (R2.domMousePosition event) of
let onMouseUp = mkEffectFn1 $ \event -> Just val -> setKnob knob setValue value val
destroyEventHandler "mousemove" mouseMoveHandler *> Nothing -> destroy
destroyEventHandler "mouseup" mouseUpHandler let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> destroy
Element.addEventListener document "mousemove" onMouseMove EL.addEventListener document "mousemove" onMouseMove
Element.addEventListener document "mouseup" onMouseUp EL.addEventListener document "mouseup" onMouseUp
Nothing -> do Nothing -> destroy
destroyEventHandler "mousemove" mouseMoveHandler pure $ H.div { className, aria }
destroyEventHandler "mouseup" mouseUpHandler
H.div { className, aria }
[ renderScale scaleElem props value' [ renderScale scaleElem props value'
, renderKnob lowElem value'.min ("Minimum value:" <> show value'.min) MinKnob setDragKnob , renderKnob lowElem value'.min ("Minimum value:" <> show value'.min) MinKnob setDragKnob
, renderKnob highElem value'.max ("Maximum value:" <> show value'.max) MaxKnob setDragKnob , renderKnob highElem value'.max ("Maximum value:" <> show value'.max) MaxKnob setDragKnob
...@@ -92,9 +94,15 @@ rangeSliderCpt = R.hooksComponent "RangeSlider" cpt ...@@ -92,9 +94,15 @@ rangeSliderCpt = R.hooksComponent "RangeSlider" cpt
className = "range-slider" 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." } 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." }
destroyEventHandler :: forall e. String -> R.Ref (Maybe (e -> EffectFn1 e Unit)) -> Effect Unit destroyEventHandler
:: forall e
. Event.IsEvent e
=> String -> R.Ref (Maybe (EL.Callback e)) -> Effect Unit
destroyEventHandler name ref = traverse_ destroy $ R.readRef ref destroyEventHandler name ref = traverse_ destroy $ R.readRef ref
where destroy handler = Element.removeEventListener document name handler *> R.setRef ref Nothing where
destroy handler = do
EL.removeEventListener document name handler
R.setRef ref Nothing
setKnob :: Knob -> (Range.Closed Number -> Effect Unit) -> Range.Closed Number -> Number -> Effect Unit setKnob :: Knob -> (Range.Closed Number -> Effect Unit) -> Range.Closed Number -> Number -> Effect Unit
setKnob knob setValue r val = setValue $ setter knob r val setKnob knob setValue r val = setValue $ setter knob r val
...@@ -102,16 +110,17 @@ setKnob knob setValue r val = setValue $ setter knob r val ...@@ -102,16 +110,17 @@ setKnob knob setValue r val = setValue $ setter knob r val
setter MinKnob = Range.withMin setter MinKnob = Range.withMin
setter MaxKnob = Range.withMax setter MaxKnob = Range.withMax
getDragScale :: Knob -> R.Ref (Maybe DOMRect) -> R.Ref (Maybe DOMRect) -> R.Ref (Maybe DOMRect) -> Range.Closed Number getDragScale :: Knob -> R.Ref (Maybe DOMRect) -> R.Ref (Maybe DOMRect) -> R.Ref (Maybe DOMRect) -> Maybe (Range.Closed Number)
getDragScale knob scalePos lowPos highPos = Range.Closed { min: min knob, max: max knob } getDragScale knob scalePos lowPos highPos = do
scale <- R.readRef scalePos
low <- R.readRef lowPos
high <- R.readRef highPos
pure $ Range.Closed { min: min knob scale high, max: max knob scale low }
where where
scale = R.readRef scalePos min MinKnob scale _ = scale.left
low = R.readRef lowPos min MaxKnob _ low = low.left
high = R.readRef highPos max MinKnob _ high = high.left
min MinKnob = scale.left max MaxKnob scale _ = scale.right
min MaxKnob = low.left
max MinKnob = high.left
max MaxKnob = scale.right
renderScale ref {width,height} {min, max} = renderScale ref {width,height} {min, max} =
H.div { ref, className, width, height, aria } [] H.div { ref, className, width, height, aria } []
...@@ -125,15 +134,22 @@ renderKnob ref val label knob set = ...@@ -125,15 +134,22 @@ renderKnob ref val label knob set =
tabindex = 0 tabindex = 0
className = "knob" className = "knob"
aria = { label } aria = { label }
onMouseDown = mkEffectFn1 $ \_ -> set knob onMouseDown = mkEffectFn1 $ \_ -> set (Just knob)
-- todo round to nearest epsilon -- todo round to nearest epsilon
reproject :: Range.Closed Number -> Range.Closed Number -> R2.Point -> Number reproject :: Maybe (Range.Closed Number) -> R.Ref (Maybe DOMRect) -> Range.Closed Number -> R2.Point -> Maybe Number
reproject drag scale value mousePos = Range.projectNormal value normal reproject drag scale value (R2.Point mousePos) = do
where drag_ <- drag
normal = Range.normalise scale (Range.clamp drag mousePos.x) scale_ <- rectRange <$> R.readRef scale
let normal = Range.normalise scale_ (Range.clamp drag_ mousePos.x)
pure $ Range.projectNormal value normal
rectRange :: DOMRect -> Range.Closed Number
rectRange rect = Range.Closed { min, max }
where min = rect.left
max = rect.right
initialValue :: Props -> NumberRange initialValue :: Record Props -> NumberRange
initialValue props = roundRange props.epsilon props.bounds props.initialValue initialValue props = roundRange props.epsilon props.bounds props.initialValue
round :: Number -> NumberRange -> Number -> Number round :: Number -> NumberRange -> Number -> Number
......
...@@ -31,6 +31,8 @@ scuff = unsafeCoerce ...@@ -31,6 +31,8 @@ scuff = unsafeCoerce
mousePosition :: RE.SyntheticEvent DE.MouseEvent -> Point mousePosition :: RE.SyntheticEvent DE.MouseEvent -> Point
mousePosition e = Point { x: RE.clientX e, y: RE.clientY e } mousePosition e = Point { x: RE.clientX e, y: RE.clientY e }
domMousePosition :: DE.MouseEvent -> Point
domMousePosition = mousePosition <<< unsafeCoerce
-- | This is naughty, it quietly mutates the input and returns it -- | This is naughty, it quietly mutates the input and returns it
named :: forall o. String -> o -> o named :: forall o. String -> o -> o
named = flip $ defineProperty "name" named = flip $ defineProperty "name"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment