module Haste.Events.TouchEvents (
TouchEvent (..), TouchData (..), Touch (..)
) where
import Haste.Prim.Any
import Haste.Foreign
import Haste.Events.Core
import Haste.DOM.Core
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
data TouchEvent
= TouchStart
| TouchMove
| TouchEnd
| TouchCancel
data TouchData = TouchData {
touches :: [Touch],
targetTouches :: [Touch],
changedTouches :: [Touch]
}
data Touch = Touch {
identifier :: !Int,
target :: !Elem,
pageCoords :: !(Int, Int),
clientCoords :: !(Int, Int),
screenCoords :: !(Int, Int)
}
instance FromAny Touch where
fromAny t =
Touch <$> get t "identifier"
<*> get t "target"
<*> ((,) <$> get t "pageX" <*> get t "pageY")
<*> ((,) <$> get t "clientX" <*> get t "clientY")
<*> ((,) <$> get t "screenX" <*> get t "screenY")
instance Event TouchEvent where
type EventData TouchEvent = TouchData
eventName TouchStart = "touchstart"
eventName TouchMove = "touchmove"
eventName TouchEnd = "touchend"
eventName TouchCancel = "touchcancel"
eventData _ e = do
ts <- get e "touches"
(cts, tts) <- getTIDs e
return $ TouchData {
touches = ts,
changedTouches = filter ((`elem` cts) . identifier) ts,
targetTouches = filter ((`elem` tts) . identifier) ts
}
getTIDs :: JSAny -> IO ([Int], [Int])
getTIDs = ffi "(function(e) {\
var len = e.changedTouches.length;\
var chts = new Array(len);\
for(var i = 0; i < len; ++i) {chts[i] = e.changedTouches[i].identifier;}\
var len = e.targetTouches.length;\
var tts = new Array(len);\
for(var i = 0; i < len; ++i) {tts[i] = e.targetTouches[i].identifier;}\
return [chts, tts];})"