From 5281c593ef0628c19c4c2f0e5990f5b433c92ca3 Mon Sep 17 00:00:00 2001 From: David Botton Date: Mon, 22 Jul 2024 21:44:09 -0400 Subject: [PATCH] rewrite size and move code --- tools/clog-builder-panels.lisp | 144 +++++++++++++++++---------------- 1 file changed, 73 insertions(+), 71 deletions(-) diff --git a/tools/clog-builder-panels.lisp b/tools/clog-builder-panels.lisp index dd3d90d..261ff0e 100644 --- a/tools/clog-builder-panels.lisp +++ b/tools/clog-builder-panels.lisp @@ -257,8 +257,7 @@ return t on success" :left (position-left control) :width (client-width control) :height (client-height control)) - (jquery-execute placer (format nil "draggable({snap:'.placer',snapMode:'inner',cursor:'crosshair'})~ - .resizable({alsoResize:'#~A',autoHide:true})" + (jquery-execute placer (format nil "resizable({alsoResize:'#~A',autoHide:true})" (html-id control))) ;; setup placer events (setf (tab-index placer) "-1") ; must have a tab-index to accept keyboard input @@ -301,96 +300,99 @@ 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-start placer (lambda (obj data) - (declare (ignore obj)) - (setf touch-x (getf data :X)) - (setf touch-y (getf data :Y))) - :cancel-event t) (set-on-touch-move placer (lambda (obj data) (declare (ignore obj)) - (set-geometry control :top (+ (position-top control) - (- (getf data :y) touch-y)) + (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 :x) touch-x))) - (setf touch-x (getf data :X)) - (setf touch-y (getf data :Y))) - :cancel-event t) - (set-on-touch-end placer (lambda (obj data) - (declare (ignore obj data)) - (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)) + (- (getf data :screen-x) touch-x)))) :cancel-event t) - (set-on-mouse-up placer (lambda (obj data) + (set-on-touch-end placer (lambda (obj data) (declare (ignore obj data)) - (set-geometry control :units "" - :top (top placer) - :left (left placer)) + (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) - (set-on-mouse-down placer - (lambda (obj data) - (declare (ignore obj)) - (let ((last (current-control app)) - (shift (getf data :shift-key))) - (if (and (select-tool app) - (not (equal (value (select-tool app)) ""))) - (when (do-drop-new-control app content data :win win) - (incf-next-id content))) - (cond ((and last - shift) - (let* ((control1 last) - (control2 control) - (placer1 (get-placer control1)) - (placer2 (get-placer control2))) - (place-inside-bottom-of control1 control2) - (place-after control2 placer2) - (place-after control2 placer2) - (set-geometry placer1 :top (position-top control1) - :left (position-left control1) - :width (client-width control1) - :height (client-height control1)) - (set-geometry placer2 :top (position-top control2) - :left (position-left control2) - :width (client-width control2) - :height (client-height control2))) - (select-control control) - (on-populate-control-properties-win content :win win) - (on-populate-control-list-win content :win win)) - (t - (select-control control))) - (when win - (window-focus win)))) - :cancel-event t) + :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)) + :cancel-event t) + (set-on-pointer-down placer + (lambda (obj data) + (declare (ignore obj)) + (let ((last (current-control app)) + (shift (getf data :shift-key))) + (if (and (select-tool app) + (not (equal (value (select-tool app)) ""))) + (when (do-drop-new-control app content data :win win) + (incf-next-id content))) + (cond ((and last + shift) + (let* ((control1 last) + (control2 control) + (placer1 (get-placer control1)) + (placer2 (get-placer control2))) + (place-inside-bottom-of control1 control2) + (place-after control2 placer2) + (place-after control2 placer2) + (set-geometry placer1 :top (position-top control1) + :left (position-left control1) + :width (client-width control1) + :height (client-height control1)) + (set-geometry placer2 :top (position-top control2) + :left (position-left control2) + :width (client-width control2) + :height (client-height control2))) + (select-control control) + (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 (background-color placer) (rgba 0 0 255 0.10)) + (setf touch-x (getf data :screen-x)) + (setf touch-y (getf data :screen-y))) + (t + (select-control control))) + (when win + (window-focus win)))) + :capture-pointer t)) (set-on-mouse-double-click placer (lambda (obj data) (declare (ignore obj data)) (setf (hiddenp placer) t) - (on-populate-control-list-win content :win win)) - :cancel-event t) + (on-populate-control-list-win content :win win))) (set-on-event placer "resize" (lambda (obj) - (set-properties-after-geomentry-change obj))) + (declare (ignore obj)) + (set-on-pointer-move content nil) + (setf (background-color placer) ""))) (set-on-event placer "resizestop" (lambda (obj) (set-properties-after-geomentry-change obj) (jquery-execute placer "trigger('clog-builder-snap-shot')")) - :cancel-event t) - (set-on-event placer "drag" - (lambda (obj) - (declare (ignore obj)) - (set-geometry control :units "" - :top (top placer) - :left (left placer)) - (set-properties-after-geomentry-change control))))) + :cancel-event t))) (defun on-populate-loaded-window (content &key win) "Setup html imported in to CONTENT for use with Builder"