aboutsummaryrefslogtreecommitdiff
path: root/pnm/pgm.scm
diff options
context:
space:
mode:
Diffstat (limited to 'pnm/pgm.scm')
-rw-r--r--pnm/pgm.scm86
1 files changed, 43 insertions, 43 deletions
diff --git a/pnm/pgm.scm b/pnm/pgm.scm
index 0f448f6..89f4c35 100644
--- a/pnm/pgm.scm
+++ b/pnm/pgm.scm
@@ -17,53 +17,53 @@
;;; along with R7RS-PNM. If not, see <https://www.gnu.org/licenses/>.
(define-library (pnm pgm)
- (export make-pgm-image)
+ (export make-pgm-image
+ %make-pgm-image)
(import (scheme base)
(scheme case-lambda)
(pnm image))
(begin
- (define make-pgm-image
- (case-lambda
- ((width height maxval)
- (when (or (< maxval 0)
- (< 65536 maxval))
- (error "(pnm pgm) make-pgm: maxval is out of range"))
- (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 ((byte-count (* width height)))
- (define (xy->idx x y) (+ x (* y width)))
- (define (pixel-getter x y)
- (let ((idx (xy->idx x y)))
- (bytevector-u8-ref data idx)))
- (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 ((byte-count (* width height 2)))
- (define (xy->idx x y) (+ x (* y width)))
- (define (pixel-getter x y)
- (let ((idx (xy->idx x y)))
- (combine-values (bytevector-u8-ref data idx)
- (bytevector-u8-ref data (+ idx 1)))))
- (define (pixel-setter x y v)
- (let ((idx (xy->idx x y)))
- (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 (make-pgm-image width height maxval)
+ (when (or (< maxval 0)
+ (< 65536 maxval))
+ (error "(pnm pgm) make-pgm: maxval is out of range"))
+ (let* ((byte-count (* width height
+ (if (< maxval 256)
+ 1
+ 2)))
+ (data (make-bytevector byte-count 0)))
+ (%make-pgm-image width height maxval data)))
+
+ (define (%make-pgm-image width height maxval data)
+ (when (or (< maxval 0)
+ (< 65536 maxval))
+ (error "(pnm pgm) make-pgm: maxval is out of range"))
+ (if (< maxval 256)
+ (let ((byte-count (* width height)))
+ (define (xy->idx x y) (+ x (* y width)))
+ (define (pixel-getter x y)
+ (let ((idx (xy->idx x y)))
+ (bytevector-u8-ref data idx)))
+ (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 ((byte-count (* width height 2)))
+ (define (xy->idx x y) (+ x (* y width)))
+ (define (pixel-getter x y)
+ (let ((idx (xy->idx x y)))
+ (combine-values (bytevector-u8-ref data idx)
+ (bytevector-u8-ref data (+ idx 1)))))
+ (define (pixel-setter x y v)
+ (let ((idx (xy->idx x y)))
+ (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)
(values (modulo (quotient v 256) 256)