From c4d21e94152e2ee7152e373d7b8eaa75352a380b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jacek=20TeMPOraL=20Z=C5=82ydach?= <temporal.pl@gmail.com> Date: Sat, 3 Jun 2017 12:28:30 +0200 Subject: [PATCH] Uncommented dynamic scrollbar update code + added background/foreground initargs. This leads to Lisp Listener demo showing a scroll pane. --- silica/gadgets.lisp | 125 ++++++++++++++++++++++---------------------- silica/medium.lisp | 4 +- 2 files changed, 65 insertions(+), 64 deletions(-) diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp index 8708c4e0..15e0a00a 100644 --- a/silica/gadgets.lisp +++ b/silica/gadgets.lisp @@ -845,7 +845,7 @@ The text-field must have the focus before you can call this function.")) ;; simplified so that it repaints the viewport over the entire region ;; taking advantage of the fact that the repainting of overlapping ;; children happens after -#+ignore +#++really-ignore (defmethod repaint-sheet ((sheet viewport) region) (let ((region (region-intersection (sheet-region sheet) region))) (dolist (child (sheet-children sheet)) @@ -864,76 +864,77 @@ The text-field must have the focus before you can call this function.")) (bounding-rectangle-width pane) (bounding-rectangle-height pane))) ;;--- Work on this -#+++ignore (defmethod note-sheet-region-changed :around ((viewport viewport) &key port-did-it) #-aclpc (declare (ignore port-did-it)) (multiple-value-bind (changedp hscroll-bar hscroll-bar-enabled-p vscroll-bar vscroll-bar-enabled-p) - (compute-dynamic-scroll-bar-values viewport) + (compute-dynamic-scroll-bar-values (viewport-scroller-pane viewport)) (if changedp - (update-dynamic-scroll-bars - viewport changedp - hscroll-bar hscroll-bar-enabled-p - vscroll-bar vscroll-bar-enabled-p) + (update-dynamic-scroll-bars (viewport-scroller-pane viewport) + changedp + hscroll-bar + hscroll-bar-enabled-p + vscroll-bar + vscroll-bar-enabled-p) (call-next-method)))) -;(defun update-dynamic-scroll-bars (scroller changedp -; hscroll-bar hscroll-bar-enabled-p -; vscroll-bar vscroll-bar-enabled-p -; &optional relayout) -; (when changedp -; (when hscroll-bar -; (setf (sheet-enabled-p hscroll-bar) hscroll-bar-enabled-p)) -; (when vscroll-bar -; (setf (sheet-enabled-p vscroll-bar) vscroll-bar-enabled-p)) -; (when (or (and hscroll-bar (not hscroll-bar-enabled-p)) -; (and vscroll-bar (not vscroll-bar-enabled-p))) -; (let* ((contents (slot-value scroller 'contents)) -; (c-extent (viewport-contents-extent -; (pane-viewport contents)))) -; (multiple-value-bind (vx vy) -; (window-viewport-position contents) -; (window-set-viewport-position -; contents -; (if (and hscroll-bar (not hscroll-bar-enabled-p)) -; (bounding-rectangle-min-x c-extent) -; vx) -; (if (and vscroll-bar (not vscroll-bar-enabled-p)) -; (bounding-rectangle-min-y c-extent) -; vy))))) -; (clear-space-requirement-caches-in-tree scroller) -; (when relayout -; ;;--- This is kinda bogus. If this was a generic scroller then -; ;;--- you want to layout the table. -; (let ((table (slot-value scroller 'viewport))) -; (multiple-value-bind (width height) -; (bounding-rectangle-size table) -; (allocate-space table width height)))))) - -;(defun compute-dynamic-scroll-bar-values (scroller) -; (let* ((hscroll-bar (scroller-pane-horizontal-scroll-bar scroller)) -; (vscroll-bar (scroller-pane-vertical-scroll-bar scroller)) -; (scroll-bar-policy (scroller-pane-scroll-bar-policy scroller))) -; (if (eq scroll-bar-policy :dynamic) -; (multiple-value-bind (vwidth vheight) -; (bounding-rectangle-size scroller) -; (multiple-value-bind (cwidth cheight) -; (bounding-rectangle-size -; (viewport-contents-extent (slot-value scroller 'viewport))) -; (let ((ohenp (sheet-enabled-p hscroll-bar)) -; (ovenp (sheet-enabled-p vscroll-bar)) -; (nhenp (> cwidth vwidth)) -; (nvenp (> cheight vheight))) -; (values -; (not (and (eq ohenp nhenp) -; (eq ovenp nvenp))) -; (and (not (eq ohenp nhenp)) hscroll-bar) -; nhenp -; (and (not (eq ovenp nvenp)) vscroll-bar) -; nvenp)))) -; (values nil nil nil nil nil)))) +(defun update-dynamic-scroll-bars (scroller changedp + hscroll-bar hscroll-bar-enabled-p + vscroll-bar vscroll-bar-enabled-p + &optional relayout) + (when changedp + (when hscroll-bar + (setf (sheet-enabled-p hscroll-bar) hscroll-bar-enabled-p)) + (when vscroll-bar + (setf (sheet-enabled-p vscroll-bar) vscroll-bar-enabled-p)) + (when (or (and hscroll-bar (not hscroll-bar-enabled-p)) + (and vscroll-bar (not vscroll-bar-enabled-p))) + (let* ((contents (slot-value scroller 'contents)) + (c-extent (viewport-contents-extent + (pane-viewport contents)))) + (multiple-value-bind (vx vy) + (window-viewport-position contents) + (window-set-viewport-position + contents + (if (and hscroll-bar (not hscroll-bar-enabled-p)) + (bounding-rectangle-min-x c-extent) + vx) + (if (and vscroll-bar (not vscroll-bar-enabled-p)) + (bounding-rectangle-min-y c-extent) + vy))))) + (clear-space-requirement-caches-in-tree scroller) + (when relayout + ;;--- This is kinda bogus. If this was a generic scroller then + ;;--- you want to layout the table. + (let ((table (slot-value scroller 'viewport))) + (multiple-value-bind (width height) + (bounding-rectangle-size table) + (allocate-space table width height)))))) + +(defun compute-dynamic-scroll-bar-values (scroller) + (let* ((hscroll-bar (scroller-pane-horizontal-scroll-bar scroller)) + (vscroll-bar (scroller-pane-vertical-scroll-bar scroller)) + (scroll-bar-policy (scroller-pane-scroll-bar-policy scroller))) + (if (eq scroll-bar-policy :dynamic) + (multiple-value-bind (vwidth vheight) + (bounding-rectangle-size scroller) + (multiple-value-bind (cwidth cheight) + (bounding-rectangle-size + (viewport-contents-extent (slot-value scroller 'viewport))) + (let ((ohenp (sheet-enabled-p hscroll-bar)) + (ovenp (sheet-enabled-p vscroll-bar)) + (nhenp (> cwidth vwidth)) + (nvenp (> cheight vheight))) + (values + (not (and (eq ohenp nhenp) + (eq ovenp nvenp))) + (and (not (eq ohenp nhenp)) hscroll-bar) + nhenp + (and (not (eq ovenp nvenp)) vscroll-bar) + nvenp)))) + (values nil nil nil nil nil)))) (defun viewport-contents-extent (viewport) (let ((contents (sheet-child viewport))) diff --git a/silica/medium.lisp b/silica/medium.lisp index 598788dc..6404e198 100644 --- a/silica/medium.lisp +++ b/silica/medium.lisp @@ -105,8 +105,8 @@ ;; removed out hard-wired white background hack for nt (cim 10/9/96) (defclass sheet-with-resources-mixin () - ((foreground :initform nil :accessor pane-foreground) - (background :initform nil :accessor pane-background) + ((foreground :initform nil :initarg :foreground :accessor pane-foreground) + (background :initform nil :initarg :background :accessor pane-background) (text-style :initform nil :initarg :text-style :accessor pane-text-style) (initargs :initform nil :reader sheet-with-resources-initargs))) -- GitLab