From dab3046544de636e4b3d494a7b128ff7c7d8b566 Mon Sep 17 00:00:00 2001 From: David Botton Date: Mon, 22 Jan 2024 00:30:33 -0500 Subject: [PATCH] Fix touch events to work properly on mobile and desktop and redo tutorial 8 --- source/clog-base.lisp | 493 ++++++++++++++++++++------------------ tutorial/08-tutorial.lisp | 94 ++++---- 2 files changed, 308 insertions(+), 279 deletions(-) diff --git a/source/clog-base.lisp b/source/clog-base.lisp index b516b91..ba0f448 100644 --- a/source/clog-base.lisp +++ b/source/clog-base.lisp @@ -118,7 +118,7 @@ flushed with FLUSH-CONNECTION-CACHE or a query is made." (when *connection-cache* (dolist (script (reverse *connection-cache*)) (unless (eq script :cache) - (clog-connection:execute (connection-id clog-obj) script))) + (clog-connection:execute (connection-id clog-obj) script))) (setf *connection-cache* (list :cache)))) ;;;;;;;;;;;;;; @@ -131,7 +131,7 @@ flushed with FLUSH-CONNECTION-CACHE or a query is made." (defmethod js-query ((obj clog-obj) script &key (default-answer nil)) (flush-connection-cache obj) (clog-connection:query (connection-id obj) script - :default-answer default-answer)) + :default-answer default-answer)) ;;;;;;;;;;;;; ;; execute ;; @@ -154,7 +154,7 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (defmethod query ((obj clog-obj) method &key (default-answer nil)) (js-query obj (format nil "~A.~A" (script-id obj) method) - :default-answer default-answer)) + :default-answer default-answer)) ;;;;;;;;;;;;;;;;;;;;;;; ;; bind-event-script ;; @@ -166,7 +166,7 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (defmethod bind-event-script ((obj clog-obj) event call-back) (jquery-execute obj (format nil "on('~A',function (e, data){~A})" - event call-back))) + event call-back))) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; unbind-event-script ;; @@ -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].currentTarget.scrollLeft) + ':' + + e.touches[0].target.getBoundingClientRect().left + + e.touches[0].target.scrollLeft) + ':' + (e.touches[0].clientY - - e.touches[0].currentTarget.getBoundingClientRect().top + - e.touches[0].currentTarget.scrollTop) + ':' + + e.touches[0].target.getBoundingClientRect().top + + 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) @@ -301,8 +301,8 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) :shift-key (js-true-p (nth 4 f)) :meta-key (js-true-p (nth 5 f)) :key (if (equal (nth 6 f) "colon") - ":" - (nth 6 f))))) + ":" + (nth 6 f))))) ;;;;;;;;;;;;;;;;;;;;;; ;; parse-drop-event ;; @@ -333,39 +333,39 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) ;;;;;;;;;;;;;;; (defgeneric set-event (clog-obj event handler - &key call-back-script - eval-script - post-eval - cancel-event - one-time) + &key call-back-script + eval-script + post-eval + cancel-event + one-time) (:documentation "Create the hook for incoming events. (Private)")) (defmethod set-event ((obj clog-obj) event handler - &key (call-back-script "") - (eval-script "") - (post-eval "") - (cancel-event nil) - (one-time nil)) + &key (call-back-script "") + (eval-script "") + (post-eval "") + (cancel-event nil) + (one-time nil)) (let ((hook (format nil "~A:~A" (html-id obj) event)) - (cd (connection-data obj))) + (cd (connection-data obj))) (if cd - (cond (handler - (bind-event-script - obj event (format nil "~Aws.send('E:~A '~A)~A~@[~A~]~@[~A~]" - eval-script - hook - call-back-script - post-eval - (when one-time - (format nil "; ~A.off('~A')" - (jquery obj) - event)) - (when cancel-event "; return false"))) - (setf (gethash hook cd) handler)) - (t - (unbind-event-script obj event) - (remhash hook cd))) - (format t "Attempt to set event on non-existant connection.~%")))) + (cond (handler + (bind-event-script + obj event (format nil "~Aws.send('E:~A '~A)~A~@[~A~]~@[~A~]" + eval-script + hook + call-back-script + post-eval + (when one-time + (format nil "; ~A.off('~A')" + (jquery obj) + event)) + (when cancel-event "; return false"))) + (setf (gethash hook cd) handler)) + (t + (unbind-event-script obj event) + (remhash hook cd))) + (format t "Attempt to set event on non-existant connection.~%")))) ;;;;;;;;;;;;;; ;; property ;; @@ -376,15 +376,15 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (defmethod property ((obj clog-obj) property-name &key (default-answer nil)) (jquery-query obj (format nil "prop('~A')" property-name) - :default-answer default-answer)) + :default-answer default-answer)) (defgeneric (setf property) (value clog-obj property-name) (:documentation "Set html property.")) (defmethod (setf property) (value (obj clog-obj) property-name) (jquery-execute obj (format nil "prop('~A','~A')" - property-name - (escape-string value))) + property-name + (escape-string value))) value) ;;;;;;;;;;;; @@ -529,21 +529,21 @@ an application share per connection the same queue of serialized events." ;;;;;;;;;;;;;;;;;; (defgeneric set-on-event (clog-obj event-name handler - &key cancel-event one-time) + &key cancel-event one-time) (:documentation "Set a HANDLER for EVENT-NAME on CLOG-OBJ. If handler is nil unbind all event handlers. (Internal)")) (defmethod set-on-event ((obj clog-obj) event-name handler - &key - (cancel-event nil) - (one-time nil)) + &key + (cancel-event nil) + (one-time nil)) (set-event obj event-name - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :cancel-event cancel-event - :one-time one-time)) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :cancel-event cancel-event + :one-time one-time)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -551,23 +551,23 @@ nil unbind all event handlers. (Internal)")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-event-with-data (clog-obj event-name handler - &key cancel-event one-time) + &key cancel-event one-time) (:documentation "Set a HANDLER for EVENT-NAME on CLOG-OBJ. If handler is nil unbind all event handlers. Handler is called with a data option passed from javascript calling the jQuery custom event mechanism .trigger('event_name', data) (Internal)")) (defmethod set-on-event-with-data ((obj clog-obj) event-name handler - &key - (cancel-event nil) - (one-time nil)) + &key + (cancel-event nil) + (one-time nil)) (set-event obj event-name - (when handler - (lambda (data) - (funcall handler obj data))) - :call-back-script "+data" - :cancel-event cancel-event - :one-time one-time)) + (when handler + (lambda (data) + (funcall handler obj data))) + :call-back-script "+data" + :cancel-event cancel-event + :one-time one-time)) ;;;;;;;;;;;;;;;;;;; ;; set-on-resize ;; @@ -630,21 +630,21 @@ is nil unbind the event.")) ;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-drag-start (clog-obj on-drag-start-handler - &key drag-data drag-type) + &key drag-data drag-type) (:documentation "Set the ON-DRAG-START-HANDLER for CLOG-OBJ. If ON-DRAG-START-HANDLER is nil unbind the event.")) (defmethod set-on-drag-start ((obj clog-obj) handler - &key (drag-data "") (drag-type "text/plain")) + &key (drag-data "") (drag-type "text/plain")) (set-event obj "dragstart" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :eval-script (format nil - "e.originalEvent.dataTransfer.setData('~A','~A'); " - drag-type - drag-data))) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :eval-script (format nil + "e.originalEvent.dataTransfer.setData('~A','~A'); " + drag-type + drag-data))) ;;;;;;;;;;;;;;;;; ;; set-on-drag ;; @@ -701,12 +701,12 @@ is nil unbind the event.")) (defmethod set-on-drag-over ((obj clog-obj) handler) (set-event obj "dragover" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :cancel-event t - :eval-script "e.preventDefault(); ")) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :cancel-event t + :eval-script "e.preventDefault(); ")) ;;;;;;;;;;;;;;;;; ;; set-on-drop ;; @@ -718,12 +718,12 @@ is nil unbind the event.")) (defmethod set-on-drop ((obj clog-obj) handler &key (drag-type "text/plain")) (set-event obj "drop" - (when handler - (lambda (data) - (funcall handler obj (parse-drop-event data)))) - :call-back-script (format nil drop-event-script drag-type) - :eval-script "e.preventDefault(); " - :cancel-event t)) + (when handler + (lambda (data) + (funcall handler obj (parse-drop-event data)))) + :call-back-script (format nil drop-event-script drag-type) + :eval-script "e.preventDefault(); " + :cancel-event t)) ;;;;;;;;;;;;;;;;;;;;; ;; set-on-focus-in ;; @@ -758,11 +758,11 @@ this event is bound, you must call the form reset manually.")) (defmethod set-on-reset ((obj clog-obj) handler) (set-event obj "reset" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :cancel-event t)) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :cancel-event t)) ;;;;;;;;;;;;;;;;;;; ;; set-on-search ;; @@ -798,18 +798,18 @@ form action to be run. See CLOG-Form SUBMIT for more details.")) (defmethod set-on-submit ((obj clog-obj) handler) (set-event obj "submit" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :cancel-event t)) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :cancel-event t)) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-context-menu ;; ;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-context-menu (clog-obj on-context-menu-handler - &key one-time) + &key one-time) (:documentation "Set the ON-CONTEXT-MENU-HANDLER for CLOG-OBJ. If ON-CONTEXT-MENU-HANDLER is nil unbind the event. Setting on-mouse-right-click will replace this handler. If :ONE-TIME unbind @@ -817,29 +817,29 @@ event on right click.")) (defmethod set-on-context-menu ((obj clog-obj) handler &key (one-time nil)) (set-event obj "contextmenu" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :one-time one-time - :cancel-event t)) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :one-time one-time + :cancel-event t)) ;;;;;;;;;;;;;;;;;; ;; 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.")) (defmethod set-on-click ((obj clog-obj) handler &key one-time cancel-event) (set-event obj "click" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :one-time one-time + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :one-time one-time :cancel-event cancel-event)) ;;;;;;;;;;;;;;;;;;;;;;;;; @@ -847,18 +847,18 @@ set. If :ONE-TIME unbind event on click.")) ;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-double-click (clog-obj on-double-click-handler - &key one-time cancel-event) + &key one-time cancel-event) (:documentation "Set the ON-DOUBLE-CLICK-HANDLER for CLOG-OBJ. If ON-DOUBLE-CLICK-HANDLER is nil unbind the event. Setting the on-mouse-double-click event will replace this handler.")) (defmethod set-on-double-click ((obj clog-obj) handler &key one-time cancel-event) (set-event obj "dblclick" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :one-time one-time + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :one-time one-time :cancel-event cancel-event)) ;;;;;;;;;;;;;;;;;;;;;;;; @@ -872,50 +872,50 @@ on an on-click event.")) (defmethod set-on-mouse-click ((obj clog-obj) handler &key one-time cancel-event) (set-event obj "click" - (when handler - (lambda (data) - (funcall handler obj (parse-mouse-event data)))) - :one-time one-time + (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)) + :call-back-script mouse-event-script)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-mouse-double-click ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-mouse-double-click (clog-obj on-mouse-double-click-handler - &key one-time) + &key one-time) (:documentation "Set the ON-MOUSE-DOUBLE-CLICK-HANDLER for CLOG-OBJ. If ON-MOUSE-DOUBLE-CLICK-HANDLER is nil unbind the event. Setting this event will replace on an on-double-click event.")) (defmethod set-on-mouse-double-click ((obj clog-obj) handler &key (one-time nil)) (set-event obj "dblclick" - (when handler - (lambda (data) - (funcall handler obj (parse-mouse-event data)))) - :one-time one-time - :call-back-script mouse-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-mouse-event data)))) + :one-time one-time + :call-back-script mouse-event-script)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-mouse-right-click ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-mouse-right-click (clog-obj on-mouse-right-click-handler - &key one-time) + &key one-time) (:documentation "Set the ON-MOUSE-RIGHT-CLICK-HANDLER for CLOG-OBJ. If ON-MOUSE-RIGHT-CLICK-HANDLER is nil unbind the event. Setting this event will replace on an on-context-menu event.")) (defmethod set-on-mouse-right-click ((obj clog-obj) handler - &key (one-time nil)) + &key (one-time nil)) (set-event obj "contextmenu" - (when handler - (lambda (data) - (funcall handler obj (parse-mouse-event data)))) - :one-time one-time - :call-back-script mouse-event-script - :cancel-event t)) + (when handler + (lambda (data) + (funcall handler obj (parse-mouse-event data)))) + :one-time one-time + :call-back-script mouse-event-script + :cancel-event t)) ;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-mouse-enter ;; @@ -966,50 +966,58 @@ If ON-MOUSE-OVER-HANDLER is nil unbind the event.")) ;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-mouse-down (clog-obj on-mouse-down-handler - &key one-time cancel-event) + &key one-time cancel-event) (:documentation "Set the ON-MOUSE-DOWN-HANDLER for CLOG-OBJ. If ON-MOUSE-DOWN-HANDLER is nil unbind the event. If cancel-event is true event does not bubble.")) (defmethod set-on-mouse-down ((obj clog-obj) handler - &key (one-time nil) (cancel-event nil)) + &key (one-time nil) (cancel-event nil)) (set-event obj "mousedown" - (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)) + (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-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)))) - :call-back-script mouse-event-script)) + (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)))) - :call-back-script mouse-event-script)) + (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-pointer-enter ;; @@ -1060,104 +1068,123 @@ ON-MOUSE-MOVE-HANDLER is nil unbind the event.")) ;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-pointer-down (clog-obj on-pointer-down-handler - &key capture-pointer one-time cancel-event) + &key capture-pointer one-time cancel-event) (:documentation "Set the ON-POINTER-DOWN-HANDLER for CLOG-OBJ. If ON-POINTER-DOWN-HANDLER is nil unbind the event. If cancel event is t the even does not bubble.")) (defmethod set-on-pointer-down ((obj clog-obj) handler - &key (capture-pointer nil) - (one-time nil) - (cancel-event nil)) + &key (capture-pointer nil) + (one-time nil) + (cancel-event nil)) (set-event obj "pointerdown" - (when handler - (lambda (data) - (funcall handler obj (parse-pointer-event data)))) - :post-eval (if capture-pointer - (format nil "; ~A.setPointerCapture(e.pointerId)" - (script-id obj)) - "") - :one-time one-time - :cancel-event cancel-event - :call-back-script pointer-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-pointer-event data)))) + :post-eval (if capture-pointer + (format nil "; ~A.setPointerCapture(e.pointerId)" + (script-id obj)) + "") + :one-time one-time + :cancel-event cancel-event + :call-back-script pointer-event-script)) ;;;;;;;;;;;;;;;;;;;;;;; ;; 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)) - :call-back-script pointer-event-script)) + (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)))) - :call-back-script pointer-event-script)) + (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 - :call-back-script touch-event-script)) + (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)))) - :call-back-script touch-event-script)) + (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)))) - :call-back-script touch-event-script)) + (when handler + (lambda (data) + (declare (ignore dara)) + (funcall handler obj))) + :one-time one-time + :cancel-event cancel-event)) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-touch-cancel ;; @@ -1169,52 +1196,52 @@ ON-TOUCH-CANCEL-HANDLER is nil unbind the event.")) (defmethod set-on-touch-cancel ((obj clog-obj) handler) (set-event obj "touchcancel" - (when handler - (lambda (data) - (funcall handler obj (parse-touch-event data)))) - :call-back-script touch-event-script)) + (when handler + (lambda (data) + (declare (ignore dara)) + (funcall handler obj))))) ;;;;;;;;;;;;;;;;;;;;;; ;; set-on-character ;; ;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-character (clog-obj on-character-handler - &key one-time disable-default) + &key one-time disable-default) (:documentation "Set the ON-CHARACTER-HANDLER for CLOG-OBJ. If ON-CHARACTER-HANDLER is nil unbind the event. If disable-default is t default key bindings in browser will not occur. Setting this event to nil will unbind on-key-press also.")) (defmethod set-on-character ((obj clog-obj) handler - &key (one-time nil) (disable-default nil)) + &key (one-time nil) (disable-default nil)) (set-event obj "keypress" - (when handler - (lambda (data) - (let ((f (parse-keyboard-event data))) - (funcall handler obj (code-char (getf f :char-code)))))) - :one-time one-time - :cancel-event disable-default - :call-back-script keyboard-event-script)) + (when handler + (lambda (data) + (let ((f (parse-keyboard-event data))) + (funcall handler obj (code-char (getf f :char-code)))))) + :one-time one-time + :cancel-event disable-default + :call-back-script keyboard-event-script)) ;;;;;;;;;;;;;;;;;;;;; ;; set-on-key-down ;; ;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-key-down (clog-obj on-key-down-handler - &key one-time disable-default) + &key one-time disable-default) (:documentation "Set the ON-KEY-DOWN-HANDLER for CLOG-OBJ. If disable-default is t default key bindings in browser will not occur. If ON-KEY-DOWN-HANDLER is nil unbind the event.")) (defmethod set-on-key-down ((obj clog-obj) handler - &key (one-time nil) (disable-default nil)) + &key (one-time nil) (disable-default nil)) (set-event obj "keydown" - (when handler - (lambda (data) - (funcall handler obj (parse-keyboard-event data)))) - :one-time one-time - :cancel-event disable-default - :call-back-script keyboard-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-keyboard-event data)))) + :one-time one-time + :cancel-event disable-default + :call-back-script keyboard-event-script)) ;;;;;;;;;;;;;;;;;;; ;; set-on-key-up ;; @@ -1226,30 +1253,30 @@ ON-KEY-UP-HANDLER is nil unbind the event.")) (defmethod set-on-key-up ((obj clog-obj) handler &key (one-time nil)) (set-event obj "keyup" - (when handler - (lambda (data) - (funcall handler obj (parse-keyboard-event data)))) - :one-time one-time - :call-back-script keyboard-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-keyboard-event data)))) + :one-time one-time + :call-back-script keyboard-event-script)) ;;;;;;;;;;;;;;;;;;;;;; ;; set-on-key-press ;; ;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-key-press (clog-obj on-key-press-handler - &key one-time disable-default) + &key one-time disable-default) (:documentation "Set the ON-KEY-PRESS-HANDLER for CLOG-OBJ. If ON-KEY-PRESS-HANDLER is nil unbind the event.")) (defmethod set-on-key-press ((obj clog-obj) handler - &key (one-time nil) (disable-default nil)) + &key (one-time nil) (disable-default nil)) (set-event obj "keypress" - (when handler - (lambda (data) - (funcall handler obj (parse-keyboard-event data)))) - :one-time one-time - :cancel-event disable-default - :call-back-script keyboard-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-keyboard-event data)))) + :one-time one-time + :cancel-event disable-default + :call-back-script keyboard-event-script)) ;;;;;;;;;;;;;;;;; ;; set-on-copy ;; diff --git a/tutorial/08-tutorial.lisp b/tutorial/08-tutorial.lisp index ff11b06..b94e629 100644 --- a/tutorial/08-tutorial.lisp +++ b/tutorial/08-tutorial.lisp @@ -5,11 +5,11 @@ (in-package :clog-tut-8) (defclass app-data () - ((in-drag - :accessor in-drag-p + ((drag-type + :accessor drag-type :initform nil - :documentation "Ensure only one box is dragged at a time.") - (drag-x + :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.") (drag-y @@ -17,56 +17,55 @@ :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"))) ; Ensure the first event received - (unless (in-drag-p app) ; to drag is the only one, ie only - (setf (in-drag-p app) t) ; the innermost box is dragged. - (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) - (progn - (set-on-touch-move obj 'on-mouse-move) - (set-on-touch-end obj 'stop-obj-grab) - (set-on-touch-cancel obj 'on-mouse-leave)) - (progn - (set-on-mouse-move obj 'on-mouse-move) - (set-on-mouse-up obj 'stop-obj-grab) - (set-on-mouse-leave obj 'on-mouse-leave)))))))) + (let ((app (connection-data-item obj "app-data"))) + (with-sync-event (obj) ; Process one event at a time + (when (eq (drag-type app) :pointer) ; Prefer touch events to pointer events + (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)) + (cond ((eq (getf data :event-type) :touch) + (set-on-touch-move obj 'on-mouse-move) + (set-on-touch-end obj 'on-touch-end)) + (t + (set-on-pointer-move obj 'on-mouse-move) + (set-on-pointer-up obj 'on-mouse-up))))))) (defun on-mouse-move (obj data) (let* ((app (connection-data-item obj "app-data")) - (x (getf data :screen-x)) - (y (getf data :screen-y))) + (x (getf data :screen-x)) + (y (getf data :screen-y))) (setf (top obj) (unit :px (- y (drag-y app)))) (setf (left obj) (unit :px (- x (drag-x app)))))) -(defun on-mouse-leave (obj) - (let ((app (connection-data-item obj "app-data"))) - (setf (in-drag-p app) nil) - (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 on-mouse-up (obj data) + (declare (ignore data)) + (stop-tracking obj)) -(defun stop-obj-grab (obj data) - (on-mouse-move obj data) - (on-mouse-leave obj)) +(defun on-touch-end (obj) + (stop-tracking obj)) (defun on-new-window (body) (let ((app (make-instance 'app-data))) ; Create our "App-Data" for this instance (setf (connection-data-item body "app-data") app)) ; of our App. (setf (title (html-document body)) "Tutorial 08") (let* ((div1 (create-div body)) - (div2 (create-div div1)) - (div3 (create-div div2)) - (dir (create-div div1 :content "Click and drag the boxes"))) + (div2 (create-div div1)) + (div3 (create-div div2)) + (dir (create-div div1 :content "Click and drag the boxes"))) ;; Absolute allows fixed positioning relative to parent (setf (positioning dir) :absolute) (setf (bottom dir) 0) @@ -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) - (set-on-mouse-down div3 'on-mouse-down))) + ;; Setup mouse/touch/pointer events + ;; 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."