Skip to content

Commit

Permalink
CHanged api back to truecolor/truecolor-alpha instead of 8/16 variant…
Browse files Browse the repository at this point in the history 
…s, as to

not break libraries such as opticl.
  • Loading branch information
@mfiano
mfiano committed Aug 15, 2017
1 parent 4bb82fc commit ec29f38
Show file tree
Hide file tree
Showing 4 changed files with 61 additions and 91 deletions.
10 changes: 5 additions & 5 deletions ancillary-chunks.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@
(if (eql (aref imd i j) transp)
0
opaque))
((:truecolor8 :truecolor16)
(:truecolor
(if (every #'identity
;;strange... SBCL hangs during compilation when
;; always iterate keyword is used
Expand All @@ -49,7 +49,7 @@
(:greyscale
(setf (transparency *png-state*)
(big-endian-vector-to-integer chunk-data)))
((:truecolor8 :truecolor16)
(: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))
Expand All @@ -67,14 +67,14 @@
(setf (significant-bits *png-state*)
(ecase (colour-type *png-state*)
(:greyscale (list :greyscale (aref chunk-data 0)))
((:truecolor8 :truecolor16 :indexed-colour)
((: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-alpha8 :truecolor-alpha16)
(:truecolor-alpha
(list :red (aref chunk-data 0)
:green (aref chunk-data 1)
:blue (aref chunk-data 2)
Expand Down Expand Up @@ -130,7 +130,7 @@
(setf (preferred-background *png-state*)
(ecase (colour-type *png-state*)
((:greyscale :greyscale-alpha) (big-endian-vector-to-integer chunk-data))
((:truecolor8 :truecolor16 :truecolor-alpha8 :truecolor-alpha16)
((: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))))
Expand Down
8 changes: 2 additions & 6 deletions critical-chunks.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,14 +17,10 @@
(bit-depth *png-state*) bit-depth
(colour-type *png-state*) (ecase colour-type
(0 :greyscale)
(2 (ecase bit-depth
(8 :truecolor8)
(16 :truecolor16)))
(2 :truecolor)
(3 :indexed-colour)
(4 :greyscale-alpha)
(6 (ecase bit-depth
(8 :truecolor-alpha8)
(16 :truecolor-alpha16))))
(6 :truecolor-alpha))
(compression *png-state*) (ecase compression
(0 :zlib))
(filter-method *png-state*) (ecase filter-method
Expand Down
122 changes: 48 additions & 74 deletions decode.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@
(big-endian-vector-to-integer (subseq scanline xi (+ xi 2)))))))))
png-state))

(defmethod decode-data ((colour-type (eql :truecolor8)) data png-state)
(defmethod decode-data ((colour-type (eql :truecolor)) data png-state)
(let* ((h (height png-state))
(w (width png-state))
(bd (bit-depth png-state))
Expand All @@ -58,42 +58,29 @@
(setf (image-data png-state)
(make-array (list w h 3) :element-type `(unsigned-byte ,bd)))
(unfilter-scanlines scanlines (* bda 3))
(loop with image-data of-type (simple-array (unsigned-byte 8) (* * *)) = (image-data png-state)
for scanline of-type (simple-array (unsigned-byte 8) (*)) across scanlines
for k of-type (unsigned-byte 32) from 0
do (loop for xi of-type (unsigned-byte 32) from 1 below (length scanline) by bda
for y of-type (unsigned-byte 32) from 0
do (setf (aref image-data (floor y 3) k (mod y 3))
(loop for i from (1- bda) downto 0
for j from xi below (expt 2 20)
sum (ash (aref scanline j) (* 8 i))
into s of-type (unsigned-byte 32)
finally (return s)))))
png-state))

(defmethod decode-data ((colour-type (eql :truecolor16)) data png-state)
(let* ((h (height png-state))
(w (width png-state))
(bd (bit-depth png-state))
(bda (/ bd 8))
(scanlines (get-scanlines data h (1+ (* bda w 3)))))
(declare (type (unsigned-byte 32) w h bd)
(type (unsigned-byte 3) bda)
(simple-vector scanlines))
(setf (image-data png-state)
(make-array (list w h 3) :element-type `(unsigned-byte ,bd)))
(unfilter-scanlines scanlines (* bda 3))
(loop with image-data of-type (simple-array (unsigned-byte 16) (* * *)) = (image-data png-state)
for scanline of-type (simple-array (unsigned-byte 8) (*)) across scanlines
for k of-type (unsigned-byte 32) from 0
do (loop for xi of-type (unsigned-byte 32) from 1 below (length scanline) by bda
for y of-type (unsigned-byte 32) from 0
do (setf (aref image-data (floor y 3) k (mod y 3))
(loop for i from (1- bda) downto 0
for j from xi below (expt 2 20)
sum (ash (aref scanline j) (* 8 i))
into s of-type (unsigned-byte 32)
finally (return s)))))
(case bd
(8 (loop with image-data of-type (simple-array (unsigned-byte 8) (* * *)) = (image-data png-state)
for scanline of-type (simple-array (unsigned-byte 8) (*)) across scanlines
for k of-type (unsigned-byte 32) from 0
do (loop for xi of-type (unsigned-byte 32) from 1 below (length scanline) by bda
for y of-type (unsigned-byte 32) from 0
do (setf (aref image-data (floor y 3) k (mod y 3))
(loop for i from (1- bda) downto 0
for j from xi below (expt 2 20)
sum (ash (aref scanline j) (* 8 i))
into s of-type (unsigned-byte 32)
finally (return s))))))
(16 (loop with image-data of-type (simple-array (unsigned-byte 16) (* * *)) = (image-data png-state)
for scanline of-type (simple-array (unsigned-byte 8) (*)) across scanlines
for k of-type (unsigned-byte 32) from 0
do (loop for xi of-type (unsigned-byte 32) from 1 below (length scanline) by bda
for y of-type (unsigned-byte 32) from 0
do (setf (aref image-data (floor y 3) k (mod y 3))
(loop for i from (1- bda) downto 0
for j from xi below (expt 2 20)
sum (ash (aref scanline j) (* 8 i))
into s of-type (unsigned-byte 32)
finally (return s)))))))
png-state))

(defun set-image-slice-to-index (x y idx palette image-data)
Expand Down Expand Up @@ -176,32 +163,7 @@
(big-endian-vector-to-integer (subseq scanline xi (+ xi 2)))))))))
png-state))

