Ur/Web Examples
Check-in [de3e6e7ecb]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:- in JsMove, bring back usage of signals in setMouseEvents
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:de3e6e7ecbea133df60b5709c021374e281000d5
User & Date: beyert 2015-02-21 08:15:38
Context
2015-02-23
01:41
- slight revisions to formatting check-in: 5a1c5eea69 user: beyert tags: trunk
2015-02-21
08:15
- in JsMove, bring back usage of signals in setMouseEvents check-in: de3e6e7ecb user: beyert tags: trunk
07:56
- fix instructions in jsMove to be properly reactive again (this time the fix is confirmed...) check-in: 0cc741e048 user: beyert tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to jsMove/jsMove.ur.

39
40
41
42
43
44
45


46
47
48
49

50
51
52
53
54
55
56
57
..
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
...
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

fun nullifyMouseEvents (touch: bool) : transaction unit =
  if touch then JsMoveJs.nullifyHandler "ontouchmove";
                JsMoveJs.nullifyHandler "ontouchstart"
  else JsMoveJs.nullifyHandler "onclick";
       JsMoveJs.nullifyHandler "onmousemove"



fun setMouseEvents (touchOn: source bool) (mouseOn: source bool)
  (clickToMove: source bool) (ptsrc: point') (minpt: point) (maxpt: point)
  : transaction unit =
  touchOn' <- get touchOn; mouseOn' <- get mouseOn;

  clickToMove' <- get clickToMove;
  let val f = (fn ptdest =>
         if mouseOn' then moveCircle ptsrc ptdest minpt maxpt
         else return ())
  in case (touchOn', mouseOn', clickToMove') of
    (False, True, True) => JsMoveJs.onClick f
  | (False, True, False) => JsMoveJs.onMouseMove f
  | (True, True, True) => JsMoveJs.onTouchStart f
................................................................................
  i <- source ("": string);
  keyOn <- source (False: bool);
  touchOn <- source (True: bool);
  mouseOn <- source (True: bool);
  clickToMove <- source (False: bool);
  return
    <xml><body onload={
    setMouseEvents touchOn mouseOn clickToMove (x, y) minPt maxPt}>
  <dyn signal={(JsMoveJs.initCanvas minPt maxPt (x, y));
               return <xml></xml>}/>
  <p>Position: <dyn signal={x' <- signal x; y' <- signal y;
                            return <xml>{[show (x', y')]}</xml>}/></p>
  <p>Touchscreen on: <dyn signal={mouseOn <- signal mouseOn;
                                  return <xml>{[mouseOn]}</xml>}/>
  <button value="Toggle Touchscreen"
................................................................................
    onclick={fn _ => mouseOn' <- get mouseOn;
             set mouseOn (not mouseOn')}/></p>
  <p>Touch Click to move: <dyn signal={clickToMove <- signal clickToMove;
                                       return <xml>{[clickToMove]}</xml>}/>
    <button value="Toggle Touch Click"
      onclick={fn _ => clickToMove' <- get clickToMove;
               set clickToMove (not clickToMove');

               setMouseEvents touchOn mouseOn clickToMove (x, y) minPt maxPt}/></p>
      <p><dyn signal={touchOn' <- signal touchOn;
                      keyOn' <- signal keyOn;
                      mouseOn' <- signal mouseOn;
                      clickToMove' <- signal clickToMove;
                      return <xml>
                        {[instructions touchOn' keyOn' mouseOn'
                          clickToMove']}</xml>}/></p></body></xml>
................................................................................
    onKeydown (fn kev => moveCircleKey kev (x, y) minPt maxPt;
                   keyVals <- get keys;
                   set keys ((kev.KeyCode: int) :: (keyVals: list int)));
    onKeyup (fn kev => keyVals <- get keys;
                 set keys (removeReverse
                    (fn (k1: int) : int => k1 = (kev.KeyCode: int))
                      (keyVals: list int)));
    setMouseEvents touchOn mouseOn clickToMove (x, y) minPt maxPt}>
  <dyn signal={(JsMoveJs.initCanvas minPt maxPt (x, y));
    return <xml></xml>}/>
  <p>Key pressed: <dyn signal={ks <- signal keys;
                               return <xml>{[show ks]}</xml>}/></p>
  <p>Position: <dyn signal={x <- signal x; y <- signal y;
                            return <xml>{[show (x, y)]}</xml>}/></p>
  <p>Mouse on: <dyn signal={mouseOn <- signal mouseOn;
                            return <xml>{[mouseOn]}</xml>}/>
  <button value="Toggle Mouse"
    onclick={fn _ => mouseOn' <- get mouseOn;
             set mouseOn (not mouseOn')}/></p>
  <p>Click to move: <dyn signal={clickToMove <- signal clickToMove;
                                 return <xml>{[clickToMove]}</xml>}/>
    <button value="Toggle Click"
      onclick={fn _ => clickToMove' <- get clickToMove;
               set clickToMove (not clickToMove');
               setMouseEvents touchOn mouseOn clickToMove (x, y) minPt maxPt
              }/></p>
      <p><dyn signal={touchOn' <- signal touchOn;
                      keyOn' <- signal keyOn;
                      mouseOn' <- signal mouseOn;
                      clickToMove' <- signal clickToMove;
                      return <xml>
                        {[instructions touchOn' keyOn' mouseOn'
                          clickToMove']}</xml>}/></p></body></xml>







>
>
|
|

<
>
|







 







|







 







>
|







 







|






|
|








|
|







39
40
41
42
43
44
45
46
47
48
49
50

51
52
53
54
55
56
57
58
59
..
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
...
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

fun nullifyMouseEvents (touch: bool) : transaction unit =
  if touch then JsMoveJs.nullifyHandler "ontouchmove";
                JsMoveJs.nullifyHandler "ontouchstart"
  else JsMoveJs.nullifyHandler "onclick";
       JsMoveJs.nullifyHandler "onmousemove"

fun s [t] (a : source t) : (signal t) = signal a

fun setMouseEvents (touchOn: signal bool) (mouseOn: signal bool)
  (clickToMove: signal bool) (ptsrc: point') (minpt: point) (maxpt: point)
  : transaction unit =

  touchOn' <- current touchOn; mouseOn' <- current mouseOn;
  clickToMove' <- current clickToMove;
  let val f = (fn ptdest =>
         if mouseOn' then moveCircle ptsrc ptdest minpt maxpt
         else return ())
  in case (touchOn', mouseOn', clickToMove') of
    (False, True, True) => JsMoveJs.onClick f
  | (False, True, False) => JsMoveJs.onMouseMove f
  | (True, True, True) => JsMoveJs.onTouchStart f
................................................................................
  i <- source ("": string);
  keyOn <- source (False: bool);
  touchOn <- source (True: bool);
  mouseOn <- source (True: bool);
  clickToMove <- source (False: bool);
  return
    <xml><body onload={
    setMouseEvents (s touchOn) (s mouseOn) (s clickToMove) (x, y) minPt maxPt}>
  <dyn signal={(JsMoveJs.initCanvas minPt maxPt (x, y));
               return <xml></xml>}/>
  <p>Position: <dyn signal={x' <- signal x; y' <- signal y;
                            return <xml>{[show (x', y')]}</xml>}/></p>
  <p>Touchscreen on: <dyn signal={mouseOn <- signal mouseOn;
                                  return <xml>{[mouseOn]}</xml>}/>
  <button value="Toggle Touchscreen"
................................................................................
    onclick={fn _ => mouseOn' <- get mouseOn;
             set mouseOn (not mouseOn')}/></p>
  <p>Touch Click to move: <dyn signal={clickToMove <- signal clickToMove;
                                       return <xml>{[clickToMove]}</xml>}/>
    <button value="Toggle Touch Click"
      onclick={fn _ => clickToMove' <- get clickToMove;
               set clickToMove (not clickToMove');
               setMouseEvents (s touchOn) (s mouseOn) (s clickToMove) (x, y)
                 minPt maxPt}/></p>
      <p><dyn signal={touchOn' <- signal touchOn;
                      keyOn' <- signal keyOn;
                      mouseOn' <- signal mouseOn;
                      clickToMove' <- signal clickToMove;
                      return <xml>
                        {[instructions touchOn' keyOn' mouseOn'
                          clickToMove']}</xml>}/></p></body></xml>
................................................................................
    onKeydown (fn kev => moveCircleKey kev (x, y) minPt maxPt;
                   keyVals <- get keys;
                   set keys ((kev.KeyCode: int) :: (keyVals: list int)));
    onKeyup (fn kev => keyVals <- get keys;
                 set keys (removeReverse
                    (fn (k1: int) : int => k1 = (kev.KeyCode: int))
                      (keyVals: list int)));
    setMouseEvents (s touchOn) (s mouseOn) (s clickToMove) (x, y) minPt maxPt}>
  <dyn signal={(JsMoveJs.initCanvas minPt maxPt (x, y));
    return <xml></xml>}/>
  <p>Key pressed: <dyn signal={ks <- signal keys;
                               return <xml>{[show ks]}</xml>}/></p>
  <p>Position: <dyn signal={x <- signal x; y <- signal y;
                            return <xml>{[show (x, y)]}</xml>}/></p>
  <p>Mouse on: <dyn signal={mouseOn' <- signal mouseOn;
                            return <xml>{[mouseOn']}</xml>}/>
  <button value="Toggle Mouse"
    onclick={fn _ => mouseOn' <- get mouseOn;
             set mouseOn (not mouseOn')}/></p>
  <p>Click to move: <dyn signal={clickToMove <- signal clickToMove;
                                 return <xml>{[clickToMove]}</xml>}/>
    <button value="Toggle Click"
      onclick={fn _ => clickToMove' <- get clickToMove;
               set clickToMove (not clickToMove');
               setMouseEvents (s touchOn) (s mouseOn) (s clickToMove) (x, y)
                 minPt maxPt}/></p>
      <p><dyn signal={touchOn' <- signal touchOn;
                      keyOn' <- signal keyOn;
                      mouseOn' <- signal mouseOn;
                      clickToMove' <- signal clickToMove;
                      return <xml>
                        {[instructions touchOn' keyOn' mouseOn'
                          clickToMove']}</xml>}/></p></body></xml>