[mcclim-cvs] CVS mcclim/Apps/Listener

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener
In directory clnet:/tmp/cvs-serv15385/Apps/Listener

Modified Files:
	dev-commands.lisp icons.lisp 
Log Message:
Converted MCCLIM-IMAGES to CLIM 2.2 bitmap functions (with extensions).

Includes new demo application.


--- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/02/04 03:17:39	1.52
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/04/14 16:46:28	1.53
@@ -1420,7 +1420,7 @@
   (object)
   (list object))
 
-(define-command (com-display-image :name t :command-table filesystem-commands
+#+nil(define-command (com-display-image :name t :command-table filesystem-commands
                                            :menu t)
     ((image-pathname 'pathname
       :default (user-homedir-pathname) :insert-default t))
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/icons.lisp	2008/01/14 06:52:00	1.7
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/icons.lisp	2008/04/14 16:46:28	1.8
@@ -34,7 +34,8 @@
 
 (defmacro deficon (var pathname)
   `(eval-when (:load-toplevel :execute)
-     (defparameter ,var (mcclim-images:load-image ,(merge-pathnames pathname *icon-path*)))))
+     (defparameter ,var (make-pattern-from-bitmap-file
+                         ,(merge-pathnames pathname *icon-path*) :format :xpm))))
 
 (defvar *icon-cache* (make-hash-table  :test #'equal))
 
@@ -42,9 +43,10 @@
   "Loads an icon from the *icon-path*, caching it by name in *icon-cache*"
   (or (gethash filename *icon-cache*)
       (setf (gethash filename *icon-cache*)
-            (mcclim-images:load-image
+            (make-pattern-from-bitmap-file
              (merge-pathnames (parse-namestring filename)
-                              *icon-path*)))))
+                              *icon-path*)
+             :format :xpm))))
 
 ;; Don't particularly need these any more..
 (deficon *folder-icon*   #P"folder.xpm")
@@ -58,8 +60,9 @@
 
 (defun draw-icon (stream pattern &key (extra-spacing 0) )
   (let ((stream (if (eq stream t) *standard-output* stream)))
-    (mcclim-images:draw-image stream pattern)
-    (stream-increment-cursor-position stream (+ (mcclim-images:image-width pattern) extra-spacing) 0)))
+    (multiple-value-bind (x y) (stream-cursor-position stream)
+      (draw-pattern* stream pattern x y)
+      (stream-increment-cursor-position stream (+ (pattern-width pattern) extra-spacing) 0))))
 
 (defun precache-icons ()
   (let ((pathnames (remove-if #'directoryp