diff options
| -rw-r--r-- | pnm/read.scm | 61 |
1 files changed, 48 insertions, 13 deletions
diff --git a/pnm/read.scm b/pnm/read.scm index 1f0017a..55e5068 100644 --- a/pnm/read.scm +++ b/pnm/read.scm @@ -17,18 +17,17 @@ ;;; along with R7RS-PNM. If not, see <https://www.gnu.org/licenses/>. (define-library (pnm read) - (export image-read) + (export image-read + pnm-parse-error? + pnm-parse-error-type) (import (scheme base) + (scheme write) (pnm image) (pnm pbm) (pnm pgm) (pnm ppm)) (begin (define (image-read in) - (define (unexpected-eof-error) - (error "(pnm read) image-read: Unexpected end of file")) - (define (unexpected-char-error) - (error "(pnm read) image-read: Unexpected character")) (define (read-u8*) (let ((u8 (read-u8 in))) (when (eof-object? u8) @@ -39,24 +38,24 @@ (when (eof-object? magic-number) (unexpected-eof-error)) (unless magic-number - (error "(pnm read) image-read: Not supported magic number")) + (unexpected-magic-number-error)) magic-number)) (define (read-number*) (let ((n (read-number in))) (when (eof-object? n) (unexpected-eof-error)) (unless n - (unexpected-char-error)) + (unexpected-character-error)) n)) (define (read-whitespaces*) (let ((result (read-whitespaces in))) (when (eof-object? result) (unexpected-eof-error)) (unless result - (error "(pnm read) image-read: Unexpected character (expected whitespace)")))) + (unexpected-character-error)))) (define (read-single-whitespace*) (unless (whitespace? (read-u8*)) - (unexpected-char-error))) + (unexpected-character-error))) (let ((magic-number (read-magic-number*))) (read-whitespaces*) @@ -75,7 +74,7 @@ (lambda (x y v) (image-set! pbm-image x y (= v 1))) unexpected-eof-error - unexpected-char-error) + unexpected-character-error) pbm-image)) (else (read-whitespaces*) @@ -91,7 +90,7 @@ (let ((ppm-image (make-ppm-image width height maxval))) (read-text-raster width height #t in (image-pixel-setter ppm-image) unexpected-eof-error - unexpected-char-error) + unexpected-character-error) ppm-image)) ((P5) (read-single-whitespace*) @@ -103,7 +102,7 @@ (let ((pgm-image (make-pgm-image width height maxval))) (read-text-raster width height #f in (image-pixel-setter pgm-image) unexpected-eof-error - unexpected-char-error) + unexpected-character-error) pgm-image)))))))))) (define (whitespace? u8) @@ -218,4 +217,40 @@ ((digit? u8) (read-u8 in) (loop (+ (* number 10) (u8->integer u8)))) - (else number))))))))) + (else number)))))))) + (cond-expand + ((library (srfi 35)) + (import (srfi 35)) + (begin + (define-condition-type &pnm-parse-error &error + pnm-parse-error? + (type pnm-parse-error-type)) + + (define (unexpected-magic-number-error) + (raise (condition (&pnm-parse-error + (type 'unexpected-magic-number-error)) + (&message + (message "(pnm read) image-read: Not supported magic number"))))) + (define (unexpected-eof-error) + (raise (condition (&pnm-parse-error + (type 'unexpected-eof-error)) + (&message + (message "(pnm read) image-read: Unexpected end of file"))))) + (define (unexpected-character-error) + (raise (condition (&pnm-parse-error + (type 'unexpected-character-error)) + (&message + (message "(pnm read) image-read: Unexpected character"))))))) + (r7rs + (begin + (define-record-type <pnm-parse-error> + (make-pnm-parse-error type) + pnm-parse-error? + (type pnm-parse-error-type)) + + (define (unexpected-magic-number-error) + (raise (make-pnm-parse-error 'unexpected-magic-number-error))) + (define (unexpected-eof-error) + (raise (make-pnm-parse-error 'unexpected-eof-error))) + (define (unexpected-character-error) + (raise (make-pnm-parse-error 'unexpected-character-error))))))) |