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