Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Przemyslaw Kaminski
purescript-gargantext
Commits
aedbeb27
Commit
aedbeb27
authored
May 12, 2021
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[annotation] some fixes to context menu and annotated fields
parent
5001f21c
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
160 additions
and
76 deletions
+160
-76
index.html
dist/index.html
+0
-2
AnnotatedField.purs
src/Gargantext/Components/Annotation/AnnotatedField.purs
+66
-57
Menu.purs
src/Gargantext/Components/Annotation/Menu.purs
+42
-5
App.purs
src/Gargantext/Components/App.purs
+2
-2
ContextMenu.purs
src/Gargantext/Components/ContextMenu/ContextMenu.purs
+5
-3
Router.purs
src/Gargantext/Components/Router.purs
+1
-0
Reactix.js
src/Gargantext/Utils/Reactix.js
+5
-0
Reactix.purs
src/Gargantext/Utils/Reactix.purs
+39
-7
No files found.
dist/index.html
View file @
aedbeb27
...
@@ -8,8 +8,6 @@
...
@@ -8,8 +8,6 @@
<link
id=
"bootstrap-css"
href=
"styles/bootstrap-default.css"
rel=
"stylesheet"
/>
<link
id=
"bootstrap-css"
href=
"styles/bootstrap-default.css"
rel=
"stylesheet"
/>
<link
rel=
"stylesheet"
type=
"text/css"
href=
"styles/highlightjs-solarized-light.css"
/>
<link
rel=
"stylesheet"
type=
"text/css"
href=
"styles/highlightjs-solarized-light.css"
/>
<link
href=
"styles/sass.css"
rel=
"stylesheet"
type=
"text/css"
/>
<link
href=
"styles/sass.css"
rel=
"stylesheet"
type=
"text/css"
/>
<!-- <script type="text/javascript" src="/js/react-bootstrap.min.js"></script> -->
<script
type=
"text/javascript"
src=
"/js/react-bootstrap.js"
></script>
<style>
*
{
margin
:
0
;
padding
:
0
;
list-style
:
none
;}
</style>
<style>
*
{
margin
:
0
;
padding
:
0
;
list-style
:
none
;}
</style>
</head>
</head>
<body>
<body>
...
...
src/Gargantext/Components/Annotation/AnnotatedField.purs
View file @
aedbeb27
...
@@ -22,16 +22,17 @@ import Effect (Effect)
...
@@ -22,16 +22,17 @@ import Effect (Effect)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as HTML
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
import Reactix.SyntheticEvent as E
import Record as Record
import Toestand as T
import Toestand as T
import Gargantext.Prelude
import Gargantext.Prelude
import Gargantext.Components.Annotation.Menu ( annotationMenu, AnnotationMenu, MenuType(..) )
import Gargantext.Components.Annotation.Menu ( annotationMenu
Wrapper
, AnnotationMenu, MenuType(..) )
import Gargantext.Components.Annotation.Utils (termClass)
import Gargantext.Components.Annotation.Utils (termClass)
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel
import Gargantext.Utils.Selection as Sel
import Gargantext.Types (CTabNgramType(..), TermList)
here :: R2.Here
here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.AnnotatedField"
here = R2.here "Gargantext.Components.Annotation.AnnotatedField"
...
@@ -48,37 +49,51 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent
...
@@ -48,37 +49,51 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent
-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
annotatedField :: R2.Component Props
annotatedField :: R2.Component Props
annotatedField = R.createElement annotatedFieldComponent
annotatedField = R.createElement annotatedFieldCpt
annotatedFieldCpt :: R.Component Props
annotatedFieldComponent :: R.Component Props
annotatedFieldCpt = here.component "annotatedField" cpt where
annotatedFieldComponent = here.component "annotatedField" cpt
cpt props _ = do
where
menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu))
cpt { ngrams, setTermList, text: fieldText } _ = do
redrawMenu <- T.useBox false
redrawMenu <- T.useBox false
redrawMenu' <- T.useLive T.unequal redrawMenu
pure $ annotatedFieldInner (Record.merge { menuRef, redrawMenu } props)
type InnerProps =
(
menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, redrawMenu :: T.Box Boolean
| Props
)
menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu))
annotatedFieldInner :: R2.Leaf InnerProps
annotatedFieldInner p = R.createElement annotatedFieldInnerCpt p []
annotatedFieldInnerCpt :: R.Component InnerProps
annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
cpt { menuRef, ngrams, redrawMenu, setTermList, text: fieldText } _ = do
-- redrawMenu <- T.useBox false
redrawMenu' <- T.useLive T.unequal redrawMenu
let wrapperProps = { className: "annotated-field-wrapper" }
-- menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu))
-- menu <- T.useBox (Nothing :: Maybe (Record AnnotationMenu))
wrap (text /\ list) = { list
let
wrap (text /\ list) = { list
, onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
, onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
, text }
, text }
pure $ HTML.div wrapperProps
pure $ HTML.div { className: "annotated-field-wrapper" }
[ maybe (HTML.div {} []) annotationMenu $ R.readRef menuRef
[ annotationMenuWrapper { menuRef }
, HTML.div { className: "annotated-field-runs" }
, HTML.div { className: "annotated-field-runs" }
((\p -> annotateRun p []) <$> wrap <$> compile ngrams fieldText)
((\p -> annotateRun p []) <$> wrap <$> compile ngrams fieldText)
]
]
compile :: NgramsTable -> Maybe String -> Array (Tuple String (List (Tuple NgramsTerm TermList)))
compile :: NgramsTable -> Maybe String -> Array (Tuple String (List (Tuple NgramsTerm TermList)))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs
-- Runs
onAnnotationSelect :: forall e. DE.IsMouseEvent e => { menuRef :: R.Ref (Maybe (Record AnnotationMenu))
onAnnotationSelect :: forall e. DE.IsMouseEvent e => { menuRef
:: R.Ref (Maybe (Record AnnotationMenu))
, ngrams :: NgramsTable
, ngrams
:: NgramsTable
, redrawMenu :: T.Box Boolean
, redrawMenu
:: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
-> Maybe (Tuple NgramsTerm TermList) -> E.SyntheticEvent e -> Effect Unit
-> Maybe (Tuple NgramsTerm TermList) -> E.SyntheticEvent e -> Effect Unit
onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } Nothing event = do
onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } Nothing event = do
...
@@ -106,12 +121,12 @@ onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } (Just (Tuple ngr
...
@@ -106,12 +121,12 @@ onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } (Just (Tuple ngr
, setTermList }
, setTermList }
-- showMenu :: forall p e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e | p } -> Effect Unit
-- showMenu :: forall p e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e | p } -> Effect Unit
showMenu :: forall e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e
showMenu :: forall e. DE.IsMouseEvent e => { event
:: E.SyntheticEvent e
, getList :: NgramsTerm -> Maybe TermList
, getList
:: NgramsTerm -> Maybe TermList
, menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, menuRef
:: R.Ref (Maybe (Record AnnotationMenu))
, menuType :: MenuType
, menuType
:: MenuType
, ngram :: NgramsTerm
, ngram
:: NgramsTerm
, redrawMenu :: T.Box Boolean
, redrawMenu
:: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
-> Effect Unit
-> Effect Unit
showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = do
showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = do
...
@@ -123,15 +138,16 @@ showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } =
...
@@ -123,15 +138,16 @@ showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } =
setList t = do
setList t = do
setTermList ngram list t
setTermList ngram list t
hideMenu { menuRef, redrawMenu }
hideMenu { menuRef, redrawMenu }
here.log2 "x" x
--
here.log2 "x" x
here.log2 "y" y
--
here.log2 "y" y
E.preventDefault event
E.preventDefault event
--range <- Sel.getRange sel 0
--range <- Sel.getRange sel 0
--here.log2 "selection range" $ Sel.rangeToTuple range
--here.log2 "selection range" $ Sel.rangeToTuple range
let menu = Just
let menu = Just
{ list
{ list
, onClose: hideMenu { menuRef, redrawMenu }
, menuType
, menuType
, onClose: hideMenu { menuRef, redrawMenu }
, redrawMenu
, setList
, setList
, x
, x
, y }
, y }
...
@@ -143,32 +159,25 @@ hideMenu { menuRef, redrawMenu } = do
...
@@ -143,32 +159,25 @@ hideMenu { menuRef, redrawMenu } = do
T.modify_ not redrawMenu
T.modify_ not redrawMenu
type Run =
type Run =
( list :: List (Tuple NgramsTerm TermList)
( list
:: List (Tuple NgramsTerm TermList)
, onSelect :: Maybe (Tuple NgramsTerm TermList) -> MouseEvent -> Effect Unit
, onSelect
:: Maybe (Tuple NgramsTerm TermList) -> MouseEvent -> Effect Unit
, text :: String
, text
:: String
)
)
annotateRun :: R2.Component Run
annotateRun :: R2.Component Run
annotateRun = R.createElement annotatedRunComponent
annotateRun = R.createElement annotatedRunCpt
annotatedRunCpt :: R.Component Run
annotatedRunComponent :: R.Component Run
annotatedRunCpt = here.component "annotatedRun" cpt
annotatedRunComponent = R.staticComponent "AnnotatedRun" cpt
where
where
cpt { list: Nil, onSelect, text } _ =
cpt { list, onSelect, text } _ = do
HTML.span { on: { mouseUp: onSelect Nothing } } [ HTML.text text ]
let el = case list of
cpt { list: lst@((ngram /\ list) : otherLists), onSelect, text } _ =
Nil -> HTML.span { on: { mouseUp: onSelect Nothing } } [ HTML.text text ]
HTML.span { className
lst@(( ngram /\ list' ) : otherLists) ->
, on: { click: onSelect (Just (ngram /\ list)) } } [ HTML.text text ]
let bgClasses = joinWith " " $ A.fromFoldable $ termClass <<< snd <$> lst
where
className = "annotation-run " <> bgClasses
bgClasses = joinWith " " $ A.fromFoldable $ termClass <<< snd <$> lst
in
-- className = "annotation-run bg-" <> termBootstrapClass list
HTML.span { className
className = "annotation-run " <> bgClasses
, on: { click: onSelect (Just (ngram /\ list')) } } [ HTML.text text ]
-- cb = onSelect text list
-- elt =
pure $ el
-- case list of
-- Nothing -> HTML.span { on: { mouseUp: cb } }
-- Just l -> HTML.span { -- className: "annotation-run bg-" <> termBootstrapClass l
-- className: "annotation-run " <> termClass l
-- , on: { click: cb }
-- }
src/Gargantext/Components/Annotation/Menu.purs
View file @
aedbeb27
...
@@ -2,13 +2,17 @@
...
@@ -2,13 +2,17 @@
module Gargantext.Components.Annotation.Menu where
module Gargantext.Components.Annotation.Menu where
import Prelude (Unit, pure, ($), (<>), (==))
import Data.Array as A
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
import Effect.Uncurried (mkEffectFn1)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as HTML
import Reactix.DOM.HTML as HTML
import Toestand as T
import Gargantext.Prelude
import Gargantext.Types (TermList(..), termListName)
import Gargantext.Types (TermList(..), termListName)
import Gargantext.Components.Annotation.Utils (termBootstrapClass)
import Gargantext.Components.Annotation.Utils (termBootstrapClass)
...
@@ -20,6 +24,9 @@ here :: R2.Here
...
@@ -20,6 +24,9 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.Menu"
here = R2.here "Gargantext.Components.Annotation.Menu"
data MenuType = NewNgram | SetTermListItem
data MenuType = NewNgram | SetTermListItem
derive instance genericMenuType :: Generic MenuType _
instance eqMenuType :: Eq MenuType where
eq = genericEq
type Props =
type Props =
( list :: Maybe TermList
( list :: Maybe TermList
...
@@ -28,19 +35,49 @@ type Props =
...
@@ -28,19 +35,49 @@ type Props =
)
)
type AnnotationMenu = (
type AnnotationMenu = (
x :: Number
onClose :: Effect Unit
, y :: Number
, redrawMenu :: T.Box Boolean
, onClose :: Effect Unit
, x :: Number
, y :: Number
| Props
| Props
)
)
type AnnotationMenuWrapper =
(
menuRef :: R.Ref (Maybe (Record AnnotationMenu))
)
eqAnnotationMenu :: Record AnnotationMenu -> Record AnnotationMenu -> Boolean
eqAnnotationMenu new old = new.list == old.list &&
new.menuType == old.menuType &&
new.x == old.x &&
new.y == old.y
eqAnnotationMenuWrapper :: { new :: Maybe (Record AnnotationMenu)
, old :: Maybe (Record AnnotationMenu) } -> Effect Boolean
eqAnnotationMenuWrapper { new: Nothing, old: Nothing } = pure $ true
eqAnnotationMenuWrapper { new: Nothing, old: Just _ } = pure $ false
eqAnnotationMenuWrapper { new: Just _, old: Nothing } = pure $ false
eqAnnotationMenuWrapper { new: Just n, old: Just o } = pure $ eqAnnotationMenu n o
annotationMenuWrapper :: R2.Leaf AnnotationMenuWrapper
annotationMenuWrapper p = R.createElement annotationMenuWrapperCpt p []
annotationMenuWrapperCpt :: R.Component AnnotationMenuWrapper
annotationMenuWrapperCpt = here.component "annotationMenuWrapper" cpt where
cpt { menuRef } _ = do
case R.readRef menuRef of
Nothing -> pure $ HTML.div {} []
Just menu -> pure $ annotationMenu menu
-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to
-- | TermList the currently selected text belongs to
annotationMenu :: R2.Leaf AnnotationMenu
annotationMenu :: R2.Leaf AnnotationMenu
annotationMenu p = R.createElement annotationMenuCpt p []
annotationMenu p = R.createElement annotationMenuCpt p []
annotationMenuCpt :: R.Component AnnotationMenu
annotationMenuCpt :: R.Component AnnotationMenu
annotationMenuCpt = here.component "annotationMenu" cpt where
annotationMenuCpt = here.component "annotationMenu" cpt where
cpt { x, y, list, menuType, onClose, setList } _ = do
cpt { x, y, list, menuType, onClose, redrawMenu, setList } _ = do
redrawMenu' <- T.useLive T.unequal redrawMenu
pure $ CM.contextMenu {x, y, onClose} [
pure $ CM.contextMenu {x, y, onClose} [
annotationMenuInner { list, menuType, setList }
annotationMenuInner { list, menuType, setList }
]
]
...
...
src/Gargantext/Components/App.purs
View file @
aedbeb27
module Gargantext.Components.App (app) where
module Gargantext.Components.App (app) where
import Reactix as R
import Toestand as T
import Gargantext.Prelude
import Gargantext.Prelude
...
@@ -9,8 +11,6 @@ import Gargantext.Hooks (useHashRouter)
...
@@ -9,8 +11,6 @@ import Gargantext.Hooks (useHashRouter)
import Gargantext.Router as Router
import Gargantext.Router as Router
import Gargantext.Sessions as Sessions
import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Toestand as T
here :: R2.Here
here :: R2.Here
here = R2.here "Gargantext.Components.App"
here = R2.here "Gargantext.Components.App"
...
...
src/Gargantext/Components/ContextMenu/ContextMenu.purs
View file @
aedbeb27
...
@@ -39,7 +39,9 @@ contextMenuCpt = here.component "contextMenu" cpt
...
@@ -39,7 +39,9 @@ contextMenuCpt = here.component "contextMenu" cpt
cpt menu@{ x, y, onClose } children = do
cpt menu@{ x, y, onClose } children = do
host <- R2.getPortalHost
host <- R2.getPortalHost
root <- R.useRef null
root <- R.useRef null
rect <- T.useBox Nothing
-- rect <- T.useBox $ Just $ R2.domRectFromRect { x, y, width: 224.6, height: 102.0 }
let childRect = R2.boundingRect children
rect <- T.useBox $ Just $ R2.domRectFromRect { x, y, width: childRect.width, height: childRect.height }
rect' <- T.useLive T.unequal rect
rect' <- T.useLive T.unequal rect
R.useLayoutEffect1 (R.readRef root) $ do
R.useLayoutEffect1 (R.readRef root) $ do
...
@@ -47,7 +49,7 @@ contextMenuCpt = here.component "contextMenu" cpt
...
@@ -47,7 +49,7 @@ contextMenuCpt = here.component "contextMenu" cpt
(\r -> T.write_ (Just (Element.boundingRect r)) rect)
(\r -> T.write_ (Just (Element.boundingRect r)) rect)
(toMaybe $ R.readRef root)
(toMaybe $ R.readRef root)
pure $ pure unit
pure $ pure unit
R.useLayoutEffect2
root rect
(contextMenuEffect onClose root)
R.useLayoutEffect2
(R.readRef root) rect'
(contextMenuEffect onClose root)
let cs = [
let cs = [
HTML.div { className: "popover-content" }
HTML.div { className: "popover-content" }
[ HTML.div { className: "card" }
[ HTML.div { className: "card" }
...
@@ -64,7 +66,7 @@ contextMenuCpt = here.component "contextMenu" cpt
...
@@ -64,7 +66,7 @@ contextMenuCpt = here.component "contextMenu" cpt
, style: position menu rect
, style: position menu rect
, data: { placement: "right", toggle: "popover" }
, data: { placement: "right", toggle: "popover" }
}
}
elems ref
_ _
= HTML.div
elems ref
menu Nothing
= HTML.div
{ ref
{ ref
, key: "context-menu"
, key: "context-menu"
, className: "context-menu"
, className: "context-menu"
...
...
src/Gargantext/Components/Router.purs
View file @
aedbeb27
...
@@ -41,6 +41,7 @@ import Gargantext.Sessions as Sessions
...
@@ -41,6 +41,7 @@ import Gargantext.Sessions as Sessions
import Gargantext.Types (CorpusId, Handed(..), ListId, NodeID, NodeType(..), SessionId, SidePanelState(..), reverseHanded)
import Gargantext.Types (CorpusId, Handed(..), ListId, NodeID, NodeType(..), SessionId, SidePanelState(..), reverseHanded)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here :: R2.Here
here = R2.here "Gargantext.Components.Router"
here = R2.here "Gargantext.Components.Router"
...
...
src/Gargantext/Utils/Reactix.js
View file @
aedbeb27
...
@@ -23,11 +23,16 @@ function setCookie(c) {
...
@@ -23,11 +23,16 @@ function setCookie(c) {
document
.
cookie
=
c
;
document
.
cookie
=
c
;
}
}
function
domRectFromRect
(
obj
)
{
return
DOMRectReadOnly
.
fromRect
(
obj
)
}
exports
.
_addRootElement
=
addRootElement
;
exports
.
_addRootElement
=
addRootElement
;
exports
.
_getSelection
=
getSelection
;
exports
.
_getSelection
=
getSelection
;
exports
.
_stringify
=
stringify
;
exports
.
_stringify
=
stringify
;
exports
.
_postMessage
=
postMessage
;
exports
.
_postMessage
=
postMessage
;
exports
.
_setCookie
=
setCookie
;
exports
.
_setCookie
=
setCookie
;
exports
.
_domRectFromRect
=
domRectFromRect
;
exports
.
_keyCode
=
function
(
e
)
{
exports
.
_keyCode
=
function
(
e
)
{
// https://www.w3schools.com/jsref/event_key_keycode.asp
// https://www.w3schools.com/jsref/event_key_keycode.asp
...
...
src/Gargantext/Utils/Reactix.purs
View file @
aedbeb27
...
@@ -2,22 +2,22 @@ module Gargantext.Utils.Reactix where
...
@@ -2,22 +2,22 @@ module Gargantext.Utils.Reactix where
import Prelude
import Prelude
import DOM.Simple as DOM
import DOM.Simple.Console (log2)
import DOM.Simple.Document (document)
import DOM.Simple.Element as Element
import DOM.Simple.Event as DE
import DOM.Simple.Types (class IsNode)
import Data.Argonaut as Argonaut
import Data.Argonaut as Argonaut
import Data.Argonaut as Json
import Data.Argonaut as Json
import Data.Argonaut.Core (Json)
import Data.Argonaut.Core (Json)
import Data.Array as A
import Data.Either (hush)
import Data.Either (hush)
import Data.Function.Uncurried (Fn2, runFn2)
import Data.Function.Uncurried (Fn
1, runFn1, Fn
2, runFn2)
import Data.Maybe (Maybe(..), fromJust, fromMaybe, isJust)
import Data.Maybe (Maybe(..), fromJust, fromMaybe, isJust)
import Data.Nullable (Nullable, null, toMaybe)
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM
import DOM.Simple.Console (log2)
import DOM.Simple.Console (log2)
import DOM.Simple.Document (document)
import DOM.Simple.Element as Element
import DOM.Simple.Event as DE
import DOM.Simple.Types (class IsNode, class IsElement, DOMRect)
import Effect (Effect)
import Effect (Effect)
import Effect.Console (logShow)
import Effect.Console (logShow)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
...
@@ -398,3 +398,35 @@ setTrigger tRef fun = R.setRef tRef $ Just fun
...
@@ -398,3 +398,35 @@ setTrigger tRef fun = R.setRef tRef $ Just fun
clearTrigger :: forall a. Trigger a -> Effect Unit
clearTrigger :: forall a. Trigger a -> Effect Unit
clearTrigger tRef = R.setRef tRef Nothing
clearTrigger tRef = R.setRef tRef Nothing
type Rect =
( x :: Number
, y :: Number
, width :: Number
, height :: Number )
foreign import _domRectFromRect :: Fn1 (Record Rect) DOMRect
domRectFromRect :: Record Rect -> DOMRect
domRectFromRect = runFn1 _domRectFromRect
boundingRect :: forall e. IsElement e => Array e -> DOMRect
boundingRect els =
case A.uncons els of
Nothing -> domRectFromRect { x: 0.0, y: 0.0, width: 0.0, height: 0.0 }
Just { head, tail } ->
let br = Element.boundingRect head
in
case tail of
[] -> br
_ ->
let brs = boundingRect tail
minx = min br.left brs.left
maxx = max br.right brs.right
miny = min br.top brs.top
maxy = max br.bottom brs.bottom
in
domRectFromRect { x: minx
, y: miny
, width: maxx - minx
, height: maxy - miny }
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment