Author: junrue Date: Mon Feb 20 00:58:33 2006 New Revision: 15
Modified: trunk/src/tests/uitoolkit/layout-tester.lisp trunk/src/uitoolkit/system/user32.lisp trunk/src/uitoolkit/widgets/layouts.lisp trunk/src/uitoolkit/widgets/widget.lisp Log: implemented widget visibility interaction with flow layout
Modified: trunk/src/tests/uitoolkit/layout-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/layout-tester.lisp (original) +++ trunk/src/tests/uitoolkit/layout-tester.lisp Mon Feb 20 00:58:33 2006 @@ -52,6 +52,12 @@ (declare (ignore widget time)) (exit-layout-tester))
+(defclass pack-layout-dispatcher (gfw:event-dispatcher) ()) + +(defmethod gfw:event-select ((d pack-layout-dispatcher) item time rect) + (declare (ignorable item time rect)) + (gfw:pack *layout-tester-win*)) + (defclass layout-tester-widget-events (gfw:event-dispatcher) ((toggle-fn :accessor toggle-fn @@ -61,11 +67,11 @@ :initarg :id :initform 0)))
-(defun add-layout-tester-widget (primary-type sub-type) +(defun add-layout-tester-widget (widget-class subtype) (let* ((be (make-instance 'layout-tester-widget-events :id *button-counter*)) - (w (make-instance primary-type :dispatcher be))) + (w (make-instance widget-class :dispatcher be))) (cond - ((eql sub-type :push-button) + ((eql subtype :push-button) (setf (toggle-fn be) (let ((flag nil)) #'(lambda () (if (null flag) @@ -76,25 +82,88 @@ (setf flag nil) (format nil "~d ~a" (id be) +btn-text-after+)))))) (incf *button-counter*))) - (gfw:realize w *layout-tester-win* sub-type) + (gfw:realize w *layout-tester-win* subtype) (setf (gfw:text w) (funcall (toggle-fn be)))))
(defmethod gfw:event-select ((d layout-tester-widget-events) btn time rect) (declare (ignorable time rect)) (setf (gfw:text btn) (funcall (toggle-fn d))) + (gfw:layout *layout-tester-win*)) + +(defclass add-child-dispatcher (gfw:event-dispatcher) + ((widget-class + :accessor widget-class + :initarg :widget-class + :initform 'gfw:button) + (subtype + :accessor subtype + :initarg :subtype + :initform :push-button))) + +(defmethod gfw:event-select ((d add-child-dispatcher) item time rect) + (declare (ignorable item time rect)) + (add-layout-tester-widget (widget-class d) (subtype d)) (gfw:pack *layout-tester-win*))
-(defclass layout-tester-child-menu-dispatcher (gfw:event-dispatcher) ()) +(defclass child-menu-dispatcher (gfw:event-dispatcher) + ((item-disp-class + :accessor item-disp-class + :initarg :item-disp-class + :initform nil)))
-(defmethod gfw:event-activate ((d layout-tester-child-menu-dispatcher) menu time) +(defmethod gfw:event-activate ((d child-menu-dispatcher) menu time) (declare (ignore time)) (gfw:clear-all menu) (gfw:with-children (*layout-tester-win* kids) (loop for k in kids do (let ((it (make-instance 'gfw:menu-item))) (gfw:item-append menu it) + (unless (null (item-disp-class d)) + (setf (gfw:dispatcher it) (make-instance (item-disp-class d)))) (setf (gfw:text it) (gfw:text k))))))
+(defclass remove-child-dispatcher (gfw:event-dispatcher) ()) + +(defmethod gfw:event-select ((d remove-child-dispatcher) item time rect) + (declare (ignorable time rect)) + (let ((text (gfw:text item)) + (victim nil)) + (gfw:with-children (*layout-tester-win* kids) + (loop for k in kids + do (if (string= (gfw:text k) text) + (setf victim k)))) + (unless (null victim) + (gfi:dispose victim) + (gfw:layout *layout-tester-win*)))) + +(defclass hide-child-dispatcher (gfw:event-dispatcher) ()) + +(defmethod gfw:event-select ((d hide-child-dispatcher) item time rect) + (declare (ignorable time rect)) + (let ((text (gfw:text item)) + (victim nil)) + (gfw:with-children (*layout-tester-win* kids) + (loop for k in kids + do (if (string= (gfw:text k) text) + (setf victim k)))) + (unless (null victim) + (gfw:hide victim) + (gfw:layout *layout-tester-win*)))) + +(defclass show-child-dispatcher (gfw:event-dispatcher) ()) + +(defmethod gfw:event-select ((d show-child-dispatcher) item time rect) + (declare (ignorable time rect)) + (let ((text (gfw:text item)) + (victim nil)) + (gfw:with-children (*layout-tester-win* kids) + (loop for k in kids + do (if (string= (gfw:text k) text) + (setf victim k)))) + (unless (null victim) + (gfw:show victim) + (gfw:pack *layout-tester-win*)))) + (defclass layout-tester-exit-dispatcher (gfw:event-dispatcher) ())
(defmethod gfw:event-select ((d layout-tester-exit-dispatcher) item time rect) @@ -103,21 +172,36 @@
(defun run-layout-tester-internal () (setf *button-counter* 0) - (let* ((menubar nil) - (fed (make-instance 'layout-tester-exit-dispatcher)) - (cmd (make-instance 'layout-tester-child-menu-dispatcher))) + (let ((menubar nil) + (exit-disp (make-instance 'layout-tester-exit-dispatcher)) + (pack-disp (make-instance 'pack-layout-dispatcher)) + (add-btn-disp (make-instance 'add-child-dispatcher)) + (rem-menu-disp (make-instance 'child-menu-dispatcher :item-disp-class 'remove-child-dispatcher)) + (hide-menu-disp (make-instance 'child-menu-dispatcher :item-disp-class 'hide-child-dispatcher)) + (show-menu-disp (make-instance 'child-menu-dispatcher :item-disp-class 'show-child-dispatcher))) (setf *layout-tester-win* (make-instance 'gfw:window :dispatcher (make-instance 'layout-tester-events) :layout-manager (make-instance 'gfw:flow-layout))) (gfw:realize *layout-tester-win* nil :style-workspace) - (setf (gfw:size *layout-tester-win*) (gfi:make-size :width 250 :height 150)) (setf menubar (gfw:defmenusystem `(((:menu "&File") - (:menuitem "E&xit" :dispatcher ,fed)) - ((:menu "&Children" :dispatcher ,cmd) - (:menuitem :separator))))) + (:menuitem "E&xit" :dispatcher ,exit-disp)) + ((:menu "&Children") + (:menuitem :submenu ((:menu "Add") + (:menuitem "Button" :dispatcher ,add-btn-disp))) + (:menuitem :submenu ((:menu "Remove" :dispatcher ,rem-menu-disp) + (:menuitem :separator))) + (:menuitem :submenu ((:menu "Hide" :dispatcher ,hide-menu-disp) + (:menuitem :separator))) + (:menuitem :submenu ((:menu "Show" :dispatcher ,show-menu-disp) + (:menuitem :separator)))) + ((:menu "&Window") + (:menuitem "Pack" :dispatcher ,pack-disp) + (:menuitem :submenu ((:menu "Select Layout") + (:menuitem "Flow"))) + (:menuitem :submenu ((:menu "Modify Layout") + (:menuitem :separator))))))) (setf (gfw:menu-bar *layout-tester-win*) menubar) - (add-layout-tester-widget 'gfw:button :push-button) - (add-layout-tester-widget 'gfw:button :push-button) - (add-layout-tester-widget 'gfw:button :push-button) + (dotimes (i 3) + (add-layout-tester-widget 'gfw:button :push-button)) (gfw:pack *layout-tester-win*) (gfw:show *layout-tester-win*)))
Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Mon Feb 20 00:58:33 2006 @@ -303,6 +303,11 @@ (erase BOOL))
(defcfun + ("IsWindowVisible" is-window-visible) + BOOL + (hwnd HANDLE)) + +(defcfun ("LoadImageA" load-image) HANDLE (instance HANDLE)
Modified: trunk/src/uitoolkit/widgets/layouts.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/layouts.lisp (original) +++ trunk/src/uitoolkit/widgets/layouts.lisp Mon Feb 20 00:58:33 2006 @@ -77,42 +77,44 @@ (with-children (win kids) (loop for k in kids do (let ((kid-size (preferred-size k width-hint height-hint))) - (if (not vert-orient) - (progn - (incf total (gfi:size-width kid-size)) - (if (< max (gfi:size-height kid-size)) - (setf max (gfi:size-height kid-size)))) - (progn - (incf total (gfi:size-height kid-size)) - (if (< max (gfi:size-width kid-size)) - (setf max (gfi:size-width kid-size)))))))) + (when (or (visible-p k) (not (visible-p win))) + (if (not vert-orient) + (progn + (incf total (gfi:size-width kid-size)) + (if (< max (gfi:size-height kid-size)) + (setf max (gfi:size-height kid-size)))) + (progn + (incf total (gfi:size-height kid-size)) + (if (< max (gfi:size-width kid-size)) + (setf max (gfi:size-width kid-size))))))))) (if vert-orient (gfi:make-size :width max :height total) (gfi:make-size :width total :height max))))
(defmethod compute-layout ((layout flow-layout) (win window) width-hint height-hint) - (let ((layout-style (gfw:style layout)) - (entries nil) + (let ((entries nil) (last-coord 0) - (last-dim 0)) + (last-dim 0) + (vert-orient (find :vertical (gfw:style layout)))) (with-children (win kids) (loop for k in kids do (let ((kid-size (preferred-size k width-hint height-hint)) (pnt (gfi:make-point))) - (if (not (find :vertical layout-style)) - (progn - (setf (gfi:point-x pnt) (+ last-coord last-dim)) - (if (>= height-hint 0) - (setf (gfi:size-height kid-size) height-hint)) - (setf last-coord (gfi:point-x pnt)) - (setf last-dim (gfi:size-width kid-size))) - (progn - (setf (gfi:point-y pnt) (+ last-coord last-dim)) - (if (>= width-hint 0) - (setf (gfi:size-width kid-size) width-hint)) - (setf last-coord (gfi:point-y pnt)) - (setf last-dim (gfi:size-height kid-size)))) - (push (cons k (make-instance 'gfi:rectangle :size kid-size :location pnt)) entries)))) + (when (or (visible-p k) (not (visible-p win))) + (if (not vert-orient) + (progn + (setf (gfi:point-x pnt) (+ last-coord last-dim)) + (if (>= height-hint 0) + (setf (gfi:size-height kid-size) height-hint)) + (setf last-coord (gfi:point-x pnt)) + (setf last-dim (gfi:size-width kid-size))) + (progn + (setf (gfi:point-y pnt) (+ last-coord last-dim)) + (if (>= width-hint 0) + (setf (gfi:size-width kid-size) width-hint)) + (setf last-coord (gfi:point-y pnt)) + (setf last-dim (gfi:size-height kid-size)))) + (push (cons k (make-instance 'gfi:rectangle :size kid-size :location pnt)) entries))))) (reverse entries)))
(defmethod initialize-instance :after ((layout flow-layout) &key style)
Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Mon Feb 20 00:58:33 2006 @@ -77,6 +77,9 @@ (if (gfi:disposed-p w) (error 'gfi:disposed-error)))
+(defmethod hide ((w widget)) + (gfs::show-window (gfi:handle w) gfs::+sw-hide+)) + (defmethod location ((w widget)) (cffi:with-foreign-object (wi-ptr 'gfs::windowinfo) (cffi:with-foreign-slots ((gfs::cbsize @@ -131,7 +134,17 @@ (if (gfi:disposed-p w) (error 'gfi:disposed-error)))
+(defmethod show ((w widget)) + (gfs::show-window (gfi:handle w) gfs::+sw-showna+)) + (defmethod update ((w widget)) (let ((hwnd (gfi:handle w))) (unless (gfi:null-handle-p hwnd) (gfs::update-window hwnd)))) + +(defmethod visible-p :before ((w widget)) + (if (gfi:disposed-p w) + (error 'gfi:disposed-error))) + +(defmethod visible-p ((w widget)) + (not (zerop (gfs::is-window-visible (gfi:handle w)))))