mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2026-03-01 11:30:29 -08:00
Code Issues Projects Releases Wiki Activity

Revamped palletes

Browse source
This commit is contained in:
David Botton 2024-03-22 16:59:55 -04:00
parent d44dfc9f6e
commit 45ad536b7f
4 changed files with 136 additions and 171 deletions
Download patch file Download diff file Expand all files Collapse all files

148
tools/clog-builder-control-list.lisp
View file

@ -42,92 +42,70 @@
(defun on-show-control-list-win (obj)
"Show control list for selecting and manipulating controls by name"
(let* ((app (connection-data-item obj "builder-app-data"))
(is-hidden nil)
(auto-mode nil)
(content (create-panel (connection-body obj) :positioning :fixed
:width 220
:top 40
:left 0 :bottom 0
:class "w3-border-right"))
(side-panel (create-panel content :top 0 :right 0 :bottom 0 :width 10))
(pin (create-div side-panel :content "☑" :class "w3-small"))
(sheight (floor (/ (height content) 2)))
(swidth (floor (width content)))
(divider (create-panel content :top sheight :height 10 :left 0 :right 10))
(control-list (create-panel content :height (- sheight 10) :left 0 :bottom 0 :right 10))
(pallete (create-select content))
(adj-size 0))
(set-geometry pallete :left 0 :top 0 :height sheight :width (- swidth 10))
(setf (left-panel app) content)
(setf (hiddenp (left-panel app)) t)
(setf (background-color divider) :black)
(setf (tab-index divider) "-1")
(setf (cursor divider) :ns-resize)
(setf (background-color content) :gray)
(setf (background-color pallete) :gray)
(setf (color pallete) :white)
(setf (positioning pallete) :absolute)
(setf (size pallete) 2)
(setf (advisory-title pallete) (format nil "<ctrl/cmd> place static~%<shift> child to current selection"))
(setf (select-tool app) pallete)
(setf (overflow control-list) :auto)
(reset-control-pallete obj)
(setf (control-list-win app) control-list)
(setf (advisory-title content)
(format nil "Drag and drop order~%Double click non-focusable~%~
(let* ((app (connection-data-item obj "builder-app-data")))
(unless (controls-win app)
(let* ((win (create-gui-window obj :title "Controls" :has-pinner t :width 220))
(content (window-content win))
(sheight (floor (/ (height content) 2)))
(swidth (floor (width content)))
(divider (create-panel content :top sheight :height 10 :left 0 :right 10))
(control-list (create-panel content :height (- sheight 10) :left 0 :bottom 0 :right 10))
(pallete (create-select content))
(adj-size 0))
(add-class content "w3-small")
(setf (controls-win app) win)
(setf (control-list-win app) control-list)
(setf (select-tool app) pallete)
(set-on-window-close win (lambda (obj)
(setf (controls-win app) nil)
(setf (select-tool app) nil)
(setf (control-list-win app) nil)))
(reset-control-pallete pallete)
(window-toggle-pinned win :state t)
(set-geometry win :units "" :top "33px" :left 0 :height "" :bottom "5px" :right "")
(set-geometry pallete :left 0 :top 0 :height sheight :right 0);:width (- swidth 10))
(setf (background-color divider) :black)
(setf (tab-index divider) "-1")
(setf (cursor divider) :ns-resize)
(setf (background-color pallete) :silver)
(setf (background-color content) :silver)
(setf (positioning pallete) :absolute)
(setf (size pallete) 2)
(setf (advisory-title pallete) (format nil "<ctrl/cmd> place static~%<shift> child to current selection"))
(setf (overflow control-list) :auto)
(reset-control-pallete obj)
(setf (advisory-title content)
(format nil "Drag and drop order~%Double click non-focusable~%~
<ctrl/cmd> place as static~%<shift> child to current selection"))
(setf (background-color side-panel) :black)
(flet ((on-size (obj)
(declare (ignore obj))
(setf sheight (floor (/ (height content) 2)))
(when (and (> (- sheight adj-size) 5)
(> (+ (- sheight 10) adj-size) 5))
(set-geometry pallete :height (- sheight adj-size))
(set-geometry divider :top (- sheight adj-size))
(set-geometry control-list :height (+ (- sheight 10) adj-size)))))
(set-on-resize (window (connection-body obj)) #'on-size)
(set-on-full-screen-change (html-document (connection-body obj)) #'on-size)
(set-on-orientation-change (window (connection-body obj)) #'on-size)
(set-on-pointer-down divider (lambda (obj data)
(setf (getf data :client-y) (+ adj-size
(getf data :client-y)))
(set-on-pointer-up (connection-body obj)
(lambda (obj data)
(declare (ignore data))
(set-on-pointer-up (connection-body obj) nil)
(set-on-pointer-move (connection-body obj) nil)))
(set-on-pointer-move (connection-body obj)
(lambda (obj new-data)
(setf adj-size (- (getf data :client-y)
(getf new-data :client-y)))
(on-size obj))))
:capture-pointer t))
(set-on-click side-panel (lambda (obj)
(declare (ignore obj))
(cond (auto-mode
(setf auto-mode nil)
(setf (text-value pin) "☑")
(setf (width content) "220px")
(setf (hiddenp pallete) nil)
(setf is-hidden nil))
(t
(setf auto-mode t)
(setf (text-value pin) "☐")
(setf (width content) "10px")
(setf (hiddenp pallete) t)
(setf is-hidden t)))))
(set-on-mouse-leave side-panel (lambda (obj)
(declare (ignore obj))
(when auto-mode
(cond (is-hidden
(setf (width content) "220px")
(setf (hiddenp pallete) nil)
(setf is-hidden nil))
(t
(setf (width content) "10px")
(setf (hiddenp pallete) t)
(setf is-hidden t))))))))
(flet ((on-size (obj)
(declare (ignore obj))
(setf sheight (floor (/ (height content) 2)))
(when (and (> (- sheight adj-size) 5)
(> (+ (- sheight 10) adj-size) 5))
(set-geometry pallete :height (- sheight adj-size))
(set-geometry divider :top (- sheight adj-size))
(set-geometry control-list :height (+ (- sheight 10) adj-size)))))
(set-on-resize (window (connection-body obj)) #'on-size)
(set-on-window-size win #'on-size)
(set-on-window-move win #'on-size)
(set-on-full-screen-change (html-document (connection-body obj)) #'on-size)
(set-on-orientation-change (window (connection-body obj)) #'on-size)
(set-on-pointer-down divider (lambda (obj data)
(setf (getf data :client-y) (+ adj-size
(getf data :client-y)))
(set-on-pointer-up (connection-body obj)
(lambda (obj data)
(declare (ignore data))
(set-on-pointer-up (connection-body obj) nil)
(set-on-pointer-move (connection-body obj) nil)))
(set-on-pointer-move (connection-body obj)
(lambda (obj new-data)
(setf adj-size (- (getf data :client-y)
(getf new-data :client-y)))
(on-size obj))))
:capture-pointer t)
(on-size win))))
(window-focus (controls-win app))))
(defun on-populate-control-list-win (content &key win)
"Populate the control-list-window to allow drag and drop adjust of order

59
tools/clog-builder-control-properties.lisp
View file

@ -2,48 +2,23 @@
(defun on-show-control-properties-win (obj)
"Show control properties window"
(let* ((app (connection-data-item obj "builder-app-data"))
(is-hidden nil)
(auto-mode nil)
(panel (create-panel (connection-body obj) :positioning :fixed
:width 400
:top 40
:right 0 :bottom 0
:class "w3-border-left"))
(content (create-panel panel :width 390 :top 0 :right 0 :bottom 0))
(side-panel (create-panel panel :top 0 :left 0 :bottom 0 :width 10))
(pin (create-div side-panel :content "☑" :class "w3-small"))
(control-list (create-table content)))
(setf (background-color side-panel) :black)
(setf (background-color content) :gray)
(setf (right-panel app) panel)
(setf (hiddenp (right-panel app)) t)
(setf (control-properties-win app) content)
(setf (properties-list app) control-list)
(set-on-click side-panel (lambda (obj)
(declare (ignore obj))
(cond (auto-mode
(setf auto-mode nil)
(setf (text-value pin) "☑")
(setf (width panel) "400px")
(setf is-hidden nil))
(t
(setf auto-mode t)
(setf (text-value pin) "☐")
(setf (width panel) "400px")
(setf is-hidden nil)))))
(set-on-mouse-leave side-panel (lambda (obj)
(declare (ignore obj))
(when auto-mode
(cond (is-hidden
(setf (width panel) "400px")
(setf is-hidden nil))
(t
(setf (width panel) "10px")
(setf is-hidden t))))))
(setf (overflow content) :auto)
(setf (positioning control-list) :absolute)
(set-geometry control-list :left 0 :top 0 :right 0)))
(let ((app (connection-data-item obj "builder-app-data")))
(unless (control-properties-win app)
(let* ((win (create-gui-window obj :title "Properties" :has-pinner t :width 400))
(content (window-content win))
(control-list (create-table content)))
(add-class content "w3-small")
(set-on-window-close win (lambda (obj)
(setf (control-properties-win app) nil)))
(window-toggle-pinned win :state t)
(setf (control-properties-win app) win)
(setf (properties-list app) control-list)
(setf (background-color content) :silver)
(setf (overflow content) :auto)
(setf (positioning control-list) :absolute)
(set-geometry win :units "" :top "33px" :left "" :height "" :bottom "5px" :right "0px")
(set-geometry control-list :left 0 :top 0 :right 0)))
(window-focus (control-properties-win app))))
(defun on-populate-control-properties-win (obj &key win)
"Populate the control properties for the current control"

74
tools/clog-builder-panels.lisp
View file

@ -131,38 +131,39 @@
;; any click on panel directly will focus window
(when win
(window-focus win))
(let* ((control-record (control-info (value (select-tool app))))
(control-type-name (getf control-record :create-type)))
(cond ((eq control-type-name :custom-query)
(input-dialog win "Enter html (must have an outer element):"
(lambda (custom-query)
(when custom-query
(do-drop-new-control
app content data
:win win
:custom-query custom-query)))
:width 500
:height 300
:rows 5
:size 40
:title "Custom HTML Control"
:default-value (getf control-record :create-content)))
((eq control-type-name :custom-block)
(input-dialog win "Enter html to create control:"
(lambda (custom-query)
(when custom-query
(do-drop-new-control
app content data
:win win
:custom-query custom-query)))
:width 500
:height 300
:rows 5
:size 40
:title "Custom HTML Block"
:default-value (getf control-record :create-content)))
(t
(do-drop-new-control app content data :win win)))))
(when (select-tool app)
(let* ((control-record (control-info (value (select-tool app))))
(control-type-name (getf control-record :create-type)))
(cond ((eq control-type-name :custom-query)
(input-dialog win "Enter html (must have an outer element):"
(lambda (custom-query)
(when custom-query
(do-drop-new-control
app content data
:win win
:custom-query custom-query)))
:width 500
:height 300
:rows 5
:size 40
:title "Custom HTML Control"
:default-value (getf control-record :create-content)))
((eq control-type-name :custom-block)
(input-dialog win "Enter html to create control:"
(lambda (custom-query)
(when custom-query
(do-drop-new-control
app content data
:win win
:custom-query custom-query)))
:width 500
:height 300
:rows 5
:size 40
:title "Custom HTML Block"
:default-value (getf control-record :create-content)))
(t
(do-drop-new-control app content data :win win))))))
(defun do-drop-new-control (app content data &key win custom-query)
"Create new control dropped at event DATA on CONTENT of WIN)"
@ -311,7 +312,8 @@
(declare (ignore obj))
(let ((last (current-control app))
(shift (getf data :shift-key)))
(if (not (equal (value (select-tool app)) ""))
(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
@ -521,7 +523,9 @@ not a temporarily attached one when using select-control."
(m-rndr (create-gui-menu-item m-lisp :content "render form to lisp"))
(m-rndras (create-gui-menu-item m-lisp :content "render form to lisp as..."))
(m-test (create-gui-menu-item m-lisp :content "evaluate and test"))
(m-events (create-gui-menu-drop-down menu :content "Events"))
(m-events (create-gui-menu-drop-down menu :content "controls"))
(tmp (create-gui-menu-item m-events :content "show control properties" :on-click 'on-show-control-properties-win))
(tmp (create-gui-menu-item m-events :content "show controls window" :on-click 'on-show-control-list-win))
(tmp (create-gui-menu-item m-events :content "show CLOG events" :on-click 'on-show-control-events-win))
(tmp (create-gui-menu-item m-events :content "show JavaScript events" :on-click 'on-show-control-js-events-win))
(tmp (create-gui-menu-item m-events :content "show ParenScript events" :on-click 'on-show-control-ps-events-win))
@ -643,6 +647,8 @@ not a temporarily attached one when using select-control."
(setf (attribute content "data-custom-slots") "")
;; activate associated windows on open
(on-show-control-events-win win)
(on-show-control-properties-win win)
(on-show-control-list-win win)
(panel-mode win t)
(on-populate-control-properties-win content :win win)
(on-populate-control-list-win content :win win)

26
tools/clog-builder.lisp
View file

@ -44,11 +44,12 @@ replaced. (Exported)"
(defun reset-control-pallete (panel)
(let* ((app (connection-data-item panel "builder-app-data"))
(pallete (select-tool app)))
(setf (inner-html pallete) "")
(dolist (control *supported-controls*)
(if (equal (getf control :name) "group")
(add-select-optgroup pallete (getf control :description))
(add-select-option pallete (getf control :name) (getf control :description))))))
(when pallete
(setf (inner-html pallete) "")
(dolist (control *supported-controls*)
(if (equal (getf control :name) "group")
(add-select-optgroup pallete (getf control :description))
(add-select-option pallete (getf control :name) (getf control :description)))))))
;; Global Internal Config
@ -155,6 +156,10 @@ clog-builder window.")
:accessor control-ps-events-win
:initform nil
:documentation "Current control events window")
(controls-win
:accessor controls-win
:initform nil
:documentation "Current controls window")
(control-list-win
:accessor control-list-win
:initform nil
@ -193,9 +198,12 @@ clog-builder window.")
(defun panel-mode (obj bool)
"Set the status for display or hiding the side panels."
(let ((app (connection-data-item obj "builder-app-data")))
(setf (hiddenp (right-panel app)) (not bool))
(setf (hiddenp (left-panel app)) (not bool))))
(when obj
(let ((app (connection-data-item obj "builder-app-data")))
(when (right-panel app)
(setf (hiddenp (right-panel app)) (not bool)))
(when (left-panel app)
(setf (hiddenp (left-panel app)) (not bool))))))
(defun on-help-about-builder (obj)
"Open about box"
@ -423,8 +431,6 @@ clog-builder window.")
(open-window (window body) "https://www.w3schools.com/w3css/")))
(create-gui-menu-item help :content "About CLOG Builder" :on-click #'on-help-about-builder)
(create-gui-menu-full-screen menu))
(on-show-control-properties-win body)
(on-show-control-list-win body)
(on-show-copy-history-win body)
(cond
(open-panel