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

directly set geometry changes to speed things considerably

Browse source
This commit is contained in:
David Botton 2022-06-22 00:21:02 -04:00
parent ffa815ff2e
commit e32bcd9d8b
3 changed files with 76 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

37
source/clog-gui.lisp
View file

@ -456,24 +456,25 @@ The on-window-change clog-obj received is the new window"))
(setf (on-window-change app) handler))) (setf (on-window-change app) handler)))
(defmethod fire-on-window-change (obj app) (defmethod fire-on-window-change (obj app)
"Fire handler if set. Change the value of current-win to clog-obj (Private)" "Fire handler if set. Change the value of current-win to obj (Private)"
(when (current-win app) (unless (eq obj (current-win app))
(fire-on-window-blur (current-win app))) (when (current-win app)
(unless obj (fire-on-window-blur (current-win app)))
(let (new-order (unless obj
(order -9999)) (let (new-order
(maphash (lambda (key value) (order -9999))
(declare (ignore key)) (maphash (lambda (key value)
(setf new-order (z-index value)) (declare (ignore key))
(when (>= new-order order) (setf new-order (z-index value))
(setf order new-order) (when (>= new-order order)
(setf obj value))) (setf order new-order)
(windows app)))) (setf obj value)))
(setf (current-win app) obj) (windows app))))
(when (on-window-change app) (setf (current-win app) obj)
(funcall (on-window-change app) obj)) (when (on-window-change app)
(when obj (funcall (on-window-change app) obj))
(fire-on-window-focus obj))) (when obj
(fire-on-window-focus obj))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - Individual Windows ;; Implementation - Individual Windows

30
tools/clog-builder-settings.lisp
View file

@ -93,6 +93,9 @@
(defparameter *props-location* (defparameter *props-location*
`((:name "top" `((:name "top"
:setup ,(lambda (control td1 td2)
(declare (ignore control td1))
(add-class td2 "clog-prop-top"))
:get ,(lambda (control) :get ,(lambda (control)
(if (equal (positioning control) "static") (if (equal (positioning control) "static")
"n/a" "n/a"
@ -100,6 +103,9 @@
:set ,(lambda (control obj) :set ,(lambda (control obj)
(setf (top control) (text obj)))) (setf (top control) (text obj))))
(:name "left" (:name "left"
:setup ,(lambda (control td1 td2)
(declare (ignore control td1))
(add-class td2 "clog-prop-left"))
:get ,(lambda (control) :get ,(lambda (control)
(if (equal (positioning control) "static") (if (equal (positioning control) "static")
"n/a" "n/a"
@ -107,6 +113,9 @@
:set ,(lambda (control obj) :set ,(lambda (control obj)
(setf (left control) (text obj)))) (setf (left control) (text obj))))
(:name "bottom" (:name "bottom"
:setup ,(lambda (control td1 td2)
(declare (ignore control td1))
(add-class td2 "clog-prop-bottom"))
:get ,(lambda (control) :get ,(lambda (control)
(if (equal (positioning control) "static") (if (equal (positioning control) "static")
"n/a" "n/a"
@ -114,6 +123,9 @@
:set ,(lambda (control obj) :set ,(lambda (control obj)
(setf (bottom control) (text obj)))) (setf (bottom control) (text obj))))
(:name "right" (:name "right"
:setup ,(lambda (control td1 td2)
(declare (ignore control td1))
(add-class td2 "clog-prop-right"))
:get ,(lambda (control) :get ,(lambda (control)
(if (equal (positioning control) "static") (if (equal (positioning control) "static")
"n/a" "n/a"
@ -146,10 +158,22 @@
nil))))) nil)))))
(defparameter *props-with-height* (defparameter *props-with-height*
'((:name "width" `((:name "width"
:setf clog: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" (: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* (defparameter *props-form-values*
`((:name "value" `((:name "value"

43
tools/clog-builder.lisp
View file

@ -37,7 +37,7 @@
(properties-lock (properties-lock
:accessor properties-lock :accessor properties-lock
:initform (bordeaux-threads:make-lock) :initform (bordeaux-threads:make-lock)
:documentation "Sync refres properties and event window") :documentation "Sync refresh properties and event window")
(control-properties-win (control-properties-win
:accessor control-properties-win :accessor control-properties-win
:initform nil :initform nil
@ -422,20 +422,36 @@ replaced."
:cancel-event t) :cancel-event t)
(set-on-event placer "resizestop" (set-on-event placer "resizestop"
(lambda (obj) (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" (set-on-event placer "drag"
(lambda (obj) (lambda (obj)
(declare (ignore obj))
(set-geometry control :units "" (set-geometry control :units ""
:top (top placer) :top (top placer)
:left (left placer)))) :left (left placer))))
(set-on-event placer "dragstop" (set-on-event placer "dragstop"
(lambda (obj) (lambda (obj)
(declare (ignore obj))
(set-geometry control :units "" (set-geometry control :units ""
:top (top placer) :top (top placer)
:left (left placer)) :left (left placer))
(set-geometry placer :top (top control) (set-geometry placer :top (top control)
:left (left 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 ;; 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. "Select CONTROL as the current control and highlight its placer.
The actual original clog object used for creation must be used and The actual original clog object used for creation must be used and
not a temporary attached one when using select-control." not a temporary attached one when using select-control."
(let ((app (connection-data-item control "builder-app-data")) (let ((app (connection-data-item control "builder-app-data"))
(placer (get-placer control))) (placer (get-placer control)))
(deselect-current-control app) (unless (eq control (current-control app))
(set-geometry placer :top (position-top control) (deselect-current-control app)
:left (position-left control) (set-geometry placer :top (position-top control)
:width (client-width control) :left (position-left control)
:height (client-height control)) :width (client-width control)
(setf (current-control app) control) :height (client-height control))
(set-border placer (unit "px" 2) :solid :blue) (setf (current-control app) control)
(on-populate-control-properties-win control))) (set-border placer (unit "px" 2) :solid :blue)
(on-populate-control-properties-win control))))
(defun add-sub-controls (parent content &key win paste) (defun add-sub-controls (parent content &key win paste)
"Setup html imported in to CONTENT starting with PARENT for use with Builder" "Setup html imported in to CONTENT starting with PARENT for use with Builder"