Commit d51ae155 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[Graph] Range Slider works correctly now

parent 293d8233
...@@ -10,9 +10,7 @@ import Prelude ...@@ -10,9 +10,7 @@ import Prelude
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe) import Data.Nullable (Nullable, null, toMaybe)
import Data.Traversable (traverse_) import Data.Traversable (traverse_)
import Effect (Effect) import Data.Tuple.Nested ((/\))
import Effect.Class (liftEffect)
import Effect.Uncurried (EffectFn1, mkEffectFn1)
import DOM.Simple as DOM import DOM.Simple as DOM
import DOM.Simple.Document (document) import DOM.Simple.Document (document)
import DOM.Simple.Element as Element import DOM.Simple.Element as Element
...@@ -20,7 +18,10 @@ import DOM.Simple.EventListener as EL ...@@ -20,7 +18,10 @@ 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 DOM.Simple.Event as Event
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log, log2)
import Data.Tuple.Nested ((/\)) import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Uncurried (EffectFn1, mkEffectFn1)
--import Global (toFixed)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Reactix.SyntheticEvent as RE import Reactix.SyntheticEvent as RE
...@@ -58,14 +59,14 @@ rangeSliderCpt = R.hooksComponent "RangeSlider" cpt ...@@ -58,14 +59,14 @@ rangeSliderCpt = R.hooksComponent "RangeSlider" cpt
liftEffect $ log2 "Props: " props liftEffect $ log2 "Props: " props
-- scale bar -- scale bar
scaleElem <- R.useRef null -- dom ref scaleElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
scalePos <- R2.usePositionRef scaleElem --scalePos <- R2.usePositionRef scaleElem
-- low knob -- low knob
lowElem <- R.useRef null -- a dom ref to the low knob lowElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the low knob
lowPos <- R2.usePositionRef lowElem --lowPos <- R2.usePositionRef lowElem
-- high knob -- high knob
highElem <- R.useRef null -- a dom ref to the high knob highElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the high knob
highPos <- R2.usePositionRef highElem --highPos <- R2.usePositionRef highElem
-- The value of the user's selection -- The value of the user's selection
value /\ setValue <- R.useState' $ initialValue props value /\ setValue <- R.useState' $ initialValue props
let Range.Closed value' = value let Range.Closed value' = value
...@@ -86,29 +87,37 @@ rangeSliderCpt = R.hooksComponent "RangeSlider" cpt ...@@ -86,29 +87,37 @@ rangeSliderCpt = R.hooksComponent "RangeSlider" cpt
R.setRef mouseUpHandler $ Nothing R.setRef mouseUpHandler $ Nothing
R2.useLayoutEffect1' dragKnob $ \_ -> do R2.useLayoutEffect1' dragKnob $ \_ -> do
let scalePos' = R.readRef scaleElem
let scalePos = Element.boundingRect <$> toMaybe scalePos'
let lowPos' = R.readRef lowElem
let lowPos = Element.boundingRect <$> toMaybe lowPos'
let highPos' = R.readRef highElem
let highPos = Element.boundingRect <$> toMaybe highPos'
case dragKnob of case dragKnob of
Just knob -> do Just knob -> do
let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange
--R.setRef dragScale drag --R.setRef dragScale drag
let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do
log2 "dragKnob" dragKnob -- log2 "dragKnob" dragKnob
log2 "lowPos" lowPos -- log2 "lowPos" lowPos
log2 "highPos" highPos -- log2 "highPos" highPos
log2 "drag" drag -- log2 "drag" drag
log2 "scale" scalePos -- log2 "scale" scalePos
-- log2 "value" value -- -- log2 "value" value
let (R2.Point mousePos) = R2.domMousePosition event -- let (R2.Point mousePos) = R2.domMousePosition event
log2 "mouse position" mousePos -- log2 "mouse position" mousePos
let scale = rectRange <$> R.readRef scalePos -- let scale = rectRange <$> scalePos
case scale of -- case scale of
Just scale_ -> -- Just scale_ ->
case drag of -- case drag of
Just drag_ -> do -- Just drag_ -> do
let normal = Range.normalise scale_ (Range.clamp drag_ mousePos.x) -- let normal = Range.normalise scale_ (Range.clamp drag_ mousePos.x)
log2 "normal" normal -- log2 "normal" normal
log2 "project normal" $ Range.projectNormal props.bounds normal -- log2 "project normal" $ Range.projectNormal props.bounds normal
_ -> log "drag is Nothing" -- _ -> log "drag is Nothing"
_ -> log "scale is Nothing" -- _ -> log "scale is Nothing"
case reproject drag scalePos props.bounds (R2.domMousePosition event) of case reproject drag scalePos props.bounds (R2.domMousePosition event) of
Just val -> do Just val -> do
...@@ -127,8 +136,8 @@ rangeSliderCpt = R.hooksComponent "RangeSlider" cpt ...@@ -127,8 +136,8 @@ rangeSliderCpt = R.hooksComponent "RangeSlider" cpt
Nothing -> destroy unit Nothing -> destroy unit
pure $ H.div { className, aria } pure $ H.div { className, aria }
[ renderScale scaleElem props value' [ renderScale scaleElem props value'
, renderKnob lowElem value'.min props.bounds ("Minimum value:" <> show value'.min) MinKnob setDragKnob , renderKnob lowElem value'.min props.bounds MinKnob setDragKnob props.epsilon
, renderKnob highElem value'.max props.bounds ("Maximum value:" <> show value'.max) MaxKnob setDragKnob , renderKnob highElem value'.max props.bounds MaxKnob setDragKnob props.epsilon
] ]
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." }
...@@ -149,12 +158,12 @@ setKnob knob setValue r val = setValue $ const $ setter knob r val ...@@ -149,12 +158,12 @@ setKnob knob setValue r val = setValue $ const $ 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) -> Maybe Range.NumberRange getDragScale :: Knob -> Maybe DOMRect -> Maybe DOMRect -> Maybe DOMRect -> Maybe Range.NumberRange
getDragScale knob scalePos lowPos highPos = do getDragScale knob scalePos lowPos highPos = do
scale <- R.readRef scalePos scale <- scalePos
low <- R.readRef lowPos low <- lowPos
high <- R.readRef highPos high <- highPos
pure $ Range.Closed { min: min knob scale high, max: max knob scale low } pure $ Range.Closed { min: min knob scale low, max: max knob scale high }
where where
min MinKnob scale _ = scale.left min MinKnob scale _ = scale.left
min MaxKnob _ low = low.left min MaxKnob _ low = low.left
...@@ -168,21 +177,25 @@ renderScale ref {width,height} {min, max} = ...@@ -168,21 +177,25 @@ renderScale ref {width,height} {min, max} =
aria = { label: "Scale running from " <> show min <> " to " <> show max } aria = { label: "Scale running from " <> show min <> " to " <> show max }
style = { width: "100%", height: "3px" } style = { width: "100%", height: "3px" }
renderKnob ref val bounds label knob set = renderKnob ref val bounds knob set epsilon =
H.div { ref, tabIndex, className, aria, onMouseDown, style } [ H.text (show val) ] H.div { ref, tabIndex, className, aria, onMouseDown, style } [ H.text (text $ Just val) ]
where where
text (Just num) = show num
text Nothing = "error"
tabIndex = 0 tabIndex = 0
className = "knob" className = "knob"
aria = { label: label <> ", perc: " <> show percOffset } aria = { label: labelPrefix knob <> "value: " <> show val }
labelPrefix MinKnob = "Minimum "
labelPrefix MaxKnob = "Maximum "
onMouseDown = mkEffectFn1 $ \_ -> set $ const $ Just knob onMouseDown = mkEffectFn1 $ \_ -> set $ const $ Just knob
percOffset = Range.normalise bounds val percOffset = Range.normalise bounds val
style = { left: (show $ 100.0 * percOffset) <> "%" } style = { left: (show $ 100.0 * percOffset) <> "%" }
-- TODO round to nearest epsilon -- TODO round to nearest epsilon
reproject :: Maybe Range.NumberRange -> R.Ref (Maybe DOMRect) -> Range.NumberRange -> R2.Point -> Maybe Number reproject :: Maybe Range.NumberRange -> Maybe DOMRect -> Range.NumberRange -> R2.Point -> Maybe Number
reproject drag scale value (R2.Point mousePos) = do reproject drag scalePos value (R2.Point mousePos) = do
drag_ <- drag drag_ <- drag
scale_ <- rectRange <$> R.readRef scale scale_ <- rectRange <$> scalePos
let normal = Range.normalise scale_ (Range.clamp drag_ mousePos.x) let normal = Range.normalise scale_ (Range.clamp drag_ mousePos.x)
pure $ Range.projectNormal value normal pure $ Range.projectNormal value normal
......
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