Skip to content

P
purescript-gargantext
Commit 3c62969a authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[Graph] code cleanup

parent d9a30f18
Show whitespace changes
Inline Side-by-side
Showing with 32 additions and 83 deletions
src/Gargantext/Components/GraphExplorer.purs
View file @ 3c62969a
module Gargantext.Components.GraphExplorer where module Gargantext.Components.GraphExplorer where
import Effect.Unsafe (unsafePerformEffect)
import Gargantext.Prelude hiding (max,min) import Gargantext.Prelude hiding (max,min)
import Control.Monad.Cont.Trans (lift)
import Data.Array (fold, length, (!!), null)
import Data.FoldableWithIndex (foldMapWithIndex) import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Int as Int
import Data.Lens (Lens', over, (%~), (.~), (^.))
import Data.Lens.Record (prop)
import Data.Maybe (Maybe(..), fromJust, fromMaybe) import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype)
import Data.Number as Num
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Traversable (for_)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Thermite (Render, Spec, simpleSpec)
import Partial.Unsafe (unsafePartial)
import Thermite (Render, Spec, simpleSpec, defaultPerformAction)
import Unsafe.Coerce (unsafeCoerce)
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (getItem)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
import Gargantext.Hooks.Sigmax.Types as Sigmax import Gargantext.Hooks.Sigmax.Types as Sigmax
import Gargantext.Hooks.Sigmax.Sigmajs (CameraProps, SigmaNode, cameras, getCameraProps, goTo, pauseForceAtlas2, sigmaOnMouseMove)
import Gargantext.Components.GraphExplorer.Controls as Controls import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Components.GraphExplorer.Legend (legend)
import Gargantext.Components.GraphExplorer.Sidebar as Sidebar import Gargantext.Components.GraphExplorer.Sidebar as Sidebar
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Graph as Graph import Gargantext.Components.Graph as Graph
import Gargantext.Components.Loader2 as Loader import Gargantext.Components.Loader2 as Loader
import Gargantext.Components.Login.Types (AuthData(..), TreeId)
import Gargantext.Components.RandomText (words)
import Gargantext.Components.Tree as Tree import Gargantext.Components.Tree as Tree
import Gargantext.Config as Config import Gargantext.Config as Config
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Pages.Corpus.Graph.Tabs as GT
import Gargantext.Router (Routes(..)) import Gargantext.Router (Routes(..))
import Gargantext.Types (class Optional)
import Gargantext.Utils (toggleSet)
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type GraphId = Int type GraphId = Int
......
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @ 3c62969a
...@@ -2,7 +2,6 @@ module Gargantext.Components.GraphExplorer.Sidebar ...@@ -2,7 +2,6 @@ module Gargantext.Components.GraphExplorer.Sidebar
where where
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Prelude import Prelude
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
......
src/Gargantext/Components/RangeSlider.purs
View file @ 3c62969a
...@@ -13,7 +13,6 @@ import Data.Nullable (Nullable, null, toMaybe) ...@@ -13,7 +13,6 @@ import Data.Nullable (Nullable, null, toMaybe)
import Data.Traversable (traverse_) import Data.Traversable (traverse_)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM import DOM.Simple as DOM
import DOM.Simple.Console (log, log2)
import DOM.Simple.Document (document) import DOM.Simple.Document (document)
import DOM.Simple.Element as Element import DOM.Simple.Element as Element
import DOM.Simple.Event as Event import DOM.Simple.Event as Event
...@@ -34,13 +33,16 @@ import Gargantext.Utils.Range as Range ...@@ -34,13 +33,16 @@ import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
-- data Axis = X | Y -- data Axis = X | Y
type Epsilon = Number
type Bounds = Range.NumberRange
-- To avoid overloading the terms 'min' and 'max' here, we treat 'min' -- 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 -- 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 :: Range.NumberRange -- The minimum and maximum values it is possible to select ( bounds :: Bounds -- The minimum and maximum values it is possible to select
, initialValue :: Range.NumberRange -- The user's selection of minimum and maximum values , initialValue :: Range.NumberRange -- The user's selection of minimum and maximum values
, epsilon :: Number -- The smallest possible change (for mouse) , epsilon :: Epsilon -- 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
...@@ -58,93 +60,57 @@ rangeSliderCpt :: R.Component Props ...@@ -58,93 +60,57 @@ rangeSliderCpt :: R.Component Props
rangeSliderCpt = R.hooksComponent "RangeSlider" cpt rangeSliderCpt = R.hooksComponent "RangeSlider" cpt
where where
cpt props _ = do cpt props _ = do
--R.useEffect' $ do
-- liftEffect $ log2 "Props: " props
-- rounding precision (i.e. how many decimal digits are in epsilon) -- 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 let precision = fromMaybe 0 $ fromNumber $ max 0.0 $ - M.floor $ (M.log props.epsilon) / M.ln10
-- scale bar -- scale bar
scaleElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref scaleElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
--scalePos <- R2.usePositionRef scaleElem
-- low knob -- low knob
lowElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- 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
-- high knob -- high knob
highElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- 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
-- 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
-- the knob we are currently in a drag for. set by mousedown on a knob -- the knob we are currently in a drag for. set by mousedown on a knob
dragKnob /\ setDragKnob <- R.useState' $ (Nothing :: Maybe Knob) dragKnob /\ setDragKnob <- R.useState' $ (Nothing :: Maybe Knob)
-- the bounding box within which the mouse can drag
--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) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent))) 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))) mouseUpHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
let destroy = \_ -> do let destroy = \_ -> do
--log "RangeSlider: Destroying event handlers"
destroyEventHandler "mousemove" mouseMoveHandler destroyEventHandler "mousemove" mouseMoveHandler
destroyEventHandler "mouseup" mouseUpHandler destroyEventHandler "mouseup" mouseUpHandler
R.setRef mouseMoveHandler $ Nothing R.setRef mouseMoveHandler $ Nothing
R.setRef mouseUpHandler $ Nothing R.setRef mouseUpHandler $ Nothing
R2.useLayoutEffect1' dragKnob $ \_ -> do R2.useLayoutEffect1' dragKnob $ \_ -> do
let scalePos' = R.readRef scaleElem let scalePos = R2.readPositionRef scaleElem
let scalePos = Element.boundingRect <$> toMaybe scalePos' let lowPos = R2.readPositionRef lowElem
let lowPos' = R.readRef lowElem let highPos = R2.readPositionRef highElem
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
let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do
-- log2 "dragKnob" dragKnob case reproject drag scalePos props.bounds props.epsilon (R2.domMousePosition event) of
-- log2 "lowPos" lowPos
-- log2 "highPos" highPos
-- log2 "drag" drag
-- log2 "scale" scalePos
-- -- log2 "value" value
-- let (R2.Point mousePos) = R2.domMousePosition event
-- log2 "mouse position" mousePos
-- let scale = rectRange <$> scalePos
-- case scale of
-- Just scale_ ->
-- case drag of
-- Just drag_ -> do
-- let normal = Range.normalise scale_ (Range.clamp drag_ mousePos.x)
-- log2 "normal" normal
-- log2 "project normal" $ Range.projectNormal props.bounds normal
-- _ -> log "drag is Nothing"
-- _ -> log "scale is Nothing"
case reproject drag scalePos props.bounds (R2.domMousePosition event) of
Just val -> do Just val -> do
--log2 "reproject val" val setKnob knob setValue value val
setKnob knob setValue value $ round props.epsilon props.bounds val
Nothing -> destroy unit Nothing -> destroy unit
let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do
props.onChange value props.onChange value
setDragKnob $ const Nothing setDragKnob $ const Nothing
destroy unit destroy unit
--log "RangeSlider: Creating event handlers"
--log2 "Clamp: " $ Range.clamp props.bounds value'.min
EL.addEventListener document "mousemove" onMouseMove EL.addEventListener document "mousemove" onMouseMove
EL.addEventListener document "mouseup" onMouseUp EL.addEventListener document "mouseup" onMouseUp
R.setRef mouseMoveHandler $ Just onMouseMove R.setRef mouseMoveHandler $ Just onMouseMove
R.setRef mouseUpHandler $ Just onMouseUp R.setRef mouseUpHandler $ Just onMouseUp
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 MinKnob lowElem value'.min props.bounds setDragKnob precision , renderKnob MinKnob lowElem value props.bounds setDragKnob precision
, renderKnob MaxKnob highElem value'.max props.bounds setDragKnob precision , renderKnob MaxKnob highElem value props.bounds setDragKnob precision
] ]
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." }
...@@ -177,15 +143,16 @@ getDragScale knob scalePos lowPos highPos = do ...@@ -177,15 +143,16 @@ getDragScale knob scalePos lowPos highPos = do
max MinKnob _ high = high.left max MinKnob _ high = high.left
max MaxKnob scale _ = scale.right max MaxKnob scale _ = scale.right
renderScale ref {width,height} {min, max} = renderScale :: R.Ref (Nullable DOM.Element) -> Record Props -> Range.NumberRange -> R.Element
renderScale ref {width,height} (Range.Closed {min, max}) =
H.div { ref, className, width, height, aria, style } [] H.div { ref, className, width, height, aria, style } []
where where
className = "scale" className = "scale"
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 :: Knob -> R.Ref (Nullable DOM.Element) -> Number -> Range.NumberRange -> R2.StateSetter (Maybe Knob) -> Int -> R.Element renderKnob :: Knob -> R.Ref (Nullable DOM.Element) -> Range.NumberRange -> Bounds -> R2.StateSetter (Maybe Knob) -> Int -> R.Element
renderKnob knob ref val bounds set precision = renderKnob knob ref (Range.Closed value) bounds set precision =
H.div { ref, tabIndex, className, aria, onMouseDown, style } [ H.div { ref, tabIndex, className, aria, onMouseDown, style } [
H.div { className: "button" } [] H.div { className: "button" } []
, H.text $ text $ toFixed precision val , H.text $ text $ toFixed precision val
...@@ -201,14 +168,18 @@ renderKnob knob ref val bounds set precision = ...@@ -201,14 +168,18 @@ renderKnob knob ref val bounds set precision =
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) <> "%" }
val = case knob of
MinKnob -> value.min
MaxKnob -> value.max
-- TODO round to nearest epsilon -- TODO round to nearest epsilon
reproject :: Maybe Range.NumberRange -> Maybe DOMRect -> Range.NumberRange -> R2.Point -> Maybe Number reproject :: Maybe Range.NumberRange -> Maybe DOMRect -> Bounds -> Epsilon -> R2.Point -> Maybe Number
reproject drag scalePos value (R2.Point mousePos) = do reproject drag scalePos bounds epsilon (R2.Point mousePos) = do
drag_ <- drag drag_ <- drag
scale_ <- rectRange <$> scalePos 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 let val = Range.projectNormal bounds normal
pure $ round epsilon bounds val
rectRange :: DOMRect -> Range.NumberRange rectRange :: DOMRect -> Range.NumberRange
rectRange rect = Range.Closed { min, max } rectRange rect = Range.Closed { min, max }
...@@ -218,10 +189,10 @@ rectRange rect = Range.Closed { min, max } ...@@ -218,10 +189,10 @@ rectRange rect = Range.Closed { min, max }
initialValue :: Record Props -> Range.NumberRange initialValue :: Record Props -> Range.NumberRange
initialValue props = roundRange props.epsilon props.bounds props.initialValue initialValue props = roundRange props.epsilon props.bounds props.initialValue
round :: Number -> Range.NumberRange -> Number -> Number round :: Epsilon -> Bounds -> Number -> Number
round epsilon bounds = roundToMultiple epsilon <<< Range.clamp bounds round epsilon bounds = roundToMultiple epsilon <<< Range.clamp bounds
roundRange :: Number -> Range.NumberRange -> Range.NumberRange -> Range.NumberRange roundRange :: Epsilon -> Bounds -> Range.NumberRange -> Range.NumberRange
roundRange epsilon bounds (Range.Closed initial) = Range.Closed { min, max } roundRange epsilon bounds (Range.Closed initial) = Range.Closed { min, max }
where min = round epsilon bounds initial.min where min = round epsilon bounds initial.min
max = round epsilon bounds initial.max max = round epsilon bounds initial.max
......
src/Gargantext/Utils/Reactix.purs
View file @ 3c62969a
...@@ -124,3 +124,8 @@ useLayoutRef fn init ref = do ...@@ -124,3 +124,8 @@ useLayoutRef fn init ref = do
usePositionRef :: R.Ref (Nullable DOM.Element) -> R.Hooks (R.Ref (Maybe DOM.DOMRect)) usePositionRef :: R.Ref (Nullable DOM.Element) -> R.Hooks (R.Ref (Maybe DOM.DOMRect))
usePositionRef = useLayoutRef (map Element.boundingRect <<< toMaybe) Nothing usePositionRef = useLayoutRef (map Element.boundingRect <<< toMaybe) Nothing
readPositionRef :: R.Ref (Nullable DOM.Element) -> Maybe DOM.DOMRect
readPositionRef el = do
let posRef = R.readRef el
Element.boundingRect <$> toMaybe posRef
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