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

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

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