touchpage 0.2.2

control panel server with shared-state web controls
Documentation 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177

module SvgTouch exposing (Msg(..), Touch, extractFirstRectTouchSE, extractFirstTouch, extractFirstTouchInRect, extractFirstTouchSE, extractTouchDict, extractTouches, makeTd, parseTouch, parseTouchCount)

import Dict
import Json.Decode as JD
import List
import String
import SvgThings



{- Every `Touch` has `xy` coordinates. It also has an identifier
   `id` to distinguish one touch from another.

   A touch also keeps info about the initial point and time of contact:
   `x0`, `y0`, and `t0`. This helps compute more complicated gestures
   like taps, drags, and swipes which need to know about timing or direction.
-}


stDebugLog : a -> b -> b
stDebugLog a b =
    -- Debug.log a b
    b


type Msg
    = SvgTouchStart JD.Value
    | SvgTouchMove JD.Value
    | SvgTouchEnd JD.Value
    | SvgTouchCancel JD.Value
    | SvgTouchLeave JD.Value


type alias Touch =
    { x : Float
    , y : Float
    , id : Int
    }


parseTouch : JD.Decoder Touch
parseTouch =
    JD.map3 Touch
        (JD.field "clientX" JD.float)
        (JD.field "clientY" JD.float)
        (JD.field "identifier" JD.int)


parseTouchCount : JD.Decoder Int
parseTouchCount =
    JD.at [ "touches", "length" ] JD.int


makeTd : List Touch -> Dict.Dict Int Touch
makeTd touchlist =
    Dict.fromList <| List.map (\t -> ( t.id, t )) touchlist


extractFirstTouchSE : Msg -> Maybe Touch
extractFirstTouchSE msg =
    case msg of
        SvgTouchStart v ->
            extractFirstTouch v

        SvgTouchMove v ->
            extractFirstTouch v

        SvgTouchEnd v ->
            Nothing

        SvgTouchCancel v ->
            Nothing

        SvgTouchLeave v ->
            Nothing


extractFirstRectTouchSE : Msg -> SvgThings.Rect -> Maybe Touch
extractFirstRectTouchSE msg rect =
    case msg of
        SvgTouchStart v ->
            extractFirstTouchInRect v rect

        SvgTouchMove v ->
            extractFirstTouchInRect v rect

        SvgTouchEnd v ->
            Nothing

        SvgTouchCancel v ->
            Nothing

        SvgTouchLeave v ->
            Nothing


extractTouches : JD.Value -> List Touch
extractTouches evt =
    case JD.decodeValue parseTouchCount evt of
        Ok touchcount ->
            let
                touchresults =
                    List.map
                        (\idx -> JD.decodeValue (JD.at [ "touches", String.fromInt idx ] parseTouch) evt)
                        (List.range 0 (touchcount - 1))

                touches =
                    List.foldr
                        (\rst tl ->
                            case rst of
                                Ok touch ->
                                    touch :: tl

                                Err e ->
                                    stDebugLog (JD.errorToString e) tl
                        )
                        []
                        touchresults
            in
            touches

        Err str_msg ->
            stDebugLog (JD.errorToString str_msg) []


extractFirstTouchInRect : JD.Value -> SvgThings.Rect -> Maybe Touch
extractFirstTouchInRect evt rect =
    let
        touches =
            extractTouches evt
    in
    List.head
        (List.filter
            (\touch ->
                SvgThings.containsXY rect (truncate touch.x) (truncate touch.y)
            )
            touches
        )


extractTouchDict : JD.Value -> Dict.Dict Int Touch
extractTouchDict evt =
    case JD.decodeValue parseTouchCount evt of
        Ok touchcount ->
            let
                touchresults =
                    List.map
                        (\idx -> JD.decodeValue (JD.at [ "touches", String.fromInt idx ] parseTouch) evt)
                        (List.range 0 (touchcount - 1))

                touches =
                    List.foldr
                        (\rst tl ->
                            case rst of
                                Ok touch ->
                                    touch :: tl

                                Err e ->
                                    stDebugLog (JD.errorToString e) tl
                        )
                        []
                        touchresults
            in
            makeTd touches

        Err str_msg ->
            stDebugLog (JD.errorToString str_msg) Dict.empty


extractFirstTouch : JD.Value -> Maybe Touch
extractFirstTouch evt =
    case JD.decodeValue (JD.at [ "touches", "0" ] parseTouch) evt of
        Ok touch ->
            Just touch

        Err e ->
            stDebugLog (JD.errorToString e) Nothing