8c50940 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Merge pull request #130 from reflex-frp/touch-event-result

8c50940Ali Abrar10 years ago

src/Reflex/Dom/Builder/Class/Events.hs+26−4

compare with develop

unifiedsplit

@@ -148,11 +148,33 @@ type family EventResultType (en :: EventTag) :: * where

148 EventResultType 'ResetTag = ()

149 EventResultType 'SearchTag = ()

150 EventResultType 'SelectstartTag = ()

151− EventResultType 'TouchstartTag = [(Int, Int)]

151+ EventResultType 'TouchstartTag = TouchEventResult

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

152+ EventResultType 'TouchmoveTag = TouchEventResult

153− EventResultType 'TouchendTag = [(Int, Int)]

153+ EventResultType 'TouchendTag = TouchEventResult

154− EventResultType 'TouchcancelTag = [(Int, Int)]

154+ EventResultType 'TouchcancelTag = TouchEventResult

155 EventResultType 'WheelTag = ()

156

157+data TouchEventResult = TouchEventResult

158+ { _touchEventResult_altKey :: Bool

159+ , _touchEventResult_changedTouches :: [TouchResult]

160+ , _touchEventResult_ctrlKey :: Bool

161+ , _touchEventResult_metaKey :: Bool

162+ , _touchEventResult_shiftKey :: Bool

163+ , _touchEventResult_targetTouches :: [TouchResult]

164+ , _touchEventResult_touches :: [TouchResult]

165+ }

166+ deriving (Show, Read, Eq, Ord)

167+

168+data TouchResult = TouchResult

169+ { _touchResult_identifier :: Word

170+ , _touchResult_screenX :: Int

171+ , _touchResult_screenY :: Int

172+ , _touchResult_clientX :: Int

173+ , _touchResult_clientY :: Int

174+ , _touchResult_pageX :: Int

175+ , _touchResult_pageY :: Int

176+ }

177+ deriving (Show, Read, Eq, Ord)

178+

157deriveGEq ''EventName

179deriveGEq ''EventName

158deriveGCompare ''EventName

180deriveGCompare ''EventName

src/Reflex/Dom/Builder/Immediate.hs+52−22

@@ -624,10 +624,10 @@ defaultDomEventHandler e evt = fmap (Just . EventResult) $ case evt of

624 Reset -> return ()

625 Search -> return ()

626 Selectstart -> return ()

627− Touchstart -> getTouchEventCoords

627+ Touchstart -> getTouchEvent

628− Touchmove -> getTouchEventCoords

628+ Touchmove -> getTouchEvent

629− Touchend -> getTouchEventCoords

629+ Touchend -> getTouchEvent

630− Touchcancel -> getTouchEventCoords

630+ Touchcancel -> getTouchEvent

631 Mousewheel -> return ()

632 Wheel -> return ()

633

@@ -674,10 +674,10 @@ defaultDomWindowEventHandler w evt = fmap (Just . EventResult) $ case evt of

674 Reset -> return ()

675 Search -> return ()

676 Selectstart -> return ()

677− Touchstart -> getTouchEventCoords

677+ Touchstart -> getTouchEvent

678− Touchmove -> getTouchEventCoords

678+ Touchmove -> getTouchEvent

679− Touchend -> getTouchEventCoords

679+ Touchend -> getTouchEvent

680− Touchcancel -> getTouchEventCoords

680+ Touchcancel -> getTouchEvent

681 Mousewheel -> return ()

682 Wheel -> return ()

683

@@ -887,22 +887,52 @@ getMouseEventCoords = do

887 bisequence (getClientX e, getClientY e)

888

889#ifdef __GHCJS__

890−{-# INLINABLE getTouchEventCoords #-}

890+{-# INLINABLE getTouchEvent #-}

891−getTouchEventCoords :: EventM e TouchEvent [(Int, Int)]

891+getTouchEvent :: EventM e TouchEvent TouchEventResult

892−getTouchEventCoords = do

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+ identifier <- Touch.getIdentifier t

901+ screenX <- Touch.getScreenX t

902+ screenY <- Touch.getScreenY t

903+ clientX <- Touch.getClientX t

904+ clientY <- Touch.getClientY t

905+ pageX <- Touch.getPageX t

906+ pageY <- Touch.getPageY t

907+ return $ TouchResult

908+ { _touchResult_identifier = identifier

909+ , _touchResult_screenX = screenX

910+ , _touchResult_screenY = screenY

911+ , _touchResult_clientX = clientX

912+ , _touchResult_clientY = clientY

913+ , _touchResult_pageX = pageX

914+ , _touchResult_pageY = pageY

915+ }

893 e <- event

916 e <- event

917+ altKey <- TouchEvent.getAltKey e

918+ ctrlKey <- TouchEvent.getCtrlKey e

919+ shiftKey <- TouchEvent.getShiftKey e

920+ metaKey <- TouchEvent.getMetaKey e

921+ changedTouches <- touchResults =<< TouchEvent.getChangedTouches e

922+ targetTouches <- touchResults =<< TouchEvent.getTargetTouches e

894− mTouchList <- TouchEvent.getTouches e

923+ touches <- touchResults =<< TouchEvent.getTouches e

895− case mTouchList of

924+ return $ TouchEventResult

896− Just touchList -> do

925+ { _touchEventResult_altKey = altKey

897− touchListLength <- TouchList.getLength touchList

926+ , _touchEventResult_changedTouches = changedTouches

898− mTouchCoords <- forM [0..touchListLength - 1] $ \i -> do

927+ , _touchEventResult_ctrlKey = ctrlKey

899− mTouch <- TouchList.item touchList i

928+ , _touchEventResult_metaKey = metaKey

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

929+ , _touchEventResult_shiftKey = shiftKey

901− sequence $ catMaybes mTouchCoords

930+ , _touchEventResult_targetTouches = targetTouches

902− _ -> return []

931+ , _touchEventResult_touches = touches

932+ }

903#else

933#else

904−getTouchEventCoords :: EventM e TouchEvent [(Int, Int)]

934+getTouchEvent :: EventM e TouchEvent TouchEventResult

905−getTouchEventCoords = return []

935+getTouchEvent = return $ TouchEventResult False [] False False False [] []

906#endif

936#endif

907

937

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

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