diff options
Diffstat (limited to 'pnm')
| -rw-r--r-- | pnm/pbm.scm | 5 | ||||
| -rw-r--r-- | pnm/pgm.scm | 19 | ||||
| -rw-r--r-- | pnm/ppm.scm | 10 |
3 files changed, 23 insertions, 11 deletions
diff --git a/pnm/pbm.scm b/pnm/pbm.scm index 32506e0..7e7bc78 100644 --- a/pnm/pbm.scm +++ b/pnm/pbm.scm @@ -37,7 +37,8 @@ (data (make-bytevector byte-count 0))) (make-pbm-image width height data))) ((width height data) - (let* ((byte-width (ceiling (/ width 8)))) + (let* ((byte-width (ceiling (/ width 8))) + (byte-count (* byte-width height))) (define (xy->byte-idx+bit-idx x y) (let-values (((byte-x bit-x) (floor/ x 8))) (values (+ (* y byte-width) @@ -52,4 +53,6 @@ (let ((byte (bytevector-u8-ref data byte-idx))) (bytevector-u8-set! data byte-idx (copy-bit (- 7 bit-idx) byte b))))) + (unless (= byte-count (bytevector-length data)) + (error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count))) (make-image 'pbm width height 1 data pixel-getter pixel-setter))))))) diff --git a/pnm/pgm.scm b/pnm/pgm.scm index 6c32dea..0f448f6 100644 --- a/pnm/pgm.scm +++ b/pnm/pgm.scm @@ -28,19 +28,18 @@ (when (or (< maxval 0) (< 65536 maxval)) (error "(pnm pgm) make-pgm: maxval is out of range")) - (let ((data (make-bytevector (* width - height - (if (< maxval 256) - 1 - 2)) - 0))) + (let* ((byte-count (* width height + (if (< maxval 256) + 1 + 2))) + (data (make-bytevector byte-count 0))) (make-pgm-image width height maxval data))) ((width height maxval data) (when (or (< maxval 0) (< 65536 maxval)) (error "(pnm pgm) make-pgm: maxval is out of range")) (if (< maxval 256) - (let () + (let ((byte-count (* width height))) (define (xy->idx x y) (+ x (* y width))) (define (pixel-getter x y) (let ((idx (xy->idx x y))) @@ -48,8 +47,10 @@ (define (pixel-setter x y v) (let ((idx (xy->idx x y))) (bytevector-u8-set! data idx v))) + (unless (= byte-count (bytevector-length data)) + (error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count))) (make-image 'pgm width height maxval data pixel-getter pixel-setter)) - (let () + (let ((byte-count (* width height 2))) (define (xy->idx x y) (+ x (* y width))) (define (pixel-getter x y) (let ((idx (xy->idx x y))) @@ -60,6 +61,8 @@ (let-values (((v1 v2) (split-value v))) (bytevector-u8-set! data idx v1) (bytevector-u8-set! data (+ idx 1) v2)))) + (unless (= byte-count (bytevector-length data)) + (error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count))) (make-image 'pgm width height maxval data pixel-getter pixel-setter)))))) (define (split-value v) diff --git a/pnm/ppm.scm b/pnm/ppm.scm index 4ca453e..95ce837 100644 --- a/pnm/ppm.scm +++ b/pnm/ppm.scm @@ -40,7 +40,8 @@ (< 65536 maxval)) (error "(pnm ppm) make-ppm-image: Maxval is out of range")) (if (< maxval 256) - (let* ((w*3 (* width 3))) + (let* ((w*3 (* width 3)) + (byte-count (* w*3 height))) (define (xy->idx x y) (+ (* 3 x) (* y w*3))) (define (pixel-getter x y) (let ((idx (xy->idx x y))) @@ -52,8 +53,11 @@ (bytevector-u8-set! data idx r) (bytevector-u8-set! data (+ idx 1) g) (bytevector-u8-set! data (+ idx 2) b))) + (unless (= byte-count (bytevector-length data)) + (error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count))) (make-image 'ppm width height maxval data pixel-getter pixel-setter)) - (let* ((w*6 (* width 6))) + (let* ((w*6 (* width 6)) + (byte-count (* w*6 height))) (define (xy->idx x y) (+ (* 6 x) (* y w*6))) (define (pixel-getter x y) (let ((idx (xy->idx x y))) @@ -74,6 +78,8 @@ (bytevector-u8-set! data (+ idx 3) g2) (bytevector-u8-set! data (+ idx 4) b1) (bytevector-u8-set! data (+ idx 5) b2)))) + (unless (= byte-count (bytevector-length data)) + (error (string-append "(pnm pbm) make-pbm-image: Invalid bytevector length" byte-count))) (make-image 'ppm width height maxval data pixel-getter pixel-setter)))))) (define (split-value v) |