(defmethod decode-data ((colour-type (eql :truecolor-alpha8)) data png-state)
(let* ((h (height png-state))
(w (width png-state))
(bd (bit-depth png-state))
(bda (/ bd 8))
(scanlines (get-scanlines data h (1+ (* bda w 4)))))
(declare (type (unsigned-byte 32) w h bd)
(type (unsigned-byte 3) bda)
(simple-vector scanlines))
(setf (image-data png-state)
(make-array (list w h 4) :element-type `(unsigned-byte ,bd)))
(unfilter-scanlines scanlines (* bda 4))
(loop with image-data of-type (simple-array (unsigned-byte 8) (* * *)) = (image-data png-state)
for scanline of-type (simple-array (unsigned-byte 8) (*)) across scanlines
for k of-type (unsigned-byte 32) from 0
do (loop for xi of-type (unsigned-byte 32) from 1 below (length scanline) by bda
for y of-type (unsigned-byte 32) from 0
do (setf (aref image-data (floor y 4) k (mod y 4))
(loop for i from (1- bda) downto 0
for j from xi below (expt 2 20)
sum (ash (aref scanline j) (* 8 i))
into s of-type (unsigned-byte 32)
finally (return s)))))
png-state))

(defmethod decode-data ((colour-type (eql :truecolor-alpha16)) data png-state)
(defmethod decode-data ((colour-type (eql :truecolor-alpha)) data png-state)
(let* ((h (height png-state))
(w (width png-state))
(bd (bit-depth png-state))
Expand All @@ -213,17 +175,29 @@
(setf (image-data png-state)
(make-array (list w h 4) :element-type `(unsigned-byte ,bd)))
(unfilter-scanlines scanlines (* bda 4))
(loop with image-data of-type (simple-array (unsigned-byte 16) (* * *)) = (image-data png-state)
for scanline of-type (simple-array (unsigned-byte 8) (*)) across scanlines
for k of-type (unsigned-byte 32) from 0
do (loop for xi of-type (unsigned-byte 32) from 1 below (length scanline) by bda
for y of-type (unsigned-byte 32) from 0
do (setf (aref image-data (floor y 4) k (mod y 4))
(loop for i from (1- bda) downto 0
for j from xi below (expt 2 20)
sum (ash (aref scanline j) (* 8 i))
into s of-type (unsigned-byte 32)
finally (return s)))))
(case bd
(8 (loop with image-data of-type (simple-array (unsigned-byte 8) (* * *)) = (image-data png-state)
for scanline of-type (simple-array (unsigned-byte 8) (*)) across scanlines
for k of-type (unsigned-byte 32) from 0
do (loop for xi of-type (unsigned-byte 32) from 1 below (length scanline) by bda
for y of-type (unsigned-byte 32) from 0
do (setf (aref image-data (floor y 4) k (mod y 4))
(loop for i from (1- bda) downto 0
for j from xi below (expt 2 20)
sum (ash (aref scanline j) (* 8 i))
into s of-type (unsigned-byte 32)
finally (return s))))))
(16 (loop with image-data of-type (simple-array (unsigned-byte 16) (* * *)) = (image-data png-state)
for scanline of-type (simple-array (unsigned-byte 8) (*)) across scanlines
for k of-type (unsigned-byte 32) from 0
do (loop for xi of-type (unsigned-byte 32) from 1 below (length scanline) by bda
for y of-type (unsigned-byte 32) from 0
do (setf (aref image-data (floor y 4) k (mod y 4))
(loop for i from (1- bda) downto 0
for j from xi below (expt 2 20)
sum (ash (aref scanline j) (* 8 i))
into s of-type (unsigned-byte 32)
finally (return s)))))))
png-state))

