added on-pointer-cancel event to cover touch cancels

This commit is contained in:
David Botton 2024-01-29 10:49:37 -05:00
parent 845a8b7066
commit dc5693a6d4
3 changed files with 26 additions and 1 deletions

View file

@ -1113,6 +1113,27 @@ ON-POINTER-UP-HANDLER is nil unbind the event."))
:cancel-event cancel-event
:call-back-script pointer-event-script))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; set-on-pointer-cancel ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric set-on-pointer-cancel (clog-obj on-pointer-cancel-handler
&key one-time cancel-event)
(:documentation "Set the ON-POINTER-CANCEL-HANDLER for CLOG-OBJ. If
ON-POINTER-CANCEL-HANDLER is nil unbind the event."))
(defmethod set-on-pointer-cancel ((obj clog-obj) handler
&key (one-time nil) (cancel-event nil))
(set-event obj "pointercancel"
(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 ;;
;;;;;;;;;;;;;;;;;;;;;;;;;

View file

@ -711,6 +711,7 @@ The on-window-change clog-obj received is the new window"))
(setf (drag-x app) (- pointer-x obj-left)))
(cond (perform-drag
(set-on-pointer-move obj 'on-gui-drag-move)
(set-on-pointer-cancel obj 'on-gui-drag-stop)
(set-on-pointer-up obj 'on-gui-drag-stop))
(t
(setf (in-drag app) nil)))))))
@ -744,6 +745,7 @@ The on-window-change clog-obj received is the new window"))
(let ((app (connection-data-item obj "clog-gui")))
(on-gui-drag-move obj data)
(set-on-pointer-move obj nil)
(set-on-pointer-cancel obj nil)
(set-on-pointer-up obj nil)
(cond ((equalp (in-drag app) "m")
(fire-on-window-move-done (drag-obj app)))
@ -891,7 +893,8 @@ for identifiying the window to use with window-to-top-by-param or window-by-para
(lambda (obj data)
(declare (ignore obj data))
(setf (z-index win) (incf (last-z app)))
(fire-on-window-change win app)))
(fire-on-window-change win app))
:capture-pointer t)
(clog::set-on-event win "dragstart"
(lambda (obj)
(declare (ignore obj))

View file

@ -183,6 +183,7 @@ embedded in a native template application.)"
(set-on-pointer-out generic-function)
(set-on-pointer-down generic-function)
(set-on-pointer-up generic-function)
(set-on-pointer-cancel generic-function)
(set-on-pointer-move generic-function)
(set-on-touch-start generic-function)
(set-on-touch-move generic-function)