Jump to content

Bitmap/Read a PPM file: Difference between revisions

Bitmap/Read a PPM file (view source)

Revision as of 12:06, 26 July 2012

197 bytes removed ,  11 years ago
→‎{{header|Common Lisp}}
Line 286:
 
(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)
(file-position stream start-position)
Line 298 ⟶ 297:
(max-value (parse-integer (fourth header) :junk-allowed t))
(image (make-rgb-pixel-buffer width height)))
(ifwhen (> max-value 255)▼
(error "unsupported depth - convert to 1byte depth with pamdepth"))▼
(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 valstream)
(setf (make-rgb-pixel image w h)(read-byte val)stream)
#' (lambdaread-byte (stream)
(make-rgb-pixel (read-byte stream))))
image)))▼
(read-byte stream)
(read-byte stream))))
▲ image)))
((string= "P3" image-type)
(ifwith-open-file (>stream max-valuefile :direction 255: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 valstream)
(setf (make-rgb-pixel image w h)(read val)stream)
#' (lambdaread (stream)
(make-rgb-pixel (read stream))))
image)))▼
(read stream)
(read stream))))
▲ image)))
(t 'unsupported))
image))))
 
(export 'read-ppm-image)
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/92412"
Cookies help us deliver our services. By using our services, you agree to our use of cookies.
More information