@@ -624,10 +624,10 @@ defaultDomEventHandler e evt = fmap (Just . EventResult) $ case evt of
624624 Reset -> return ()
625625 Search -> return ()
626626 Selectstart -> return ()
627− Touchstart -> getTouchEventCoords
628− Touchmove -> getTouchEventCoords
629− Touchend -> getTouchEventCoords
630− Touchcancel -> getTouchEventCoords
627+ Touchstart -> getTouchEvent
628+ Touchmove -> getTouchEvent
629+ Touchend -> getTouchEvent
630+ Touchcancel -> getTouchEvent
631631 Mousewheel -> return ()
632632 Wheel -> return ()
633633
@@ -674,10 +674,10 @@ defaultDomWindowEventHandler w evt = fmap (Just . EventResult) $ case evt of
674674 Reset -> return ()
675675 Search -> return ()
676676 Selectstart -> return ()
677− Touchstart -> getTouchEventCoords
678− Touchmove -> getTouchEventCoords
679− Touchend -> getTouchEventCoords
680− Touchcancel -> getTouchEventCoords
677+ Touchstart -> getTouchEvent
678+ Touchmove -> getTouchEvent
679+ Touchend -> getTouchEvent
680+ Touchcancel -> getTouchEvent
681681 Mousewheel -> return ()
682682 Wheel -> return ()
683683
@@ -887,22 +887,53 @@ getMouseEventCoords = do
887887 bisequence (getClientX e, getClientY e)
888888
889889#ifdef __GHCJS__
890−{-# INLINABLE getTouchEventCoords #-}
891−getTouchEventCoords :: EventM e TouchEvent [(Int, Int)]
892−getTouchEventCoords = do
890+{-# INLINABLE getTouchEvent #-}
891+getTouchEvent :: EventM e TouchEvent TouchEventResult
892+getTouchEvent = do
893+ let touchResults = \case
894+ Nothing -> return []
895+ Just ts -> do
896+ n <- TouchList.getLength ts
897+ fmap catMaybes . forM [0 .. n - 1] $ \ix -> do
898+ mt <- TouchList.item ts ix
899+ forM mt $ \t -> do
900+ -- TODO: Applicative?
901+ identifier <- Touch.getIdentifier t
902+ screenX <- Touch.getScreenX t
903+ screenY <- Touch.getScreenY t
904+ clientX <- Touch.getClientX t
905+ clientY <- Touch.getClientY t
906+ pageX <- Touch.getPageX t
907+ pageY <- Touch.getPageY t
908+ return $ TouchResult
909+ { _touchResult_identifier = identifier
910+ , _touchResult_screenX = screenX
911+ , _touchResult_screenY = screenY
912+ , _touchResult_clientX = clientX
913+ , _touchResult_clientY = clientY
914+ , _touchResult_pageX = pageX
915+ , _touchResult_pageY = pageY
916+ }
893917 e <- event
894− mTouchList <- TouchEvent.getTouches e
895− case mTouchList of
896− Just touchList -> do
897− touchListLength <- TouchList.getLength touchList
898− mTouchCoords <- forM [0..touchListLength - 1] $ \i -> do
899− mTouch <- TouchList.item touchList i
900− return $ fmap (\t -> bisequence (Touch.getClientX t, Touch.getClientY t)) mTouch
901− sequence $ catMaybes mTouchCoords
902− _ -> return []
918+ altKey <- TouchEvent.getAltKey e
919+ ctrlKey <- TouchEvent.getCtrlKey e
920+ shiftKey <- TouchEvent.getShiftKey e
921+ metaKey <- TouchEvent.getMetaKey e
922+ changedTouches <- touchResults =<< TouchEvent.getChangedTouches e
923+ targetTouches <- touchResults =<< TouchEvent.getTargetTouches e
924+ touches <- touchResults =<< TouchEvent.getTouches e
925+ return $ TouchEventResult
926+ { _touchEventResult_altKey = altKey
927+ , _touchEventResult_changedTouches = changedTouches
928+ , _touchEventResult_ctrlKey = ctrlKey
929+ , _touchEventResult_metaKey = metaKey
930+ , _touchEventResult_shiftKey = shiftKey
931+ , _touchEventResult_targetTouches = targetTouches
932+ , _touchEventResult_touches = touches
933+ }
903934#else
904−getTouchEventCoords :: EventM e TouchEvent [(Int, Int)]
905−getTouchEventCoords = return []
935+getTouchEvent :: EventM e TouchEvent TouchEventResult
936+getTouchEvent = return $ TouchEventResult False [] False False False [] []
906937#endif
907938
908939instance MonadSample t m => MonadSample t (ImmediateDomBuilderT t m) where