0ea0b12 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Merge pull request #125 from reflex-frp/sr-touchmove-coordinates

0ea0b12Ryan Trinkle10 years ago

src/Reflex/Dom/Builder/Class/Events.hs+1−1

compare with develop

unifiedsplit

@@ -149,7 +149,7 @@ type family EventResultType (en :: EventTag) :: * where

149 EventResultType 'SearchTag = ()

150 EventResultType 'SelectstartTag = ()

151 EventResultType 'TouchstartTag = ()

152− EventResultType 'TouchmoveTag = ()

152+ EventResultType 'TouchmoveTag = [(Int, Int)]

153 EventResultType 'TouchendTag = ()

154 EventResultType 'TouchcancelTag = ()

155 EventResultType 'WheelTag = ()

src/Reflex/Dom/Builder/Immediate.hs+27−2

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE ConstraintKinds #-}

2{-# LANGUAGE ConstraintKinds #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE EmptyDataDecls #-}

4{-# LANGUAGE EmptyDataDecls #-}

@@ -59,6 +60,11 @@ import qualified GHCJS.DOM.HTMLInputElement as Input

59import qualified GHCJS.DOM.HTMLSelectElement as Select

60import qualified GHCJS.DOM.HTMLSelectElement as Select

60import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea

61import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea

61import GHCJS.DOM.MouseEvent

62import GHCJS.DOM.MouseEvent

63+#ifdef __GHCJS__

64+import qualified GHCJS.DOM.Touch as Touch

65+import qualified GHCJS.DOM.TouchEvent as TouchEvent

66+import qualified GHCJS.DOM.TouchList as TouchList

67+#endif

62import GHCJS.DOM.Node (appendChild, getOwnerDocument, getParentNode, getPreviousSibling, removeChild,

68import GHCJS.DOM.Node (appendChild, getOwnerDocument, getParentNode, getPreviousSibling, removeChild,

63 setNodeValue, toNode)

69 setNodeValue, toNode)

64import qualified GHCJS.DOM.Node as DOM

70import qualified GHCJS.DOM.Node as DOM

@@ -622,7 +628,7 @@ defaultDomEventHandler e evt = fmap (Just . EventResult) $ case evt of

622 Search -> return ()

628 Search -> return ()

623 Selectstart -> return ()

629 Selectstart -> return ()

624 Touchstart -> return ()

630 Touchstart -> return ()

625− Touchmove -> return ()

631+ Touchmove -> getTouchEventCoords

626 Touchend -> return ()

632 Touchend -> return ()

627 Touchcancel -> return ()

633 Touchcancel -> return ()

628 Mousewheel -> return ()

634 Mousewheel -> return ()

@@ -672,7 +678,7 @@ defaultDomWindowEventHandler w evt = fmap (Just . EventResult) $ case evt of

672 Search -> return ()

678 Search -> return ()

673 Selectstart -> return ()

679 Selectstart -> return ()

674 Touchstart -> return ()

680 Touchstart -> return ()

675− Touchmove -> return ()

681+ Touchmove -> getTouchEventCoords

676 Touchend -> return ()

682 Touchend -> return ()

677 Touchcancel -> return ()

683 Touchcancel -> return ()

678 Mousewheel -> return ()

684 Mousewheel -> return ()

@@ -883,6 +889,25 @@ getMouseEventCoords = do

883 e <- event

889 e <- event

884 bisequence (getClientX e, getClientY e)

890 bisequence (getClientX e, getClientY e)

885

891

892+#ifdef __GHCJS__

893+{-# INLINABLE getTouchEventCoords #-}

894+getTouchEventCoords :: EventM e TouchEvent [(Int, Int)]

895+getTouchEventCoords = do

896+ e <- event

897+ mTouchList <- TouchEvent.getTouches e

898+ case mTouchList of

899+ Just touchList -> do

900+ touchListLength <- TouchList.getLength touchList

901+ mTouchCoords <- forM [0..touchListLength - 1] $ \i -> do

902+ mTouch <- TouchList.item touchList i

903+ return $ fmap (\t -> bisequence (Touch.getClientX t, Touch.getClientY t)) mTouch

904+ sequence $ catMaybes mTouchCoords

905+ _ -> return []

906+#else

907+getTouchEventCoords :: EventM e TouchEvent [(Int, Int)]

908+getTouchEventCoords = return []

909+#endif

910+

886instance MonadSample t m => MonadSample t (ImmediateDomBuilderT t m) where

911instance MonadSample t m => MonadSample t (ImmediateDomBuilderT t m) where

887 {-# INLINABLE sample #-}

912 {-# INLINABLE sample #-}

888 sample = lift . sample

913 sample = lift . sample