Permalink
Browse files

Untabify and whitespace-cleanup

  • Loading branch information...
1 parent 2b001b7 commit d3c4254b523a53c8666181d2c607b3e0f7ce02cd @Ramarren committed Jun 9, 2009
Showing with 378 additions and 378 deletions.
  1. +90 −90 ancillary-chunks.lisp
  2. +44 −44 basic-chunks.lisp
  3. +8 −8 crc.lisp
  4. +24 −24 critical-chunks.lisp
  5. +134 −134 decode.lisp
  6. +65 −65 deinterlace.lisp
  7. +6 −6 package.lisp
  8. +7 −7 png-read.asd
View
@@ -9,144 +9,144 @@
(defun build-transparency-map (png-state)
(let ((w (width png-state))
- (h (height png-state))
- (ct (colour-type png-state))
- (imd (image-data png-state))
- (idx (index-data png-state))
- (transp (transparency png-state)))
+ (h (height png-state))
+ (ct (colour-type png-state))
+ (imd (image-data png-state))
+ (idx (index-data png-state))
+ (transp (transparency png-state)))
(let ((t-map (make-array (list w h))))
(iter (for i from 0 below w)
- (iter (for j from 0 below h)
- (setf (aref t-map i j)
- (ecase ct
- (:greyscale
- (if (eql (aref imd i j) transp)
- 0
- 255))
- (:truecolor
- (if (every #'identity
- ;;strange... SBCL hangs during compilation when
- ;; always iterate keyword is used
- (iter (for k from 0 to 2)
- (collect (eql (aref imd i j k)
- (aref transp k)))))
- 0
- 255))
- (:indexed-colour
- (if (array-in-bounds-p transp (aref idx i j))
- (setf (aref t-map i j)
- (aref idx i j))
- (setf (aref t-map i j)
- 255)))))))
+ (iter (for j from 0 below h)
+ (setf (aref t-map i j)
+ (ecase ct
+ (:greyscale
+ (if (eql (aref imd i j) transp)
+ 0
+ 255))
+ (:truecolor
+ (if (every #'identity
+ ;;strange... SBCL hangs during compilation when
+ ;; always iterate keyword is used
+ (iter (for k from 0 to 2)
+ (collect (eql (aref imd i j k)
+ (aref transp k)))))
+ 0
+ 255))
+ (:indexed-colour
+ (if (array-in-bounds-p transp (aref idx i j))
+ (setf (aref t-map i j)
+ (aref idx i j))
+ (setf (aref t-map i j)
+ 255)))))))
(setf (transparency png-state) t-map))))
(defmethod parse-ancillary-chunk ((chunk-type (eql '|tRNS|)) chunk-data)
(ecase (colour-type *png-state*)
(:greyscale (setf (transparency *png-state*)
- (big-endian-vector-to-integer chunk-data)))
+ (big-endian-vector-to-integer chunk-data)))
(:truecolor (setf (transparency *png-state*)
- (vector (big-endian-vector-to-integer (subseq chunk-data 0 2))
- (big-endian-vector-to-integer (subseq chunk-data 2 4))
- (big-endian-vector-to-integer (subseq chunk-data 4 6)))))
+ (vector (big-endian-vector-to-integer (subseq chunk-data 0 2))
+ (big-endian-vector-to-integer (subseq chunk-data 2 4))
+ (big-endian-vector-to-integer (subseq chunk-data 4 6)))))
(:indexed-colour (setf (transparency *png-state*)
- chunk-data)))
+ chunk-data)))
(when (or (eql (colour-type *png-state*) 0)
- (eql (colour-type *png-state*) 2))
+ (eql (colour-type *png-state*) 2))
(push #'build-transparency-map (postprocess-ancillaries *png-state*))))
(defmethod parse-ancillary-chunk ((chunk-type (eql '|gAMA|)) chunk-data)
(setf (gamma *png-state*)
- (big-endian-vector-to-integer chunk-data)))
+ (big-endian-vector-to-integer chunk-data)))
(defmethod parse-ancillary-chunk ((chunk-type (eql '|sBIT|)) chunk-data)
(setf (significant-bits *png-state*)
- (ecase (colour-type *png-state*)
- (:greyscale (list :greyscale (aref chunk-data 0)))
- ((:truecolor :indexed-colour) (list :red (aref chunk-data 0)
- :green (aref chunk-data 1)
- :blue (aref chunk-data 2)))
- (:greyscale-alpha (list :greyscale (aref chunk-data 0)
- :alpha (aref chunk-data 1)))
- (:truecolor-alpha (list :red (aref chunk-data 0)
- :green (aref chunk-data 1)
- :blue (aref chunk-data 2)
- :alpha (aref chunk-data 3))))))
+ (ecase (colour-type *png-state*)
+ (:greyscale (list :greyscale (aref chunk-data 0)))
+ ((:truecolor :indexed-colour) (list :red (aref chunk-data 0)
+ :green (aref chunk-data 1)
+ :blue (aref chunk-data 2)))
+ (:greyscale-alpha (list :greyscale (aref chunk-data 0)
+ :alpha (aref chunk-data 1)))
+ (:truecolor-alpha (list :red (aref chunk-data 0)
+ :green (aref chunk-data 1)
+ :blue (aref chunk-data 2)
+ :alpha (aref chunk-data 3))))))
(defmethod parse-ancillary-chunk ((chunk-type (eql '|sRGB|)) chunk-data)
(setf (rendering-intent *png-state*)
- (ecase chunk-data
- (0 :perceptual)
- (1 :relative-colorimetric)
- (2 :saturation)
- (3 :absolute-colorimetric))))
+ (ecase chunk-data
+ (0 :perceptual)
+ (1 :relative-colorimetric)
+ (2 :saturation)
+ (3 :absolute-colorimetric))))
(defmethod parse-ancillary-chunk ((chunk-type (eql '|tEXt|)) chunk-data)
(let ((separator (position 0 chunk-data)))
(let ((keyw (octets-to-string chunk-data :end separator :encoding :iso-8859-1))
- (text-string (octets-to-string chunk-data :start separator :encoding :iso-8859-1)))
+ (text-string (octets-to-string chunk-data :start separator :encoding :iso-8859-1)))
(push (cons keyw text-string) (textual-data *png-state*)))))
(defmethod parse-ancillary-chunk ((chunk-type (eql '|zTXt|)) chunk-data)
(let ((separator (position 0 chunk-data)))
(let ((keyw (octets-to-string chunk-data :end separator :encoding :iso-8859-1))
- (compression-method (aref chunk-data (1+ separator))))
+ (compression-method (aref chunk-data (1+ separator))))
(if (not (zerop compression-method))
- (cerror "Ignore this zTXt chunk." "Unknown text compression method in zTXt chunk.")
- (let ((text-string (octets-to-string
- (decompress nil :zlib chunk-data :input-start (+ separator 2))
- :encoding :iso-8859-1)))
- (push (cons keyw text-string) (textual-data *png-state*)))))))
+ (cerror "Ignore this zTXt chunk." "Unknown text compression method in zTXt chunk.")
+ (let ((text-string (octets-to-string
+ (decompress nil :zlib chunk-data :input-start (+ separator 2))
+ :encoding :iso-8859-1)))
+ (push (cons keyw text-string) (textual-data *png-state*)))))))
(defmethod parse-ancillary-chunk ((chunk-type (eql '|iTXt|)) chunk-data)
(let ((separator (position 0 chunk-data)))
(let ((keyw (octets-to-string chunk-data :end separator :encoding :iso-8859-1))
- (compression-flag (aref chunk-data (1+ separator)))
- (compression-method (aref chunk-data (+ separator 2)))
- (separator-2 (position 0 chunk-data :start (1+ separator))))
+ (compression-flag (aref chunk-data (1+ separator)))
+ (compression-method (aref chunk-data (+ separator 2)))
+ (separator-2 (position 0 chunk-data :start (1+ separator))))
(if (and (eql compression-flag 1)
- (not (zerop compression-method)))
- (cerror "Ignore this iTXt chunk." "Unknown text compression method in iTXt chunk.")
- (let ((language-tag (octets-to-string chunk-data :start (+ separator 3)
- :end separator-2 :encoding :ascii))
- (separator-3 (position 0 chunk-data :start (1+ separator-2))))
- (let ((tkeyw (octets-to-string chunk-data :start (1+ separator-2)
- :end separator-3 :encoding :utf-8))
- (ttext (if (and (eql compression-flag 1)
- (zerop compression-method))
- (octets-to-string (decompress nil :zlib chunk-data :input-start (1+ separator-3))
- :encoding :utf-8)
- (octets-to-string chunk-data :start (1+ separator-3) :encoding :utf-8))))
- (push (list keyw language-tag tkeyw ttext) (textual-data *png-state*))))))))
+ (not (zerop compression-method)))
+ (cerror "Ignore this iTXt chunk." "Unknown text compression method in iTXt chunk.")
+ (let ((language-tag (octets-to-string chunk-data :start (+ separator 3)
+ :end separator-2 :encoding :ascii))
+ (separator-3 (position 0 chunk-data :start (1+ separator-2))))
+ (let ((tkeyw (octets-to-string chunk-data :start (1+ separator-2)
+ :end separator-3 :encoding :utf-8))
+ (ttext (if (and (eql compression-flag 1)
+ (zerop compression-method))
+ (octets-to-string (decompress nil :zlib chunk-data :input-start (1+ separator-3))
+ :encoding :utf-8)
+ (octets-to-string chunk-data :start (1+ separator-3) :encoding :utf-8))))
+ (push (list keyw language-tag tkeyw ttext) (textual-data *png-state*))))))))
(defmethod parse-ancillary-chunk ((chunk-type (eql '|bKGD|)) chunk-data)
(setf (preferred-background *png-state*)
(ecase (colour-type *png-state*)
((:greyscale :greyscale-alpha) (big-endian-vector-to-integer chunk-data))
((:truecolor :truecolor-alpha) (vector (big-endian-vector-to-integer (subseq chunk-data 0 2))
- (big-endian-vector-to-integer (subseq chunk-data 2 4))
- (big-endian-vector-to-integer (subseq chunk-data 4 6))))
+ (big-endian-vector-to-integer (subseq chunk-data 2 4))
+ (big-endian-vector-to-integer (subseq chunk-data 4 6))))
(:indexed-colour (aref chunk-data 0)))))
(defmethod parse-ancillary-chunk ((chunk-type (eql '|hIST|)) chunk-data)
(setf (image-histogram *png-state*)
- (coerce (iter (for k index-of-vector chunk-data by 2)
- (collect (+ (* (aref chunk-data k) 256)
- (aref chunk-data (1+ k)))))
- '(vector (unsigned-byte 16)))))
+ (coerce (iter (for k index-of-vector chunk-data by 2)
+ (collect (+ (* (aref chunk-data k) 256)
+ (aref chunk-data (1+ k)))))
+ '(vector (unsigned-byte 16)))))
(defmethod parse-ancillary-chunk ((chunk-type (eql '|pHYs|)) chunk-data)
(setf (physical-dimensions *png-state*)
- (list :x-axis (big-endian-vector-to-integer (subseq chunk-data 0 4))
- :y-axis (big-endian-vector-to-integer (subseq chunk-data 4 8))
- :unit (ecase (aref chunk-data 8)
- (0 :unknown)
- (1 :metre)))))
+ (list :x-axis (big-endian-vector-to-integer (subseq chunk-data 0 4))
+ :y-axis (big-endian-vector-to-integer (subseq chunk-data 4 8))
+ :unit (ecase (aref chunk-data 8)
+ (0 :unknown)
+ (1 :metre)))))
(defmethod parse-ancillary-chunk ((chunk-type (eql '|tIME|)) chunk-data)
(setf (last-modification *png-state*)
- (encode-universal-time (aref chunk-data 6)
- (aref chunk-data 5)
- (aref chunk-data 4)
- (aref chunk-data 3)
- (aref chunk-data 2)
- (big-endian-vector-to-integer (subseq chunk-data 0 2)))))
+ (encode-universal-time (aref chunk-data 6)
+ (aref chunk-data 5)
+ (aref chunk-data 4)
+ (aref chunk-data 3)
+ (aref chunk-data 2)
+ (big-endian-vector-to-integer (subseq chunk-data 0 2)))))
View
@@ -8,11 +8,11 @@
(crc-is :initarg :crc-is :reader crc-is-of)
(crc-read :initarg :crc-read :reader crc-read-of))
(:report (lambda (c stream)
- (if (file-of c)
- (format stream "Checksum failure in file ~a. Computed: #x~x, read: #x~x."
- (file-of c) (crc-is-of c) (crc-read-of c))
- (format stream "Checksum failure in datastream. Computed: #x~x, read: #x~x."
- (crc-is-of c) (crc-read-of c))))))
+ (if (file-of c)
+ (format stream "Checksum failure in file ~a. Computed: #x~x, read: #x~x."
+ (file-of c) (crc-is-of c) (crc-read-of c))
+ (format stream "Checksum failure in datastream. Computed: #x~x, read: #x~x."
+ (crc-is-of c) (crc-read-of c))))))
(defun read-png-file (file)
(let ((*png-file* file))
@@ -28,13 +28,13 @@
((every #'eql *png-header* header)
(read-png-chunks png-stream))
(t (if *png-file*
- (error "File ~a is not a PNG file." *png-file*)
- (error "Not PNG datastream."))))))
+ (error "File ~a is not a PNG file." *png-file*)
+ (error "Not PNG datastream."))))))
(defun big-endian-vector-to-integer (byte-vector)
(iter (for i from (1- (length byte-vector)) downto 0)
- (for j from 0)
- (summing (ash (aref byte-vector j) (* 8 i)))))
+ (for j from 0)
+ (summing (ash (aref byte-vector j) (* 8 i)))))
(define-compiler-macro big-endian-vector-to-integer (&whole form byte-vector-form)
(if (and (listp byte-vector-form)
@@ -57,46 +57,46 @@
(defun read-png-chunks (png-stream)
(let ((length-field (make-array 4 :element-type '(unsigned-byte 8)))
- (type-field (make-array 4 :element-type '(unsigned-byte 8)))
- (crc-field (make-array 4 :element-type '(unsigned-byte 8)))
- (*png-state* (make-instance 'png-state)))
+ (type-field (make-array 4 :element-type '(unsigned-byte 8)))
+ (crc-field (make-array 4 :element-type '(unsigned-byte 8)))
+ (*png-state* (make-instance 'png-state)))
(if *png-file* (setf (png-file *png-state*) *png-file*))
(let ((crc-ok
- (iter
- (for read-status next (read-sequence length-field png-stream))
- (for type-status next (read-sequence type-field png-stream))
- (until (zerop read-status))
- (assert (eql read-status 4))
- (assert (eql type-status 4))
- (let ((chunk-length (big-endian-vector-to-integer length-field))
- (type-string (map 'string #'code-char type-field)))
- (let ((chunk-data (make-array chunk-length :element-type '(unsigned-byte 8))))
- (let ((data-status (read-sequence chunk-data png-stream)))
- (assert (eql data-status chunk-length))
- (let ((crc-status (read-sequence crc-field png-stream)))
- (assert (eql crc-status 4))
- (let ((read-crc (big-endian-vector-to-integer crc-field))
- (computed-crc (finish-crc (updated-crc (start-crc type-field) chunk-data))))
- (parse-chunk type-string chunk-data)
- (unless (eql read-crc computed-crc)
- (let ((condition (make-condition 'crc-failure
- :file *png-file*
- :crc-is computed-crc
- :crc-read read-crc)))
- (with-simple-restart (ignore-crc-failure "Ignore checksum failure.")
- (ecase *crc-fail-behaviour*
- (:error (error condition))
- (:warn (warn condition ))
- ((:no-action nil) nil)))))
- (collect (eql read-crc computed-crc))))))))))
+ (iter
+ (for read-status next (read-sequence length-field png-stream))
+ (for type-status next (read-sequence type-field png-stream))
+ (until (zerop read-status))
+ (assert (eql read-status 4))
+ (assert (eql type-status 4))
+ (let ((chunk-length (big-endian-vector-to-integer length-field))
+ (type-string (map 'string #'code-char type-field)))
+ (let ((chunk-data (make-array chunk-length :element-type '(unsigned-byte 8))))
+ (let ((data-status (read-sequence chunk-data png-stream)))
+ (assert (eql data-status chunk-length))
+ (let ((crc-status (read-sequence crc-field png-stream)))
+ (assert (eql crc-status 4))
+ (let ((read-crc (big-endian-vector-to-integer crc-field))
+ (computed-crc (finish-crc (updated-crc (start-crc type-field) chunk-data))))
+ (parse-chunk type-string chunk-data)
+ (unless (eql read-crc computed-crc)
+ (let ((condition (make-condition 'crc-failure
+ :file *png-file*
+ :crc-is computed-crc
+ :crc-read read-crc)))
+ (with-simple-restart (ignore-crc-failure "Ignore checksum failure.")
+ (ecase *crc-fail-behaviour*
+ (:error (error condition))
+ (:warn (warn condition ))
+ ((:no-action nil) nil)))))
+ (collect (eql read-crc computed-crc))))))))))
(unless (finished *png-state*)
- (if (png-file *png-state*)
- (error "No IEND chunk in file ~a." (png-file *png-state*))
- (error "No IEND chunk in stream.")))
+ (if (png-file *png-state*)
+ (error "No IEND chunk in file ~a." (png-file *png-state*))
+ (error "No IEND chunk in stream.")))
(values *png-state* (every #'identity crc-ok)))))
(defun parse-chunk (chunk-type chunk-data)
(let ((criticalp (char= (char chunk-type 0) (char (string-upcase chunk-type :end 1) 0))))
(if criticalp
- (parse-critical-chunk (intern chunk-type (find-package :png-read)) chunk-data)
- (parse-ancillary-chunk (intern chunk-type (find-package :png-read)) chunk-data))))
+ (parse-critical-chunk (intern chunk-type (find-package :png-read)) chunk-data)
+ (parse-ancillary-chunk (intern chunk-type (find-package :png-read)) chunk-data))))
View
@@ -3,20 +3,20 @@
(defun make-crc-array ()
(let ((crc-array (make-array 256 :initial-element 0)))
(iter (for n from 0 below 256)
- (let ((c n))
- (iter (for k from 0 below 8)
- (if (not (zerop (logand c 1)))
- (setf c (logxor #xedb88320 (ash c -1)))
- (setf c (ash c -1))))
- (setf (aref crc-array n) c)))
+ (let ((c n))
+ (iter (for k from 0 below 8)
+ (if (not (zerop (logand c 1)))
+ (setf c (logxor #xedb88320 (ash c -1)))
+ (setf c (ash c -1))))
+ (setf (aref crc-array n) c)))
crc-array))
(defvar *crc-array* (make-crc-array))
(defun updated-crc (crc data)
(reduce #'(lambda (c d)
- (logxor (aref *crc-array* (logand (logxor c d) #xff)) (ash c -8)))
- data :initial-value crc))
+ (logxor (aref *crc-array* (logand (logxor c d) #xff)) (ash c -8)))
+ data :initial-value crc))
(defun start-crc (data)
(updated-crc #xffffffff data))
Oops, something went wrong.

0 comments on commit d3c4254

Please sign in to comment.