[mcclim-cvs] CVS mcclim/Examples

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim/Examples
In directory clnet:/tmp/cvs-serv10125/Examples

Modified Files:
	image-viewer.lisp 
Log Message:
Improved the image-viewer demo.


--- /project/mcclim/cvsroot/mcclim/Examples/image-viewer.lisp	2008/04/14 16:46:28	1.1
+++ /project/mcclim/cvsroot/mcclim/Examples/image-viewer.lisp	2008/04/15 10:19:21	1.2
@@ -43,17 +43,23 @@
   ;; Clear the old image.
   (with-bounding-rectangle* (x1 y1 x2 y2) (sheet-region pane)    
     (draw-rectangle* (sheet-medium pane) x1 y1 x2 y2 :ink +background-ink+))
+  ;; Draw the new one, if there is one.
   (when (gadget-value pane)
-    ;; Try to ensure there is room for the new image.
-    (change-space-requirements pane
-     :height (pattern-height (gadget-value pane))
-     :width (pattern-width (gadget-value pane)))
-    ;; Draw the new one, if there is one.
-    (handler-case (draw-pattern* pane (gadget-value pane) 0 0)
-      (error ()
-        (with-text-style (pane (make-text-style nil :italic nil))
-          (draw-text* pane (format nil "Error while drawing image")
-                      0 0 :align-y :top))))))
+    (let ((image-height (pattern-height (gadget-value pane)))
+          (image-width (pattern-width (gadget-value pane))))
+      ;; Try to ensure there is room for the new image.
+      (change-space-requirements pane :height image-height :width image-width)
+      ;; Draw it in the center.
+      (handler-case (draw-pattern*
+                     pane (gadget-value pane)
+                     (/ (- (bounding-rectangle-width pane) image-width)
+                        2)
+                     (/ (- (bounding-rectangle-height pane) image-height)
+                        2))
+        (error ()
+          (with-text-style (pane (make-text-style nil :italic nil))
+            (draw-text* pane (format nil "Error while drawing image")
+                        0 0 :align-y :top)))))))
 
 (define-application-frame image-viewer ()
   ((%image-pathname :accessor image-pathname
@@ -93,6 +99,10 @@
             (format t "Image format ~A not recognized" type))))
       (format t "No such file: ~A" image-pathname)))
 
+(define-image-viewer-command (com-blank-image :name t :menu t)
+    ()
+  (setf (gadget-value (find-pane-named *application-frame* 'viewer)) nil))
+
 (defun image-viewer (&key (new-process t))
   (flet ((run ()
            (let ((frame (make-application-frame 'image-viewer)))