/prog/ - Is my Lisp enterprise enough?

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))))
Is my Lisp enterprise enough?

1 Name: Anonymous 2012-03-11 11:56

4 Name: Anonymous 2012-03-11 13:51

Name: Anonymous 2012-03-11 11:56

Name: Anonymous 2012-03-11 13:51
