mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

Add ability to handle wheel events with clog:set-on-wheel

Browse source
This commit is contained in:
Aethor 2025-03-03 11:15:39 +01:00
parent 4bac089b18
commit 36e2bd0d18
3 changed files with 44 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

37
source/clog-base.lisp
View file

@ -347,6 +347,24 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
:meta-key (js-true-p (nth 6 f))
:drag-data (quri:url-decode (or (nth 7 f) "")))))
;;;;;;;;;;;;;;;;;;;;;;;
;; parse-wheel-event ;;
;;;;;;;;;;;;;;;;;;;;;;;
(defparameter wheel-event-script
"+ e.originalEvent.deltaX + ':' + e.originalEvent.deltaY + ':' + e.originalEvent.deltaZ +
':' + e.originalEvent.deltaMode"
"JavaScript to collect wheel event data from browser.")
(defun parse-wheel-event (data)
(let ((f (ppcre:split ":" data)))
(list
:event-type :wheel
:delta-x (js-to-float (nth 0 f))
:delta-y (js-to-float (nth 1 f))
:delta-z (js-to-float (nth 2 f))
:delta-mode (js-to-integer (nth 3 f)))))
;;;;;;;;;;;;;;;
;; set-event ;;
;;;;;;;;;;;;;;;
@ -1062,6 +1080,25 @@ ON-MOUSE-MOVE-HANDLER is nil unbind the event."))
:cancel-event cancel-event
:call-back-script mouse-event-script))
;;;;;;;;;;;;;;;;;;
;; set-on-wheel ;;
;;;;;;;;;;;;;;;;;;
(defgeneric set-on-wheel (clog-obj on-wheel-handler
&key one-time cancel-event)
(:documentation "Set the ON-WHEEL-HANDLER for CLOG-OBJ. If
ON-WHEEL-HANDLER is nil unbind the event."))
(defmethod set-on-wheel ((obj clog-obj) handler
&key (one-time nil) (cancel-event nil))
(set-event obj "wheel"
(when handler
(lambda (data)
(funcall handler obj (parse-wheel-event data))))
:one-time one-time
:cancel-event cancel-event
:call-back-script wheel-event-script))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; set-on-pointer-enter ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;

1
source/clog.lisp
View file

@ -191,6 +191,7 @@ embedded in a native template application.)"
(set-on-mouse-down generic-function)
(set-on-mouse-up generic-function)
(set-on-mouse-move generic-function)
(set-on-wheel generic-function)
(set-on-pointer-enter generic-function)
(set-on-pointer-leave generic-function)
(set-on-pointer-over generic-function)