-
Notifications
You must be signed in to change notification settings - Fork 8
/
critical-chunks.lisp
59 lines (54 loc) · 2.83 KB
/
critical-chunks.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
(in-package :png-read)
(defgeneric parse-critical-chunk (chunk-type chunk-data)
(:method (chunk-type chunk-data)
(error "Unknown critical chunk ~a." chunk-type)))
(defmethod parse-critical-chunk ((chunk-type (eql '|IHDR|)) chunk-data)
(let ((width (big-endian-vector-to-integer (subseq chunk-data 0 4)))
(height (big-endian-vector-to-integer (subseq chunk-data 4 8)))
(bit-depth (aref chunk-data 8))
(colour-type (aref chunk-data 9))
(compression (aref chunk-data 10))
(filter-method (aref chunk-data 11))
(interlace-method (aref chunk-data 12)))
(setf (width *png-state*) width
(height *png-state*) height
(bit-depth *png-state*) bit-depth
(colour-type *png-state*) (ecase colour-type
(0 :greyscale)
(2 :truecolor)
(3 :indexed-colour)
(4 :greyscale-alpha)
(6 :truecolor-alpha))
(compression *png-state*) (ecase compression
(0 :zlib))
(filter-method *png-state*) (ecase filter-method
(0 :standard-filter))
(interlace-method *png-state*) (ecase interlace-method
(0 :no-interlace)
(1 :adam7-interlace)))))
(defmethod parse-critical-chunk ((chunk-type (eql '|PLTE|)) chunk-data)
(unless (zerop (mod (length chunk-data) 3))
(error "Corrupted palette data."))
(let ((data-length (/ (length chunk-data) 3)))
(let ((palette-array (make-array (list data-length 3) :element-type '(unsigned-byte 8))))
(iter (for i from 0 below data-length)
(setf (aref palette-array i 0) (aref chunk-data (* i 3))
(aref palette-array i 1) (aref chunk-data (+ 1 (* i 3)))
(aref palette-array i 2) (aref chunk-data (+ 2 (* i 3)))))
(setf (palette *png-state*) palette-array))))
(defmethod parse-critical-chunk ((chunk-type (eql '|IDAT|)) chunk-data)
(when (zerop (length chunk-data))
(cerror "Ignore this chunk." "Empty IDAT chunk."))
(push chunk-data (datastream *png-state*)))
(defmethod parse-critical-chunk ((chunk-type (eql '|IEND|)) chunk-data)
(let* ((l (reduce #'+ (datastream *png-state*) :key #'length))
(v (make-array (list l) :element-type '(unsigned-byte 8))))
(loop
for start = 0 then (+ start (length chunk))
for chunk of-type (simple-array (unsigned-byte 8) (*)) in (reverse (datastream *png-state*))
do (replace v chunk :start1 start))
(setf (datastream *png-state*) v))
(finish-decoding *png-state*)
(dolist (tk (postprocess-ancillaries *png-state*))
(funcall tk *png-state*))
(setf (finished *png-state*) t))