Touch.elm

module Signals.Touch where

import Json.Decode as D exposing ((:=))
import Html
import Html.Events exposing (on, onWithOptions)
import Signal exposing (Address(..), message)

type alias TouchPosition = {
        pageX : Float
    ,   pageY : Float
    }

type TouchEvent =
        TouchStart TouchPosition
    |   TouchMove TouchPosition
    |   TouchEnd
    |   TouchCancel

touchDecode : (TouchPosition -> TouchEvent) -> D.Decoder TouchEvent
touchDecode ctor =
    (D.oneOf [
        D.at ["touches", "0"] ((D.object2 TouchPosition ("pageX" := D.float) ("pageY" := D.float)))
    ,   ((D.object2 TouchPosition ("pageX" := D.float) ("pageY" := D.float)))
    ,   D.succeed { pageX = 0, pageY = 0 }
    ]) `D.andThen` (\y -> D.succeed (ctor y))

onTouchGen : Address a -> Bool -> ((TouchPosition -> TouchEvent) -> D.Decoder a) -> List Html.Attribute
onTouchGen address prevent decoder =
    let onDontPropagateMsg s ctor =
        onWithOptions s { stopPropagation = False, preventDefault = prevent } (decoder ctor) (\y -> message address y)
    in
    [
        onDontPropagateMsg "touchstart" TouchStart
    ,   onDontPropagateMsg "mousedown" TouchStart
    ,   onDontPropagateMsg "touchmove" TouchMove
    ,   onDontPropagateMsg "mousemove" TouchMove
    ,   onDontPropagateMsg "touchend" (\_ -> TouchEnd)
    ,   onDontPropagateMsg "mouseup" (\_ -> TouchEnd)
--    ,   onDontPropogateMsg "mouseout" (eventDecode TouchCancel) (\y -> message address y)
--    ,   onDontPropogateMsg "touchcancel" (eventDecode TouchCancel) (\y -> message address y)
    ]

onTouch : Address TouchEvent -> List Html.Attribute
onTouch address =
    onTouchGen address True touchDecode

onTouchDef : Address TouchEvent -> List Html.Attribute
onTouchDef address =
    onTouchGen address False touchDecode