resize on side panel

This commit is contained in:
David Botton 2022-07-03 16:44:33 -04:00
parent 68e9dc0d97
commit e7497fb49b

View file

@ -1071,11 +1071,13 @@ of controls and double click to select control."
:class "w3-border"))
(side-panel (create-panel content :top 0 :right 0 :bottom 0 :width 10))
(sheight (height content))
(divider (create-panel content :top (/ sheight 2) :height 5 :left 0 :right 10))
(control-list (create-panel content :height (- (/ sheight 2) 5) :left 0 :bottom 0 :right 10))
(divider (create-panel content :top (/ sheight 2) :height 10 :left 0 :right 10))
(control-list (create-panel content :height (- (/ sheight 2) 10) :left 0 :bottom 0 :right 10))
(pallete (create-select content))
(adj-size 0))
(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)
@ -1094,13 +1096,28 @@ of controls and double click to select control."
(format nil "Drag and drop order~%Double click non-focusable~%~
<ctrl> place as static~%<shift> child to selected"))
(setf (background-color side-panel) :black)
(set-on-resize (window (connection-body obj))
(lambda (obj)
(declare (ignore obj))
(setf sheight (height content))
(set-geometry pallete :left 0 :top 0 :height (/ sheight 2) :right 10)
(set-geometry divider :top (/ sheight 2) :height 5 :left 0 :right 10)
(set-geometry control-list :height (- (/ sheight 2) 5) :left 0 :bottom 0 :right 10)))
(flet ((on-size (obj)
(declare (ignore obj))
(setf sheight (height content))
(when (and (> (- (/ sheight 2) adj-size) 5)
(> (+ (- (/ sheight 2) 10) adj-size) 5))
(set-geometry pallete :height (- (/ sheight 2) adj-size))
(set-geometry divider :top (- (/ sheight 2) adj-size))
(set-geometry control-list :height (+ (- (/ sheight 2) 10) adj-size)))))
(set-on-resize (window (connection-body obj)) #'on-size)
(set-on-pointer-down divider (lambda (obj data)
(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 :screen-y)
(getf new-data :screen-y)))
(print adj-size)
(on-size obj))))
:capture-pointer t))
(set-on-click side-panel (lambda (obj)
(declare (ignore obj))
(cond (is-hidden