Bitmap/Read a PPM file: Difference between revisions

Content added Content deleted
Line 286: Line 286:


(defun read-ppm-image (file)
(defun read-ppm-image (file)
"reads an image from a ppm file and constructs the rgb-pixel-buffer"
(flet ((image-data-reader (stream start-position width height image-build-function read-function)
(flet ((image-data-reader (stream start-position width height image-build-function read-function)
(file-position stream start-position)
(file-position stream start-position)
Line 298: Line 297:
(max-value (parse-integer (fourth header) :junk-allowed t))
(max-value (parse-integer (fourth header) :junk-allowed t))
(image (make-rgb-pixel-buffer width height)))
(image (make-rgb-pixel-buffer width height)))
(when (> max-value 255)
(error "unsupported depth - convert to 1byte depth with pamdepth"))
(cond ((string= "P6" image-type)
(cond ((string= "P6" image-type)
(with-open-file (stream file :direction :input :element-type '(unsigned-byte 8))
(if (> max-value 255)
(image-data-reader stream
(error "unsupported depth - convert to 1byte depth with pamdepth")
file-pos
(with-open-file (stream file :direction :input :element-type '(unsigned-byte 8))
width
(image-data-reader stream
file-pos
height
#'(lambda (w h val)
width
(setf (rgb-pixel image w h) val))
height
#'(lambda (w h val)
#'(lambda (stream)
(setf (rgb-pixel image w h) val))
(make-rgb-pixel (read-byte stream)
#'(lambda (stream)
(read-byte stream)
(make-rgb-pixel (read-byte stream)
(read-byte stream))))
image))
(read-byte stream)
(read-byte stream))))
image)))
((string= "P3" image-type)
((string= "P3" image-type)
(if (> max-value 255)
(with-open-file (stream file :direction :input)
(image-data-reader stream
(error "unsupported depth - convert to 1byte depth with pamdepth")
file-pos
(with-open-file (stream file :direction :input)
width
(image-data-reader stream
file-pos
height
#'(lambda (w h val)
width
(setf (rgb-pixel image w h) val))
height
#'(lambda (w h val)
#'(lambda (stream)
(setf (rgb-pixel image w h) val))
(make-rgb-pixel (read stream)
#'(lambda (stream)
(read stream)
(make-rgb-pixel (read stream)
(read stream))))
image))
(read stream)
(read stream))))
image)))
(t 'unsupported))
(t 'unsupported))
image))))
image))))


(export 'read-ppm-image)
(export 'read-ppm-image)