[bknr-cvs] r2220 - in branches/trunk-reorg/thirdparty: . salza-png-1.0.1
bknr at bknr.net
bknr at bknr.net
Fri Oct 5 06:04:49 UTC 2007
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 at 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 at 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")))
More information about the Bknr-cvs
mailing list