mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-15 06:50:20 -08:00
Revamped palletes
This commit is contained in:
David Botton
parent
d44dfc9f6e
commit
45ad536b7f
4 changed files with 136 additions and 171 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue