diff options
Diffstat (limited to 'pnm/read.scm')
| -rw-r--r-- | pnm/read.scm | 39 |
1 files changed, 24 insertions, 15 deletions
diff --git a/pnm/read.scm b/pnm/read.scm index e88f958..ae7676f 100644 --- a/pnm/read.scm +++ b/pnm/read.scm @@ -20,6 +20,7 @@ (export image-read) (import (scheme base) (pnm image) + (pnm pbm) (pnm pgm) (pnm ppm)) (begin @@ -56,21 +57,28 @@ (let ((width (read-number in))) (read-whitespaces*) (let ((height (read-number in))) - (read-whitespaces*) - (let ((maxval (read-number in))) - (unless (whitespace? (read-u8*)) - (unexpected-char-error)) - (case magic-number - ((P6) - (make-ppm-image width height maxval - (if (< maxval 256) - (read-bytevector (* 3 width height) in) - (read-bytevector (* 6 width height) in)))) - ((P5) - (make-pgm-image width height maxval - (if (< maxval 256) - (read-bytevector (* width height) in) - (read-bytevector (* 2 width height) in)))))))))) + (case magic-number + ((P4) + (unless (whitespace? (read-u8*)) + (unexpected-char-error)) + (make-pbm-image width height + (read-bytevector (* (ceiling (/ width 8)) height) in))) + (else + (read-whitespaces*) + (let ((maxval (read-number in))) + (unless (whitespace? (read-u8*)) + (unexpected-char-error)) + (case magic-number + ((P6) + (make-ppm-image width height maxval + (if (< maxval 256) + (read-bytevector (* 3 width height) in) + (read-bytevector (* 6 width height) in)))) + ((P5) + (make-pgm-image width height maxval + (if (< maxval 256) + (read-bytevector (* width height) in) + (read-bytevector (* 2 width height) in)))))))))))) (define (whitespace? u8) (case (integer->char u8) @@ -111,6 +119,7 @@ ((or (eof-object? u8-1) (eof-object? u8-2)) (eof-object)) ((and (= u8-1 P/u8) (= u8-2/int 6)) 'P6) ((and (= u8-1 P/u8) (= u8-2/int 5)) 'P5) + ((and (= u8-1 P/u8) (= u8-2/int 4)) 'P4) (else #f)))) (define (read-whitespaces in) |