@@ -0,0 +1,56 @@
1+{-# LANGUAGE RecursiveDo #-}
2+module Reflex.Dom.Widget.Resize where
3+
4+import Reflex
5+import Reflex.Dom.Class
6+import Reflex.Dom.Widget.Basic
7+
8+import Control.Monad
9+import Control.Monad.IO.Class
10+import Data.Monoid
11+import GHCJS.DOM.Element
12+
13+-- | A widget that wraps the given widget in a div and fires an event when resized.
14+-- Adapted from github.com/marcj/css-element-queries
15+resizeDetector :: MonadWidget t m => m a -> m (Event t (), a)
16+resizeDetector w = do
17+ let childStyle = "position: absolute; left: 0; top: 0;"
18+ containerAttrs = "style" =: "position: absolute; left: 0; top: 0; right: 0; bottom: 0; overflow: scroll; z-index: -1; visibility: hidden;"
19+ (parent, (expand, expandChild, shrink, w')) <- elAttr' "div" ("style" =: "position: relative;") $ do
20+ w' <- w
21+ elAttr "div" containerAttrs $ do
22+ (expand, (expandChild, _)) <- elAttr' "div" containerAttrs $ elAttr' "div" ("style" =: childStyle) $ return ()
23+ (shrink, _) <- elAttr' "div" containerAttrs $ elAttr "div" ("style" =: (childStyle <> "width: 200%; height: 200%;")) $ return ()
24+ return (expand, expandChild, shrink, w')
25+ let reset = do
26+ let e = _el_element expand
27+ s = _el_element shrink
28+ eow <- elementGetOffsetWidth e
29+ eoh <- elementGetOffsetHeight e
30+ let ecw = eow + 10
31+ ech = eoh + 10
32+ elementSetAttribute (_el_element expandChild) "style" (childStyle <> "width: " <> show ecw <> "px;" <> "height: " <> show ech <> "px;")
33+ esw <- elementGetScrollWidth e
34+ elementSetScrollLeft e esw
35+ esh <- elementGetScrollHeight e
36+ elementSetScrollTop e esh
37+ ssw <- elementGetScrollWidth s
38+ elementSetScrollLeft s ssw
39+ ssh <- elementGetScrollHeight s
40+ elementSetScrollTop s ssh
41+ lastWidth <- elementGetOffsetWidth (_el_element parent)
42+ lastHeight <- elementGetOffsetHeight (_el_element parent)
43+ return (Just lastWidth, Just lastHeight)
44+ resetIfChanged ds = do
45+ pow <- elementGetOffsetWidth (_el_element parent)
46+ poh <- elementGetOffsetHeight (_el_element parent)
47+ if ds == (Just pow, Just poh)
48+ then return Nothing
49+ else liftM Just reset
50+ pb <- getPostBuild
51+ expandScroll <- wrapDomEvent (_el_element expand) elementOnscroll $ return ()
52+ shrinkScroll <- wrapDomEvent (_el_element shrink) elementOnscroll $ return ()
53+ size0 <- performEvent $ fmap (const $ liftIO reset) pb
54+ rec resize <- performEventAsync $ fmap (\d cb -> liftIO $ cb =<< resetIfChanged d) $ tag (current dimensions) $ leftmost [expandScroll, shrinkScroll]
55+ dimensions <- holdDyn (Nothing, Nothing) $ leftmost [ size0, fmapMaybe id resize ]
56+ return (fmap (const ()) $ fmapMaybe id resize, w')