[mcclim-devel] PNG read support for McCLIM.

Samium Gromoff _deepfire at feelingofgreen.ru
Tue Sep 1 00:58:50 UTC 2009


Good day folks,

the included patch (also available via git[1]) adds a bridge
to PNG-READ[2] by Jakub Higersberger, adding pure CL PNG support to McCLIM.


diff --git a/Extensions/Bitmap-formats/png.lisp b/Extensions/Bitmap-formats/png.lisp
new file mode 100644
index 0000000..3c75b13
--- /dev/null
+++ b/Extensions/Bitmap-formats/png.lisp
@@ -0,0 +1,44 @@
+;;; -*- Mode: Lisp; Package: MCCLIM-IMAGES -*-
+
+;;;  (c) copyright 2009 by
+;;;           Samium Gromoff (_deepfire at feelingofgreen.ru)
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA  02111-1307  USA.
+
+(in-package :clim-internals)
+
+(define-bitmap-file-reader :png (image-pathname)
+  (let* ((png-state (png-read:read-png-file image-pathname))
+         (data (png-read:image-data png-state))
+         (depth (png-read:bit-depth png-state))
+         (height (png-read:height png-state))
+         (width (png-read:width png-state))
+         (array (make-array (list height width) :element-type '(unsigned-byte 32))))
+    (unless (member depth '(8 32))
+      (error "~@<PNG-encoded images with bit depth ~D are not supported. The only supported bit depths are 8 and 32.~:@>" depth))
+    (dotimes (y height)
+      (dotimes (x width)
+        (case depth
+          ((8 32)
+           (let ((red (aref data x y 0))
+                 (green (aref data x y 1))
+                 (blue (aref data x y 2)))
+             (setf (aref array y x)
+                   (dpb red (byte 8 0)
+                        (dpb green (byte 8 8)
+                             (dpb blue (byte 8 16)
+                                  (dpb (- 255 0) (byte 8 24) 0))))))))))
+    array))
diff --git a/mcclim-png-bitmaps.asd b/mcclim-png-bitmaps.asd
new file mode 100644
index 0000000..0a63f70
--- /dev/null
+++ b/mcclim-png-bitmaps.asd
@@ -0,0 +1,24 @@
+;;; -*- Mode: Lisp -*-
+
+;;;  (c) copyright 2009 by 
+;;;           Samium Gromoff (_deepfire at feelingofgreen.ru)
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the 
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
+;;; Boston, MA  02111-1307  USA.
+
+(asdf:defsystem :mcclim-png-bitmaps
+  :description "Support for PNG images in McCLIM bitmap reading functions."
+  :depends-on (:mcclim :png-read)
+  :components ((:file "png" :pathname #P"Extensions/Bitmap-formats/png")))


regards,
  Samium Gromoff
--
1. git://git.feelingofgreen.ru/mcclim, branch 'png-bitmaps'
2. git://github.com/Ramarren/png-read.git

                                 _deepfire-at-feelingofgreen.ru
O< ascii ribbon campaign - stop html mail - www.asciiribbon.org




More information about the mcclim-devel mailing list