mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
Fix touch events to work properly on mobile and desktop and redo tutorial 8
This commit is contained in:
David Botton
parent
7e3c5954df
commit
dab3046544
2 changed files with 308 additions and 279 deletions
|
|
@ -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)
|
||||
|
|
@ -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))))
|
||||
:call-back-script touch-event-script))
|
||||
(declare (ignore dara))
|
||||
(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))))
|
||||
:call-back-script touch-event-script))
|
||||
(declare (ignore dara))
|
||||
(funcall handler obj)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-character ;;
|
||||
|
|
|
|||
|
|
@ -5,10 +5,10 @@
|
|||
(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.")
|
||||
: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"))) ; 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 ((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))
|
||||
(if (eq (getf data :event-type) :touch)
|
||||
(progn
|
||||
(cond ((eq (getf data :event-type) :touch)
|
||||
(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))))))))
|
||||
(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"))
|
||||
|
|
@ -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)
|
||||
(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
|
||||
|
|
@ -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."
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue