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

Control list open on start and better updating

Browse source
This commit is contained in:
David Botton 2022-01-12 12:07:30 -05:00
parent 820949e28c
commit 32a5798566
1 changed files with 202 additions and 191 deletions
Download patch file Download diff file Expand all files Collapse all files

71
tools/clog-builder.lisp
View file

@ -291,7 +291,10 @@
(let ((app (connection-data-item obj "builder-app-data"))) (let ((app (connection-data-item obj "builder-app-data")))
(if (control-list-win app) (if (control-list-win app)
(window-focus (control-list-win app)) (window-focus (control-list-win app))
(let* ((win (create-gui-window obj :title "Control List"))) (let* ((win (create-gui-window obj :title "Control List"
:top 350
:left 0
:width 200)))
(setf (control-list-win app) win) (setf (control-list-win app) win)
(set-on-window-close win (lambda (obj) (setf (control-list-win app) nil))))))) (set-on-window-close win (lambda (obj) (setf (control-list-win app) nil)))))))
@ -326,6 +329,34 @@
(file-name ".") (file-name ".")
control-list control-list
placer-list) placer-list)
(labels ((populate-control-list-win ()
(when (control-list-win app)
(let* ((c (control-list-win app))
(w (window-content c))
(p (first-child content))
dln)
(setf (inner-html w) "")
(loop
(when (equal (html-id p) "undefined") (return))
(setf dln (attribute p "data-lisp-name"))
(unless (equal dln "undefined")
(let ((n (create-div w :content dln)))
(setf (color n) :blue)
(setf (draggablep n) t)
(setf (attribute n "data-clog-control") (html-id p))
(set-on-drag-over n (lambda (obj)(declare (ignore obj))()))
(set-on-drop n (lambda (obj data)
(declare (ignore obj))
(let ((id (attribute n "data-clog-control")))
(place-before
(attach-as-child n id)
(attach-as-child n
(getf data :drag-data)))
(populate-control-list-win))))
(set-on-drag-start n (lambda (obj)
(declare (ignore obj))())
:drag-data (html-id p))))
(setf p (next-sibling p)))))))
(setf (background-color tool-bar) :silver) (setf (background-color tool-bar) :silver)
(setf (attribute content "data-lisp-name") panel-name) (setf (attribute content "data-lisp-name") panel-name)
(setf (window-title win) panel-name) (setf (window-title win) panel-name)
@ -338,7 +369,8 @@
(destroy (current-control app)) (destroy (current-control app))
(setf (current-control app) nil) (setf (current-control app) nil)
(setf (current-placer app) nil) (setf (current-placer app) nil)
(on-populate-control-properties win)))) (on-populate-control-properties win)
(populate-control-list-win))))
(set-on-click btn-sim (lambda (obj) (set-on-click btn-sim (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(cond (in-simulation (cond (in-simulation
@ -414,7 +446,8 @@
(declare (ignore obj)) (declare (ignore obj))
(setf (current-control app) nil) (setf (current-control app) nil)
(setf (current-placer app) nil) (setf (current-placer app) nil)
(on-populate-control-properties win))) (on-populate-control-properties win)
(populate-control-list-win)))
(set-on-mouse-down content (set-on-mouse-down content
(lambda (obj data) (lambda (obj data)
(unless in-simulation (unless in-simulation
@ -435,37 +468,13 @@
(set-border (current-placer app) (unit "px" 0) :none :blue)) (set-border (current-placer app) (unit "px" 0) :none :blue))
(setf (current-control app) nil) (setf (current-control app) nil)
(setf (current-placer app) nil) (setf (current-placer app) nil)
(on-populate-control-properties win) (on-populate-control-properties win))
(when (control-list-win app)
(let* ((c (control-list-win app))
(w (window-content c))
(p (first-child content))
dln)
(setf (inner-html w) "")
(loop
(when (equal (html-id p) "undefined") (return))
(setf dln (attribute p "data-lisp-name"))
(unless (equal dln "undefined")
(let ((n (create-div w :content dln)))
(setf (color n) :blue)
(setf (draggablep n) t)
(setf (attribute n "data-clog-control") (html-id p))
(set-on-drag-over n (lambda (obj)(declare (ignore obj))()))
(set-on-drop n (lambda (obj data)
(declare (ignore obj))
(let ((id (attribute n "data-clog-control")))
(place-before (attach-as-child n id)
(attach-as-child n (getf data :drag-data))))))
(set-on-drag-start n (lambda (obj)
(declare (ignore obj))())
:drag-data (html-id p))))
(setf p (next-sibling p))))))
(when element (when element
(setf (current-control app) element) (setf (current-control app) element)
(push element control-list) (push element control-list)
(push placer placer-list) (push placer placer-list)
(setf (attribute element "data-lisp-name") (setf (attribute element "data-lisp-name")
(format nil "control-~A" (html-id element))) (format nil "~A-~A" (getf control :name) (html-id element)))
(setf (attribute element "data-clog-type") (getf control :name)) (setf (attribute element "data-clog-type") (getf control :name))
(setf (box-sizing element) :content-box) (setf (box-sizing element) :content-box)
(setf (box-sizing placer) :content-box) (setf (box-sizing placer) :content-box)
@ -516,7 +525,8 @@
(set-geometry element :units "" (set-geometry element :units ""
:top (top placer) :top (top placer)
:left (left placer)) :left (left placer))
(on-populate-control-properties win)))))))))) (on-populate-control-properties win)))
(populate-control-list-win)))))))))
(defun on-help-about-builder (obj) (defun on-help-about-builder (obj)
(let ((about (create-gui-window obj (let ((about (create-gui-window obj
@ -566,6 +576,7 @@
(create-gui-menu-item help :content "About" :on-click #'on-help-about-builder) (create-gui-menu-item help :content "About" :on-click #'on-help-about-builder)
(create-gui-menu-full-screen menu)) (create-gui-menu-full-screen menu))
(on-show-control-pallete body) (on-show-control-pallete body)
(on-show-control-list body)
(on-show-control-properties body) (on-show-control-properties body)
(on-new-builder-window body) (on-new-builder-window body)
(set-on-before-unload (window body) (lambda(obj) (set-on-before-unload (window body) (lambda(obj)