Ur/Web Examples
Check-in [0cc741e048]
Not logged in

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

Overview
Comment:- fix instructions in jsMove to be properly reactive again (this time the fix is confirmed...)
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:0cc741e04821824224339c8a9ddf69a4da7de1f6
User & Date: beyert 2015-02-21 07:56:42
Context
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
06:19
- fix instructions in jsMove to be properly reactive again check-in: fbf4cdd254 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
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
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
...
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: 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
  | (True, True, False) => JsMoveJs.onTouchMove f
  | _ => nullifyMouseEvents touchOn' end

fun sinkInstructions (touchOn: signal bool) (keyOn: signal bool)
  (mouseOn: signal bool) (click: signal bool) (outCell: source string)
  : transaction unit =
  touchOn' <- current touchOn; keyOn' <- current keyOn;
  mouseOn' <- current mouseOn; click' <- current click;
  set outCell let val device = if touchOn' then "touchscreen" else "mouse"
              in "Move the circle via " ^
                (if keyOn' then "the arrow keys " else "") ^
                case (keyOn', mouseOn', click') of

                  (True, True, True) => "or a mouse click"
                | (True, True, False) => " or a mouse movement"
                | (True, _, _) => ""
                | (False, True, True) => "a " ^ device ^ " click"
                | (False, True, False) => "a " ^ device ^ " movement"
                | _ => "clicking on one of the buttons to reactivate input" end

fun main_touch () : transaction page =
  x <- source (initPt.1: int); y <- source (initPt.2: int);
  i <- source ("": string);
  keyOn <- source (False: bool);
  touchOn <- source (True: bool);
  mouseOn <- source (True: bool);
  clickToMove <- source (False: bool);
  return
    <xml><body onload={
    sinkInstructions (signal touchOn) (signal keyOn) (signal mouseOn)
      (signal clickToMove) i;
    setMouseEvents (signal touchOn) (signal mouseOn) (signal 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 (signal touchOn) (signal mouseOn)



                 (signal clickToMove) (x, y) minPt maxPt}/></p>
      <p><dyn signal={cur <- signal i; return <xml>{[cur]}</xml>}/></p>


  </body></xml>

fun main () : transaction page =
  x <- source (initPt.1: int); y <- source (initPt.2: int);
  keys <- source ([]: list int);
  i <- source ("": string);
  keyOn <- source (True: bool);
  touchOn <- source (False: bool);
................................................................................
    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)));
    sinkInstructions (signal touchOn) (signal keyOn) (signal mouseOn)
      (signal clickToMove) i;
    setMouseEvents (signal touchOn) (signal mouseOn) (signal 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;
................................................................................
    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 (signal touchOn) (signal mouseOn)
                 (signal clickToMove) (x, y) minPt maxPt}/></p>
      <p><dyn signal={cur <- signal i; return <xml>{[cur]}</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
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
...
118
119
120
121
122
123
124



125
126
127
128
129
130
131
132
...
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
  | (True, True, False) => JsMoveJs.onTouchMove f
  | _ => nullifyMouseEvents touchOn' end

fun instructions (touchOn: bool) (keyOn: bool)
  (mouseOn: bool) (click: bool) : string =



  let val device = if touchOn then "touchscreen" else "mouse"
  in "Move the circle via " ^
    (if keyOn then "the arrow keys " else "") ^

    case (keyOn, mouseOn, click) of
      (True, True, True) => "or a mouse click"
    | (True, True, False) => " or a mouse movement"
    | (True, _, _) => ""
    | (False, True, True) => "a " ^ device ^ " click"
    | (False, True, False) => "a " ^ device ^ " movement"
    | _ => "clicking on one of the buttons to reactivate input" end

fun main_touch () : transaction page =
  x <- source (initPt.1: int); y <- source (initPt.2: int);
  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>

fun main () : transaction page =
  x <- source (initPt.1: int); y <- source (initPt.2: int);
  keys <- source ([]: list int);
  i <- source ("": string);
  keyOn <- source (True: bool);
  touchOn <- source (False: bool);
................................................................................
    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;
................................................................................
    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>