mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-05 18:20:36 -08:00
Code Issues Projects Releases Wiki Activity

Merge pull request #421 from Aethor/main

Browse source 
Add ability to handle wheel events with clog:set-on-wheel
This commit is contained in:
David Botton 2025-11-08 23:18:42 -05:00 • committed by GitHub
commit 0e9e3b09be
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
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)

6
test/test-clog.lisp
View file

@ -45,6 +45,12 @@
(lambda (obj data)
(declare (ignore obj))
(format t "x=~A Y=~A~%" (getf data ':x) (getf data ':y))))
(set-on-wheel *last-obj*
(lambda (obj data)
(declare (ignore obj))
(format t "delta-x=~A delta-y=~A~%"
(getf data ':delta-x)
(getf data ':delta-y))))
(set-on-key-down win
(lambda (obj data)
(declare (ignore obj))