(defun get-scanlines (data h filtered-scanline-length)
Expand Down
12 changes: 6 additions & 6 deletions deinterlace.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,10 +30,10 @@
(let ((step-ctr
(ceiling
(* w h bd (ecase colour-type
((:truecolor8 :truecolor16) 3)
(:truecolor 3)
(:greyscale 1)
(:greyscale-alpha 2)
((:truecolor-alpha8 :truecolor-alpha16) 4)
(:truecolor-alpha 4)
(:indexed-colour 1))) 8)))
(iter (until (zerop (mod step-ctr h)))
(incf step-ctr))
Expand Down Expand Up @@ -70,10 +70,10 @@
(defun finish-deinterlace (colour-type w h sub-images sub-arrays sub-heights)
(let ((image-dimensions (ecase colour-type
(:greyscale (list w h))
((:truecolor8 :truecolor16) (list w h 3))
(:truecolor (list w h 3))
(:indexed-colour (list w h 3))
(:greyscale-alpha (list w h 2))
((:truecolor-alpha8 :truecolor-alpha16) (list w h 4)))))
(:truecolor-alpha (list w h 4)))))
(check-type image-dimensions (cons fixnum (cons fixnum (or null (cons fixnum null)))))
(let ((image-final (make-array image-dimensions :initial-element 0)))
(iter (for sub-array in-vector sub-arrays)
Expand All @@ -85,15 +85,15 @@
(:greyscale
(setf (aref image-final x y)
(aref sub-image (floor i sub-height) (mod i sub-height))))
((:truecolor8 :truecolor16 :indexed-colour)
((:truecolor :indexed-colour)
(iter (for k from 0 to 2)
(setf (aref image-final x y k)
(aref sub-image (floor i sub-height) (mod i sub-height) k))))
(:greyscale-alpha
(iter (for k from 0 to 1)
(setf (aref image-final x y k)
(aref sub-image (floor i sub-height) (mod i sub-height) k))))
((:truecolor-alpha8 :truecolor-alpha16)
(:truecolor-alpha
(iter (for k from 0 to 3)
(setf (aref image-final x y k)
(aref sub-image (floor i sub-height) (mod i sub-height) k)))))))
Expand Down

0 comments on commit ec29f38

Please sign in to comment.