@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE ConstraintKinds #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE EmptyDataDecls #-}
@@ -59,6 +60,11 @@ import qualified GHCJS.DOM.HTMLInputElement as Input
5960import qualified GHCJS.DOM.HTMLSelectElement as Select
6061import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea
6162import 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
6268import GHCJS.DOM.Node (appendChild, getOwnerDocument, getParentNode, getPreviousSibling, removeChild,
6369 setNodeValue, toNode)
6470import qualified GHCJS.DOM.Node as DOM
@@ -622,7 +628,7 @@ defaultDomEventHandler e evt = fmap (Just . EventResult) $ case evt of
622628 Search -> return ()
623629 Selectstart -> return ()
624630 Touchstart -> return ()
625− Touchmove -> return ()
631+ Touchmove -> getTouchEventCoords
626632 Touchend -> return ()
627633 Touchcancel -> return ()
628634 Mousewheel -> return ()
@@ -672,7 +678,7 @@ defaultDomWindowEventHandler w evt = fmap (Just . EventResult) $ case evt of
672678 Search -> return ()
673679 Selectstart -> return ()
674680 Touchstart -> return ()
675− Touchmove -> return ()
681+ Touchmove -> getTouchEventCoords
676682 Touchend -> return ()
677683 Touchcancel -> return ()
678684 Mousewheel -> return ()
@@ -883,6 +889,25 @@ getMouseEventCoords = do
883889 e <- event
884890 bisequence (getClientX e, getClientY e)
885891
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+
886911instance MonadSample t m => MonadSample t (ImmediateDomBuilderT t m) where
887912 {-# INLINABLE sample #-}
888913 sample = lift . sample