Permalink
Browse files

Added support for reading PNG files contributed by Samium Gromoff. Th…

…anks!
  • Loading branch information...
1 parent 5fb1d39 commit 5826e16444290b4a80020b5cd51badd8023a391b Robert Strandh committed Sep 2, 2009
Showing with 68 additions and 0 deletions.
  1. +44 −0 Extensions/Bitmap-formats/png.lisp
  2. +24 −0 mcclim-png-bitmaps.asd
View
44 Extensions/Bitmap-formats/png.lisp
@@ -0,0 +1,44 @@
+;;; -*- Mode: Lisp; Package: MCCLIM-IMAGES -*-
+
+;;; (c) copyright 2009 by
+;;; Samium Gromoff (_deepfire@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))
View
24 mcclim-png-bitmaps.asd
@@ -0,0 +1,24 @@
+;;; -*- Mode: Lisp -*-
+
+;;; (c) copyright 2009 by
+;;; Samium Gromoff (_deepfire@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")))

0 comments on commit 5826e16

Please sign in to comment.