[graphic-forms-cvs] r14 - in trunk/src: tests/uitoolkit uitoolkit/widgets

[junrue at common-lisp.net]

Author: junrue
Date: Sun Feb 19 21:46:03 2006
New Revision: 14

Modified:
   trunk/src/tests/uitoolkit/layout-tester.lisp
   trunk/src/uitoolkit/widgets/layouts.lisp
Log:
implemented flow layout compute-size; window pack now works

Modified: trunk/src/tests/uitoolkit/layout-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/layout-tester.lisp	(original)
+++ trunk/src/tests/uitoolkit/layout-tester.lisp	Sun Feb 19 21:46:03 2006
@@ -82,7 +82,7 @@
 (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*))
+  (gfw:pack *layout-tester-win*))
 
 (defclass layout-tester-child-menu-dispatcher (gfw:event-dispatcher) ())
 
@@ -118,6 +118,7 @@
     (add-layout-tester-widget 'gfw:button :push-button)
     (add-layout-tester-widget 'gfw:button :push-button)
     (add-layout-tester-widget 'gfw:button :push-button)
+    (gfw:pack *layout-tester-win*)
     (gfw:show *layout-tester-win*)))
 
 (defun run-layout-tester ()

Modified: trunk/src/uitoolkit/widgets/layouts.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/layouts.lisp	(original)
+++ trunk/src/uitoolkit/widgets/layouts.lisp	Sun Feb 19 21:46:03 2006
@@ -71,7 +71,24 @@
 ;;;
 
 (defmethod compute-size ((layout flow-layout) (win window) width-hint height-hint)
-  (error "not yet implemented"))
+  (let ((max -1)
+        (total 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)))
+                 (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))