Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Add proper tRNS handling for indexed images.

  • Loading branch information...
commit f9173046bafa303b12f8178534a5d53373800165 1 parent b389479
Jakub Higersberger authored April 16, 2008
51  ancillary-chunks.lisp
@@ -12,37 +12,44 @@
12 12
 	(h (height png-state))
13 13
 	(ct (colour-type png-state))
14 14
 	(imd (image-data png-state))
  15
+	(idx (index-data png-state))
15 16
 	(transp (transparency png-state)))
16 17
    (let ((t-map (make-array (list w h))))
17 18
      (iter (for i from 0 below w)
18 19
 	   (iter (for j from 0 below h)
19 20
 		 (setf (aref t-map i j)
20 21
 		       (ecase ct
21  
-			 (:greyscale (if (eql (aref imd i j) transp)
22  
-				0
23  
-				255))
24  
-			 (:truecolor (if (every #'identity
25  
-				       ;strange... SBCL hangs during compilation when
26  
-				       ;           always iterate keyword is used
27  
-				       (iter (for k from 0 to 2)
28  
-					     (collect (eql (aref imd i j k)
29  
-							   (aref transp k)))))
30  
-				0
31  
-				255))))))
  22
+			 (:greyscale
  23
+			  (if (eql (aref imd i j) transp)
  24
+			      0
  25
+			      255))
  26
+			 (:truecolor
  27
+			  (if (every #'identity
  28
+				     ;;strange... SBCL hangs during compilation when
  29
+				     ;;           always iterate keyword is used
  30
+				     (iter (for k from 0 to 2)
  31
+					   (collect (eql (aref imd i j k)
  32
+							 (aref transp k)))))
  33
+			      0
  34
+			      255))
  35
+			 (:indexed-colour
  36
+			  (if (array-in-bounds-p transp (aref idx i j))
  37
+			   (setf (aref t-map i j)
  38
+				 (aref idx i j))
  39
+			   (setf (aref t-map i j)
  40
+				 255)))))))
32 41
      (setf (transparency png-state) t-map))))
33 42
 
34 43
 (defmethod parse-ancillary-chunk ((chunk-type (eql '|tRNS|)) chunk-data)
35  
-  (when (or (eql (interlace-method *png-state*) :no-interlace)
36  
-	    (not (eql (colour-type *png-state*) :indexed-colour)))
37  
-   (ecase (colour-type *png-state*)
38  
-     (:greyscale (setf (transparency *png-state*)
39  
-		       (big-endian-vector-to-integer chunk-data)))
40  
-     (:truecolor (setf (transparency *png-state*)
41  
-		       (vector (big-endian-vector-to-integer (subseq chunk-data 0 2))
42  
-			       (big-endian-vector-to-integer (subseq chunk-data 2 4))
43  
-			       (big-endian-vector-to-integer (subseq chunk-data 4 6)))))
44  
-     (:indexed-colour (setf (transparency *png-state*)
45  
-			    chunk-data))))
  44
+  (ecase (colour-type *png-state*)
  45
+    (:greyscale (setf (transparency *png-state*)
  46
+		      (big-endian-vector-to-integer chunk-data)))
  47
+    (:truecolor (setf (transparency *png-state*)
  48
+		      (vector (big-endian-vector-to-integer (subseq chunk-data 0 2))
  49
+			      (big-endian-vector-to-integer (subseq chunk-data 2 4))
  50
+			      (big-endian-vector-to-integer (subseq chunk-data 4 6)))))
  51
+    (:indexed-colour (setf (transparency *png-state*)
  52
+			   chunk-data)))
46 53
   (when (or (eql (colour-type *png-state*) 0)
47 54
 	    (eql (colour-type *png-state*) 2))
48 55
     (push #'build-transparency-map (postprocess-ancillaries *png-state*))))
33  decode.lisp
@@ -72,11 +72,7 @@
72 72
      (let ((scanlines (get-scanlines data h (1+ (ceiling (* bd w) 8)))))
73 73
        (unfilter-scanlines scanlines (* bda 4))
74 74
        (let ((image-data (image-data png-state))
75  
-	     (index-data (index-data png-state))
76  
-	     (t-map (if (transparency png-state)
77  
-			(make-array (list w h))
78  
-			nil))
79  
-	     (transp (transparency png-state)))
  75
+	     (index-data (index-data png-state)))
80 76
 	 (iter (for scanline in-vector scanlines with-index k)
81 77
 	       (iter (for x in-vector scanline from 1 with-index xi by bda)
82 78
 		     (ecase bd
@@ -85,38 +81,21 @@
85 81
 				   (until (>= xii w))
86 82
 				   (let ((idx (ldb (byte 1 l) x)))
87 83
 				     (setf (aref index-data xii k) idx)
88  
-				     (set-image-slice-to-index xii k idx pal image-data)
89  
-				     (if t-map (setf (aref t-map xii k)
90  
-						     (if (array-in-bounds-p transp idx)
91  
-							 (aref transp idx)
92  
-							 255))))))
  84
+				     (set-image-slice-to-index xii k idx pal image-data))))
93 85
 			  (2 (iter (for l from 0 below 4)
94 86
 				   (for xii next (+ (* (1- xi) 4) l))
95 87
 				   (until (>= xii w))
96 88
 				   (let ((idx (ldb (byte 2 (* 2 l)) x)))
97 89
 				     (setf (aref index-data xii k) idx)
98  
-				     (set-image-slice-to-index xii k idx pal image-data)
99  
-				     (if t-map (setf (aref t-map xii k)
100  
-						     (if (array-in-bounds-p transp idx)
101  
-							 (aref transp idx)
102  
-							 255))))))
  90
+				     (set-image-slice-to-index xii k idx pal image-data))))
103 91
 			  (4 (iter (for l from 0 below 2)
104 92
 				   (for xii next (+ (* (1- xi) 2) l))
105 93
 				   (until (>= xii w))
106 94
 				   (let ((idx (ldb (byte 4 (* 4 l)) x)))
107 95
 				     (setf (aref index-data xii k) idx)
108  
-				     (set-image-slice-to-index xii k idx pal image-data)
109  
-				     (if t-map (setf (aref t-map xii k)
110  
-						     (if (array-in-bounds-p transp idx)
111  
-							 (aref transp idx)
112  
-							 255))))))
113  
-			  (8 (setf (aref index-data (1- xi) k) idx)
114  
-			     (set-image-slice-to-index (1- xi) k x pal image-data)
115  
-			     (if t-map (setf (aref t-map (1- xi) k)
116  
-					     (if (array-in-bounds-p transp x)
117  
-						 (aref transp x)
118  
-						 255)))))))
119  
-	 (if t-map (setf (transparency png-state) t-map)))
  96
+				     (set-image-slice-to-index xii k idx pal image-data))))
  97
+			  (8 (setf (aref index-data (1- xi) k) x)
  98
+			     (set-image-slice-to-index (1- xi) k x pal image-data))))))
120 99
        png-state))))
121 100
 
122 101
 (defmethod decode-data ((colour-type (eql :greyscale-alpha)) data png-state)

0 notes on commit f917304

Please sign in to comment.
Something went wrong with that request. Please try again.