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

more efficient movement

Browse source
This commit is contained in:
David Botton 2024-07-23 09:26:59 -04:00
parent 58e97aa49c
commit bfd5dd2648
1 changed files with 22 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

52
tools/clog-builder-panels.lisp
View file

@ -246,6 +246,7 @@ return t on success"
(panel-id (html-id content)) (panel-id (html-id content))
(touch-x 0) (touch-x 0)
(touch-y 0) (touch-y 0)
(mv-state :off)
(placer (create-div control (placer (create-div control
:class "placer" :class "placer"
:style "position:absolute;box-sizing:content-box;" :style "position:absolute;box-sizing:content-box;"
@ -300,41 +301,32 @@ return t on success"
:height (client-height control)) :height (client-height control))
(jquery-execute placer "trigger('clog-builder-snap-shot')") (jquery-execute placer "trigger('clog-builder-snap-shot')")
(set-properties-after-geomentry-change control)))) (set-properties-after-geomentry-change control))))
(set-on-touch-move placer (lambda (obj data)
(declare (ignore obj))
(set-on-pointer-move content nil)
(set-geometry placer :top (+ (position-top control)
(- (getf data :screen-y) touch-y))
:left (+ (position-left control)
(- (getf data :screen-x) touch-x))))
:cancel-event t)
(set-on-touch-end placer (lambda (obj data)
(declare (ignore obj data))
(setf (background-color placer) "")
(set-geometry placer :units ""
:top (top control)
:left (left control))
(select-control control)
(jquery-execute placer "trigger('clog-builder-snap-shot')")
(set-properties-after-geomentry-change control))
:cancel-event t)
(flet ((mouse-move (obj data) (flet ((mouse-move (obj data)
(declare (ignore obj)) (set-geometry control
(set-geometry placer :top (+ (position-top placer)
:top (+ (position-top control)
(- (getf data :screen-y) touch-y)) (- (getf data :screen-y) touch-y))
:left (+ (position-left control) :left (+ (position-left placer)
(- (getf data :screen-x) touch-x))))) (- (getf data :screen-x) touch-x)))
(set-properties-after-geomentry-change obj)))
(set-on-touch-move placer (lambda (obj data)
(when (eq mv-state :point)
(setf mv-state :touch))
(mouse-move obj data))
:cancel-event t)
(set-on-pointer-move placer (lambda (obj data)
(when (eq mv-state :point)
(mouse-move obj data)))
:cancel-event t)
(set-on-pointer-up placer (lambda (obj data) (set-on-pointer-up placer (lambda (obj data)
(declare (ignore obj data)) (declare (ignore obj data))
(set-on-pointer-move content nil) (setf mv-state :off)
(setf (background-color placer) "") (setf (background-color placer) "")
(set-geometry control :units ""
:top (top placer)
:left (left placer))
(set-geometry placer :units "" (set-geometry placer :units ""
:top (top control) :top (top control)
:left (left control)) :left (left control))
(set-geometry control :units ""
:top (top placer)
:left (left placer))
(select-control control) (select-control control)
(jquery-execute placer "trigger('clog-builder-snap-shot')") (jquery-execute placer "trigger('clog-builder-snap-shot')")
(set-properties-after-geomentry-change control)) (set-properties-after-geomentry-change control))
@ -369,7 +361,7 @@ return t on success"
(on-populate-control-properties-win content :win win) (on-populate-control-properties-win content :win win)
(on-populate-control-list-win content :win win)) (on-populate-control-list-win content :win win))
(last (last
(set-on-pointer-move content #'mouse-move) (setf mv-state :point)
(setf (background-color placer) (rgba 0 0 255 0.10)) (setf (background-color placer) (rgba 0 0 255 0.10))
(setf touch-x (getf data :screen-x)) (setf touch-x (getf data :screen-x))
(setf touch-y (getf data :screen-y))) (setf touch-y (getf data :screen-y)))
@ -377,7 +369,7 @@ return t on success"
(select-control control))) (select-control control)))
(when win (when win
(window-focus win)))) (window-focus win))))
:capture-pointer t)) :capture-pointer t))
(set-on-mouse-double-click placer (set-on-mouse-double-click placer
(lambda (obj data) (lambda (obj data)
(declare (ignore obj data)) (declare (ignore obj data))
@ -386,7 +378,7 @@ return t on success"
(set-on-event placer "resize" (set-on-event placer "resize"
(lambda (obj) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(set-on-pointer-move content nil) (setf mv-state :off)
(setf (background-color placer) ""))) (setf (background-color placer) "")))
(set-on-event placer "resizestop" (set-on-event placer "resizestop"
(lambda (obj) (lambda (obj)