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

performace enhacements

Browse source
This commit is contained in:
David Botton 2024-06-21 18:18:14 -04:00
parent 519cadddd4
commit 452ee0b1b8
5 changed files with 437 additions and 422 deletions
Download patch file Download diff file Expand all files Collapse all files

65
source/clog-gui.lisp
View file

@ -990,38 +990,39 @@ The on-window-change clog-obj received is the new window"))
"Handle mouse down on drag items"
(let ((app (connection-data-item obj "clog-gui")))
(setf (in-drag app) (attribute obj "data-drag-type"))
(let* ((target (gethash (attribute obj "data-drag-obj") (windows app)))
(pointer-x (getf data ':screen-x))
(pointer-y (getf data ':screen-y))
(obj-top)
(obj-left)
(perform-drag nil))
(when target
(setf (drag-obj app) target)
(cond ((equalp (in-drag app) "m")
(setf obj-top
(js-to-integer (top (drag-obj app))))
(setf obj-left
(js-to-integer (left (drag-obj app))))
(setf perform-drag (fire-on-window-can-move (drag-obj app))))
((equalp (in-drag app) "s")
(setf obj-top (height (drag-obj app)))
(setf obj-left (width (drag-obj app)))
(setf perform-drag (fire-on-window-can-size (drag-obj app))))
(t
(format t "Warning - invalid data-drag-type attribute")))
(unless (keep-on-top (drag-obj app))
(setf (z-index (drag-obj app)) (incf (last-z app))))
(fire-on-window-change (drag-obj app) app)
(setf (drag-y app) (- pointer-y obj-top))
(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))))))
(handler-case
(let* ((target (gethash (attribute obj "data-drag-obj") (windows app)))
(pointer-x (getf data ':screen-x))
(pointer-y (getf data ':screen-y))
(obj-top)
(obj-left)
(perform-drag nil))
(when target
(setf (drag-obj app) target)
(cond ((equalp (in-drag app) "m")
(setf obj-top
(js-to-integer (top (drag-obj app))))
(setf obj-left
(js-to-integer (left (drag-obj app))))
(setf perform-drag (fire-on-window-can-move (drag-obj app))))
((equalp (in-drag app) "s")
(setf obj-top (height (drag-obj app)))
(setf obj-left (width (drag-obj app)))
(setf perform-drag (fire-on-window-can-size (drag-obj app))))
(t
(format t "Warning - invalid data-drag-type attribute")))
(unless (keep-on-top (drag-obj app))
(setf (z-index (drag-obj app)) (incf (last-z app))))
(fire-on-window-change (drag-obj app) app)
(setf (drag-y app) (- pointer-y obj-top))
(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))))
(error () nil))))
;;;;;;;;;;;;;;;;;;;;;;
;; on-gui-drag-move ;;
;;;;;;;;;;;;;;;;;;;;;;