Fix touch events to work properly on mobile and desktop and redo tutorial 8

source/clog-base.lisp

@@ -218,18 +218,18 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
 
 (defparameter touch-event-script
   "+ (e.touches[0].clientX -
-        e.touches[0].currentTarget.getBoundingClientRect().left +
+	e.touches[0].target.getBoundingClientRect().left +
-        e.touches[0].currentTarget.scrollLeft) + ':' +
+	e.touches[0].target.scrollLeft) + ':' +
      (e.touches[0].clientY -
-        e.touches[0].currentTarget.getBoundingClientRect().top +
+	e.touches[0].target.getBoundingClientRect().top +
-        e.touches[0].currentTarget.scrollTop) + ':' +
+	e.touches[0].target.scrollTop) + ':' +
      e.touches[0].screenX + ':' + e.touches[0].screenY + ':' + e.touches.length + ':' +
      e.altKey + ':' +
      e.ctrlKey + ':' +
      e.shiftKey + ':' +
      e.metaKey + ':' +
      e.touches[0].clientX + ':' + e.touches[0].clientY + ':' +
-     e..touches[0].pageX + ':' + e.touches[0].pageY"
+     e.touches[0].pageX + ':' + e.touches[0].pageY"
     "JavaScript to collect touch event data from browser.")
 
 (defun parse-touch-event (data)
@@ -828,7 +828,7 @@ event on right click."))
 ;; set-on-click ;;
 ;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-click (clog-obj on-click-handler &key one-time)
+(defgeneric set-on-click (clog-obj on-click-handler &key one-time cancel-event)
   (:documentation "Set the ON-CLICK-HANDLER for CLOG-OBJ. If ON-CLICK-HANDLER
 is nil unbind the event. Setting this event will replace an on-mouse click if
 set. If :ONE-TIME unbind event on click."))
@@ -985,30 +985,38 @@ does not bubble."))
 ;; set-on-mouse-up ;;
 ;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-mouse-up (clog-obj on-mouse-up-handler)
+(defgeneric set-on-mouse-up (clog-obj on-mouse-up-handler
+			     &key one-time cancel-event)
   (:documentation "Set the ON-MOUSE-UP-HANDLER for CLOG-OBJ. If
 ON-MOUSE-UP-HANDLER is nil unbind the event."))
 
-(defmethod set-on-mouse-up ((obj clog-obj) handler)
+(defmethod set-on-mouse-up ((obj clog-obj) handler
+			    &key (one-time nil) (cancel-event nil))
   (set-event obj "mouseup"
 	     (when handler
 	       (lambda (data)
 		 (funcall handler obj (parse-mouse-event data))))
+	     :one-time one-time
+	     :cancel-event cancel-event
 	     :call-back-script mouse-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-mouse-move ;;
 ;;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-mouse-move (clog-obj on-mouse-move-handler)
+(defgeneric set-on-mouse-move (clog-obj on-mouse-move-handler
+			       &key one-time cancel-event)
   (:documentation "Set the ON-MOUSE-MOVE-HANDLER for CLOG-OBJ. If
 ON-MOUSE-MOVE-HANDLER is nil unbind the event."))
 
-(defmethod set-on-mouse-move ((obj clog-obj) handler)
+(defmethod set-on-mouse-move ((obj clog-obj) handler
+			    &key (one-time nil) (cancel-event nil))
   (set-event obj "mousemove"
 	     (when handler
 	       (lambda (data)
 		 (funcall handler obj (parse-mouse-event data))))
+	     :one-time one-time
+	     :cancel-event cancel-event
 	     :call-back-script mouse-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1085,79 +1093,98 @@ even does not bubble."))
 ;; set-on-pointer-up ;;
 ;;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-pointer-up (clog-obj on-pointer-up-handler)
+(defgeneric set-on-pointer-up (clog-obj on-pointer-up-handler
+			       &key one-time cancel-event)
   (:documentation "Set the ON-POINTER-UP-HANDLER for CLOG-OBJ. If
 ON-POINTER-UP-HANDLER is nil unbind the event."))
 
-(defmethod set-on-pointer-up ((obj clog-obj) handler)
+(defmethod set-on-pointer-up ((obj clog-obj) handler
+			      &key (one-time nil) (cancel-event nil))
   (set-event obj "pointerup"
 	     (when handler
 	       (lambda (data)
 		 (funcall handler obj (parse-pointer-event data))))
 	     :post-eval (format nil "; ~A.releasePointerCapture(e.pointerId)"
 				(script-id obj))
+	     :one-time one-time
+	     :cancel-event cancel-event
 	     :call-back-script pointer-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-pointer-move ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-pointer-move (clog-obj on-pointer-move-handler)
+(defgeneric set-on-pointer-move (clog-obj on-pointer-move-handler
+				 &key one-time cancel-event)
   (:documentation "Set the ON-POINTER-MOVE-HANDLER for CLOG-OBJ. If
 ON-POINTER-MOVE-HANDLER is nil unbind the event."))
 
-(defmethod set-on-pointer-move ((obj clog-obj) handler)
+(defmethod set-on-pointer-move ((obj clog-obj) handler
+				&key (one-time nil) (cancel-event nil))
   (set-event obj "pointermove"
 	     (when handler
 	       (lambda (data)
 		 (funcall handler obj (parse-pointer-event data))))
+	     :one-time one-time
+	     :cancel-event cancel-event
 	     :call-back-script pointer-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-touch-start ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-touch-start (clog-obj on-touch-start-handler &key one-time)
+(defgeneric set-on-touch-start (clog-obj on-touch-start-handler
+				&key one-time cancel-event)
   (:documentation "Set the ON-TOUCH-START-HANDLER for CLOG-OBJ. If
 ON-TOUCH-START-HANDLER is nil unbind the event."))
 
-(defmethod set-on-touch-start ((obj clog-obj) handler &key (one-time nil))
+(defmethod set-on-touch-start ((obj clog-obj) handler
+			       &key (one-time nil) (cancel-event nil))
   (set-event obj "touchstart"
 	     (when handler
 	       (lambda (data)
 		 (funcall handler obj (parse-touch-event data))))
 	     :one-time one-time
+	     :cancel-event cancel-event
 	     :call-back-script touch-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-touch-move ;;
 ;;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-touch-move (clog-obj on-touch-move-handler)
+(defgeneric set-on-touch-move (clog-obj on-touch-move-handler
+			       &key one-time cancel-event)
   (:documentation "Set the ON-TOUCH-MOVE-HANDLER for CLOG-OBJ. If
 ON-TOUCH-MOVE-HANDLER is nil unbind the event."))
 
-(defmethod set-on-touch-move ((obj clog-obj) handler)
+(defmethod set-on-touch-move ((obj clog-obj) handler
+			      &key (one-time nil) (cancel-event nil))
   (set-event obj "touchmove"
 	     (when handler
 	       (lambda (data)
 		 (funcall handler obj (parse-touch-event data))))
+	     :one-time one-time
+	     :cancel-event cancel-event
 	     :call-back-script touch-event-script))
 
 ;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-touch-end ;;
 ;;;;;;;;;;;;;;;;;;;;;;
 
-(defgeneric set-on-touch-end (clog-obj on-touch-end-handler)
+(defgeneric set-on-touch-end (clog-obj on-touch-end-handler
+			      &key one-time cancel-event)
   (:documentation "Set the ON-TOUCH-END-HANDLER for CLOG-OBJ. If
 ON-TOUCH-END-HANDLER is nil unbind the event."))
 
-(defmethod set-on-touch-end ((obj clog-obj) handler)
+(defmethod set-on-touch-end ((obj clog-obj) handler
+			     &key (one-time nil) (cancel-event nil))
   (set-event obj "touchend"
 	     (when handler
 	       (lambda (data)
-                 (funcall handler obj (parse-touch-event data))))
+		 (declare (ignore dara))
-             :call-back-script touch-event-script))
+		 (funcall handler obj)))
+	     :one-time one-time
+	     :cancel-event cancel-event))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-touch-cancel ;;
@@ -1171,8 +1198,8 @@ ON-TOUCH-CANCEL-HANDLER is nil unbind the event."))
   (set-event obj "touchcancel"
 	     (when handler
 	       (lambda (data)
-                 (funcall handler obj (parse-touch-event data))))
+		 (declare (ignore dara))
-             :call-back-script touch-event-script))
+		 (funcall handler obj)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-character ;;

tutorial/08-tutorial.lisp

@@ -5,10 +5,10 @@
 (in-package :clog-tut-8)
 
 (defclass app-data ()
-  ((in-drag
+  ((drag-type
-    :accessor in-drag-p
+    :accessor drag-type
     :initform nil
-    :documentation "Ensure only one box is dragged at a time.")
+    :documentation "Ensure only pointer or touch events.")
     (drag-x
     :accessor drag-x
     :documentation "The location of the left side of the box relative to mouse during drag.")
@@ -17,26 +17,32 @@
    :documentation "The location of the top of the box relative to mouse during drag."))
   (:documentation "App data specific to each instance of our tutorial 8 app"))
 
+(defun stop-tracking (obj)
+  (set-on-pointer-move obj nil)
+  (set-on-pointer-up obj nil)
+  (set-on-touch-move obj nil)
+  (set-on-touch-end obj nil)
+  (let ((app (connection-data-item obj "app-data")))
+    (setf (drag-type app) nil)))
+
 (defun on-mouse-down (obj data)
-  (with-sync-event (obj)                                 ; Serialize events to on-mouse-down.
+  (let ((app (connection-data-item obj "app-data")))
-    (let ((app (connection-data-item obj "app-data")))   ; Ensure the first event received
+    (with-sync-event (obj)                     ; Process one event at a time
-      (unless (in-drag-p app)                            ; to drag is the only one, ie only
+      (when (eq (drag-type app) :pointer)      ; Prefer touch events to pointer events
-        (setf (in-drag-p app) t)                         ; the innermost box is dragged.
+	(stop-tracking obj))                   ; to accomidate mobile devices emulating mice
+      (setf (drag-type app) (getf data :event-type))
       (let* ((mouse-x  (getf data :screen-x))  ; Use the screen coordinates not
 	     (mouse-y  (getf data :screen-y))  ; the coordinates relative to the obj
 	     (obj-top  (parse-integer (top obj) :junk-allowed t))
 	     (obj-left (parse-integer (left obj) :junk-allowed t)))
 	(setf (drag-x app) (- mouse-x obj-left))
 	(setf (drag-y app) (- mouse-y obj-top))
-          (if (eq (getf data :event-type) :touch)
+	(cond ((eq (getf data :event-type) :touch)
-              (progn
 	       (set-on-touch-move obj 'on-mouse-move)
-                (set-on-touch-end obj 'stop-obj-grab)
+	       (set-on-touch-end obj 'on-touch-end))
-                (set-on-touch-cancel obj 'on-mouse-leave))
+	      (t
-              (progn
+	       (set-on-pointer-move obj 'on-mouse-move)
-                (set-on-mouse-move obj 'on-mouse-move)
+	       (set-on-pointer-up obj 'on-mouse-up)))))))
-                (set-on-mouse-up obj 'stop-obj-grab)
-                (set-on-mouse-leave obj 'on-mouse-leave))))))))
 
 (defun on-mouse-move (obj data)
   (let* ((app (connection-data-item obj "app-data"))
@@ -45,19 +51,12 @@
     (setf (top obj) (unit :px (- y (drag-y app))))
     (setf (left obj) (unit :px (- x (drag-x app))))))
 
-(defun on-mouse-leave (obj)
+(defun on-mouse-up (obj data)
-  (let ((app (connection-data-item obj "app-data")))
+  (declare (ignore data))
-    (setf (in-drag-p app) nil)
+  (stop-tracking obj))
-    (set-on-touch-move obj nil)
-    (set-on-touch-end obj nil)
-    (set-on-touch-cancel obj nil)
-    (set-on-mouse-move obj nil)
-    (set-on-mouse-up obj nil)
-    (set-on-mouse-leave obj nil)))
 
-(defun stop-obj-grab (obj data)
+(defun on-touch-end (obj)
-  (on-mouse-move obj data)
+  (stop-tracking obj))
-  (on-mouse-leave obj))
 
 (defun on-new-window (body)
   (let ((app (make-instance 'app-data)))                 ; Create our "App-Data" for this instance
@@ -85,15 +84,18 @@
     ;; to the entire window.
     (setf (positioning div1) :fixed)        ; Its location relative to window
     (setf (overflow div1) :hidden)          ; Clip the contents
-    (set-on-touch-start div1 'on-mouse-down)
-    (set-on-mouse-down div1 'on-mouse-down)
     (setf (positioning div2) :absolute)     ; Its location relative to its parent container
     (setf (overflow div2) :hidden)
-    (set-on-touch-start div2 'on-mouse-down)
-    (set-on-mouse-down div2 'on-mouse-down)
     (setf (positioning div3) :absolute)
-    (set-on-touch-start div3 'on-mouse-down)
+    ;; Setup mouse/touch/pointer events
-    (set-on-mouse-down div3 'on-mouse-down)))
+    ;; Since our divs are embedded on with in the other we use cancel-event so events do
+    ;; not bubble up from one div to another
+    (set-on-touch-start div1 'on-mouse-down :cancel-event t)
+    (set-on-touch-start div2 'on-mouse-down :cancel-event t)
+    (set-on-touch-start div3 'on-mouse-down :cancel-event t)
+    (set-on-pointer-down div1 'on-mouse-down :cancel-event t :capture-pointer t)
+    (set-on-pointer-down div2 'on-mouse-down :cancel-event t :capture-pointer t)
+    (set-on-pointer-down div3 'on-mouse-down :cancel-event t :capture-pointer t)))
 
 (defun start-tutorial ()
   "Start turtorial."