Name:
Anonymous
2012-03-11 11:56
(defun png-load-stream (bs)
(let* ((chunks (png-parse bs))
(g nil)
(chns 0)
(IHDR (gethash "IHDR" chunks))
(IDAT (gethash "IDAT" chunks))
(PLTE (gethash "PLTE" chunks)))
(unless IHDR (gfx-load-error "Missing IHDR"))
(unless IDAT (gfx-load-error "Missing IDAT"))
(deser (strm IHDR) ((width msb 4)
(height msb 4)
(chn-depth msb 1)
(type msb 1)
(enc msb 1)
(filter msb 1)
(interlace msb 1))
(unless (= enc 0) (gfx-load-error "Unsupported encoding (~a)" enc))
(setf chns (case type
(0 1) ; grayscale
(2 3) ; truecolor
(3 2) ; indexed
(4 4) ; grayscale with alpha
(6 4) ; truecolor with alpha
(otherwise (gfx-load-error "Invalid color type (~d)" type))))
(setf g (gfx width height :c chns))
(setf IDAT (zlib-unpack-bytes IDAT))
(png-defilter g IDAT)
(case interlace
(0 ) ; no interlace
(1 (gfx-load-error "Interlaced PNGs are not supported")) (png-deinterlace-adam7 g))
(otherwise (gfx-load-error "Invalid interlace type (~d)" type)))
(when PLTE
(let ((a (vec 256 u4))
(n (truncate (length PLTE) 3))
(s (strm PLTE)))
(dotimes (i n)
(deser s ((r msb 1)
(g msb 1)
(b msb 1))
(setf (aref a i) (rgb r g b))))
(setf (gfx-m g) a)))
g))))