Author: hhubner Date: 2007-10-05 02:04:47 -0400 (Fri, 05 Oct 2007) New Revision: 2220 Added: branches/trunk-reorg/thirdparty/salza-png-1.0.1/ branches/trunk-reorg/thirdparty/salza-png-1.0.1/README branches/trunk-reorg/thirdparty/salza-png-1.0.1/png.lisp branches/trunk-reorg/thirdparty/salza-png-1.0.1/salza-png.asd Removed: branches/trunk-reorg/thirdparty/salza-png-1.0/ Log: update salza-png Added: branches/trunk-reorg/thirdparty/salza-png-1.0.1/README =================================================================== --- branches/trunk-reorg/thirdparty/salza-png-1.0.1/README 2007-10-05 06:02:33 UTC (rev 2219) +++ branches/trunk-reorg/thirdparty/salza-png-1.0.1/README 2007-10-05 06:04:47 UTC (rev 2220) @@ -0,0 +1,35 @@ +The salza-png software is a standalone version of the PNG writer from +the salza examples directory. Documentation, such as it is, is at the +start of png.lisp. + +For questions or comments, please contact me, Zach Beane, at +xach@xach.com. + +salza-png is offered under the following license: + +;;; +;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Added: branches/trunk-reorg/thirdparty/salza-png-1.0.1/png.lisp =================================================================== --- branches/trunk-reorg/thirdparty/salza-png-1.0.1/png.lisp 2007-10-05 06:02:33 UTC (rev 2219) +++ branches/trunk-reorg/thirdparty/salza-png-1.0.1/png.lisp 2007-10-05 06:04:47 UTC (rev 2220) @@ -0,0 +1,203 @@ +;;; +;;; png.lisp +;;; +;;; Created: 2005-03-14 by Zach Beane <xach@xach.com> +;;; +;;; An example use of the salza ZLIB interface functions. +;;; +;;; (setq png (make-instance 'png +;;; :color-type :truecolor +;;; :height 10 +;;; :width 10 +;;; :image-data <300 bytes of image data>)) +;;; +;;; (write-png png "example.png") +;;; +;;; +;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;; +;;; $Id: png.lisp,v 1.2 2007/10/01 13:37:47 xach Exp $ + +(defpackage #:png + (:use #:cl #:salza #:salza-deflate) + (:export #:png + #:write-png + #:write-png-stream)) + +(in-package :png) + + +;;; Chunks + +(defclass chunk () + ((buffer :initarg :buffer :reader buffer) + (pos :initform 4 :accessor pos))) + +(defun chunk-write-byte (byte chunk) + "Save one byte to CHUNK." + (setf (aref (buffer chunk) (pos chunk)) byte) + (incf (pos chunk))) + +(defun chunk-write-uint32 (integer chunk) + "Save INTEGER to CHUNK as four bytes." + (dotimes (i 4) + (setf (aref (buffer chunk) (pos chunk)) + (logand #xFF (ash integer (+ -24 (* i 8))))) + (incf (pos chunk)))) + +(defun make-chunk (a b c d size) + "Make a chunk that uses A, B, C, and D as the signature bytes, with +data size SIZE." + (let ((buffer (make-array (+ size 4) :element-type '(unsigned-byte 8)))) + (setf (aref buffer 0) a + (aref buffer 1) b + (aref buffer 2) c + (aref buffer 3) d) + (make-instance 'chunk + :buffer buffer))) + +(defun write-uint32 (integer stream) + (dotimes (i 4) + (write-byte (logand #xFF (ash integer (+ -24 (* i 8)))) stream))) + +(defun write-chunk (chunk stream) + (write-uint32 (- (pos chunk) 4) stream) + (write-sequence (buffer chunk) stream :end (pos chunk)) + (write-sequence (crc32-sequence (buffer chunk) :end (pos chunk)) stream)) + + +;;; PNGs + +(defclass png () + ((width :initarg :width :reader width) + (height :initarg :height :reader height) + (color-type :initform :truecolor :initarg :color-type :reader color-type) + (bpp :initform 8 :initarg :bpp :reader bpp) + (image-data :initarg :image-data :reader image-data))) + +(defmethod initialize-instance :after ((png png) &rest args) + (declare (ignore args)) + (assert (= (length (image-data png)) + (* (height png) (rowstride png))))) + +(defgeneric write-png (png pathname &key if-exists)) +(defgeneric write-ihdr (png stream)) +(defgeneric ihdr-color-type (png)) +(defgeneric write-idat (png stream)) +(defgeneric write-iend (png stream)) +(defgeneric write-png-header (png stream)) +(defgeneric scanline-offset (png scanline)) +(defgeneric rowstride (png)) +(defgeneric samples/pixel (png)) + +(defmethod samples/pixel (png) + (ecase (color-type png) + (:grayscale 1) + (:truecolor 3) + (:indexed-color 1) + (:grayscale-alpha 2) + (:truecolor-alpha 4))) + + +(defmethod rowstride (png) + (* (width png) (samples/pixel png))) + +(defmethod scanline-offset (png scanline) + (* scanline (rowstride png))) + +(defmethod write-png-header (png stream) + (let ((header (make-array 8 + :element-type '(unsigned-byte 8) + :initial-contents '(137 80 78 71 13 10 26 10)))) + (write-sequence header stream))) + +(defvar *color-types* + '((:grayscale . 0) + (:truecolor . 2) + (:indexed-color . 3) + (:grayscale-alpha . 4) + (:truecolor-alpha . 6))) + +(defmethod ihdr-color-type (png) + (cdr (assoc (color-type png) *color-types*))) + +(defmethod write-ihdr (png stream) + (let ((chunk (make-chunk 73 72 68 82 13))) + (chunk-write-uint32 (width png) chunk) + (chunk-write-uint32 (height png) chunk) + (chunk-write-byte (bpp png) chunk) + (chunk-write-byte (ihdr-color-type png) chunk) + ;; compression method + (chunk-write-byte 0 chunk) + ;; filtering + (chunk-write-byte 0 chunk) + ;; interlace + (chunk-write-byte 0 chunk) + (write-chunk chunk stream))) + +(defmethod write-idat (png stream) + (let* ((chunk (make-chunk 73 68 65 84 16384)) + (filter-type (make-array 1 + :element-type '(unsigned-byte 8) + :initial-element 0))) + (flet ((write-full-chunk (zlib-stream) + (setf (pos chunk) (zlib-stream-position zlib-stream)) + (write-chunk chunk stream) + (fill (buffer chunk) 0 :start 4) + (setf (zlib-stream-position zlib-stream) 4))) + (let ((zlib-stream (make-zlib-stream (buffer chunk) + :start 4 + :callback #'write-full-chunk))) + (dotimes (i (height png)) + (let* ((start-offset (scanline-offset png i)) + (end-offset (+ start-offset (rowstride png)))) + (zlib-write-sequence filter-type zlib-stream) + (zlib-write-sequence (image-data png) zlib-stream + :start start-offset + :end end-offset))) + (finish-zlib-stream zlib-stream))))) + + + +(defmethod write-iend (png stream) + (let ((chunk (make-chunk 73 69 78 68 0))) + (write-chunk chunk stream))) + +(defmethod write-png-stream (png stream) + (write-png-header png stream) + (write-ihdr png stream) + (write-idat png stream) + (write-iend png stream)) + +(defmethod write-png (png file &key (if-exists :supersede)) + (with-open-file (stream file + :direction :output + :if-exists if-exists + :if-does-not-exist :create + :element-type '(unsigned-byte 8)) + (write-png-stream png stream) + (truename file))) Added: branches/trunk-reorg/thirdparty/salza-png-1.0.1/salza-png.asd =================================================================== --- branches/trunk-reorg/thirdparty/salza-png-1.0.1/salza-png.asd 2007-10-05 06:02:33 UTC (rev 2219) +++ branches/trunk-reorg/thirdparty/salza-png-1.0.1/salza-png.asd 2007-10-05 06:04:47 UTC (rev 2220) @@ -0,0 +1,35 @@ +;;; +;;; salza-png.asd +;;; +;;; Copyright (c) 2007 Zachary Beane, All Rights Reserved +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; +;;; * Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; +;;; * Redistributions in binary form must reproduce the above +;;; copyright notice, this list of conditions and the following +;;; disclaimer in the documentation and/or other materials +;;; provided with the distribution. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED +;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;; +;;; $Id: salza-png.asd,v 1.2 2007/10/01 13:37:29 xach Exp $ + +(asdf:defsystem #:salza-png + :depends-on (#:salza) + :version "1.0.1" + :components ((:file "png")))