From e32bcd9d8bfc9b49d21e49ca8e181f2ab6952f3c Mon Sep 17 00:00:00 2001 From: David Botton Date: Wed, 22 Jun 2022 00:21:02 -0400 Subject: [PATCH] directly set geometry changes to speed things considerably --- source/clog-gui.lisp | 37 ++++++++++++++------------- tools/clog-builder-settings.lisp | 30 +++++++++++++++++++--- tools/clog-builder.lisp | 43 ++++++++++++++++++++++---------- 3 files changed, 76 insertions(+), 34 deletions(-) diff --git a/source/clog-gui.lisp b/source/clog-gui.lisp index 6329a9b..1c7145e 100644 --- a/source/clog-gui.lisp +++ b/source/clog-gui.lisp @@ -456,24 +456,25 @@ The on-window-change clog-obj received is the new window")) (setf (on-window-change app) handler))) (defmethod fire-on-window-change (obj app) - "Fire handler if set. Change the value of current-win to clog-obj (Private)" - (when (current-win app) - (fire-on-window-blur (current-win app))) - (unless obj - (let (new-order - (order -9999)) - (maphash (lambda (key value) - (declare (ignore key)) - (setf new-order (z-index value)) - (when (>= new-order order) - (setf order new-order) - (setf obj value))) - (windows app)))) - (setf (current-win app) obj) - (when (on-window-change app) - (funcall (on-window-change app) obj)) - (when obj - (fire-on-window-focus obj))) + "Fire handler if set. Change the value of current-win to obj (Private)" + (unless (eq obj (current-win app)) + (when (current-win app) + (fire-on-window-blur (current-win app))) + (unless obj + (let (new-order + (order -9999)) + (maphash (lambda (key value) + (declare (ignore key)) + (setf new-order (z-index value)) + (when (>= new-order order) + (setf order new-order) + (setf obj value))) + (windows app)))) + (setf (current-win app) obj) + (when (on-window-change app) + (funcall (on-window-change app) obj)) + (when obj + (fire-on-window-focus obj)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implementation - Individual Windows diff --git a/tools/clog-builder-settings.lisp b/tools/clog-builder-settings.lisp index 88090e5..2df2f9d 100644 --- a/tools/clog-builder-settings.lisp +++ b/tools/clog-builder-settings.lisp @@ -93,6 +93,9 @@ (defparameter *props-location* `((:name "top" + :setup ,(lambda (control td1 td2) + (declare (ignore control td1)) + (add-class td2 "clog-prop-top")) :get ,(lambda (control) (if (equal (positioning control) "static") "n/a" @@ -100,6 +103,9 @@ :set ,(lambda (control obj) (setf (top control) (text obj)))) (:name "left" + :setup ,(lambda (control td1 td2) + (declare (ignore control td1)) + (add-class td2 "clog-prop-left")) :get ,(lambda (control) (if (equal (positioning control) "static") "n/a" @@ -107,6 +113,9 @@ :set ,(lambda (control obj) (setf (left control) (text obj)))) (:name "bottom" + :setup ,(lambda (control td1 td2) + (declare (ignore control td1)) + (add-class td2 "clog-prop-bottom")) :get ,(lambda (control) (if (equal (positioning control) "static") "n/a" @@ -114,6 +123,9 @@ :set ,(lambda (control obj) (setf (bottom control) (text obj)))) (:name "right" + :setup ,(lambda (control td1 td2) + (declare (ignore control td1)) + (add-class td2 "clog-prop-right")) :get ,(lambda (control) (if (equal (positioning control) "static") "n/a" @@ -146,10 +158,22 @@ nil))))) (defparameter *props-with-height* - '((:name "width" - :setf clog:width) + `((:name "width" + :setup ,(lambda (control td1 td2) + (declare (ignore control td1)) + (add-class td2 "clog-prop-width")) + :set ,(lambda (control obj) + (setf (width control) (text obj))) + :get ,(lambda (control) + (width control))) (:name "height" - :setf clog:height))) + :setup ,(lambda (control td1 td2) + (declare (ignore control td1)) + (add-class td2 "clog-prop-height")) + :set ,(lambda (control obj) + (setf (height control) (text obj))) + :get ,(lambda (control) + (height control))))) (defparameter *props-form-values* `((:name "value" diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index a823e62..08b9164 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -37,7 +37,7 @@ (properties-lock :accessor properties-lock :initform (bordeaux-threads:make-lock) - :documentation "Sync refres properties and event window") + :documentation "Sync refresh properties and event window") (control-properties-win :accessor control-properties-win :initform nil @@ -422,20 +422,36 @@ replaced." :cancel-event t) (set-on-event placer "resizestop" (lambda (obj) - (on-populate-control-properties-win content :win win))) + (declare (ignore obj)) + (set-properties-after-geomentry-change obj)) + :cancel-event t) (set-on-event placer "drag" (lambda (obj) + (declare (ignore obj)) (set-geometry control :units "" :top (top placer) :left (left placer)))) (set-on-event placer "dragstop" (lambda (obj) + (declare (ignore obj)) (set-geometry control :units "" :top (top placer) :left (left placer)) (set-geometry placer :top (top control) :left (left control)) - (on-populate-control-properties-win content :win win))))) + (set-properties-after-geomentry-change control))))) + +(defun set-properties-after-geomentry-change (control) + "Set properties window geometry setting" + (flet ((set-prop (n val) + (js-execute control (format nil "$('.clog-prop-~A').text('~A')" + n val)))) + (set-prop "top" (top control)) + (set-prop "left" (left control)) + (set-prop "right" (right control)) + (set-prop "bottom" (bottom control)) + (set-prop "width" (client-width control)) + (set-prop "height" (client-height control)))) ;; Control selection utilities @@ -465,16 +481,17 @@ manipulation of the control's location and size." "Select CONTROL as the current control and highlight its placer. The actual original clog object used for creation must be used and not a temporary attached one when using select-control." - (let ((app (connection-data-item control "builder-app-data")) - (placer (get-placer control))) - (deselect-current-control app) - (set-geometry placer :top (position-top control) - :left (position-left control) - :width (client-width control) - :height (client-height control)) - (setf (current-control app) control) - (set-border placer (unit "px" 2) :solid :blue) - (on-populate-control-properties-win control))) + (let ((app (connection-data-item control "builder-app-data")) + (placer (get-placer control))) + (unless (eq control (current-control app)) + (deselect-current-control app) + (set-geometry placer :top (position-top control) + :left (position-left control) + :width (client-width control) + :height (client-height control)) + (setf (current-control app) control) + (set-border placer (unit "px" 2) :solid :blue) + (on-populate-control-properties-win control)))) (defun add-sub-controls (parent content &key win paste) "Setup html imported in to CONTENT starting with PARENT for use with Builder"