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

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)))
(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

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

@ -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"

43
tools/clog-builder.lisp
View file

@ -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"