From fd4a72db990d6ec5e62b4d1ffebd8f40c8ee5a30 Mon Sep 17 00:00:00 2001
From: Masaya Tojo <masaya@tojo.tokyo>
Date: Sun, 4 Aug 2024 19:34:27 +0900
Subject: Remove the ability to pass bytevector directly to make-*-image

---
 pnm/pbm.scm  |  56 ++++++++++++++--------------
 pnm/pgm.scm  |  86 +++++++++++++++++++++---------------------
 pnm/ppm.scm  | 120 +++++++++++++++++++++++++++++------------------------------
 pnm/read.scm |  20 +++++-----
 4 files changed, 141 insertions(+), 141 deletions(-)

(limited to 'pnm')

diff --git a/pnm/pbm.scm b/pnm/pbm.scm
index 7e7bc78..b8e3178 100644
--- a/pnm/pbm.scm
+++ b/pnm/pbm.scm
@@ -17,7 +17,8 @@
 ;;; along with R7RS-PNM. If not, see <https://www.gnu.org/licenses/>.
 
 (define-library (pnm pbm)
-  (export make-pbm-image)
+  (export make-pbm-image
+          %make-pbm-image)
   (import (scheme base)
           (scheme case-lambda)
           (pnm image))
@@ -29,30 +30,29 @@
     ((library (srfi 151))
      (import (only (srfi 151) bit-set? copy-bit))))
   (begin
-    (define make-pbm-image
-      (case-lambda
-        ((width height)
-         (let* ((byte-width (ceiling (/ width 8)))
-                (byte-count (* byte-width height))
-                (data (make-bytevector byte-count 0)))
-           (make-pbm-image width height data)))
-        ((width height data)
-         (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)
-                          byte-x)
-                       bit-x)))
-           (define (pixel-getter x y)
-             (let-values (((byte-idx bit-idx) (xy->byte-idx+bit-idx x y)))
-               (let ((byte (bytevector-u8-ref data byte-idx)))
-                 (bit-set? (- 7 bit-idx) byte))))
-           (define (pixel-setter x y b)
-             (let-values (((byte-idx bit-idx) (xy->byte-idx+bit-idx x y)))
-               (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)))))))
+    (define (make-pbm-image width height)
+      (let* ((byte-width (ceiling (/ width 8)))
+             (byte-count (* byte-width height))
+             (data (make-bytevector byte-count 0)))
+        (%make-pbm-image width height data)))
+
+    (define (%make-pbm-image width height data)
+      (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)
+                       byte-x)
+                    bit-x)))
+        (define (pixel-getter x y)
+          (let-values (((byte-idx bit-idx) (xy->byte-idx+bit-idx x y)))
+            (let ((byte (bytevector-u8-ref data byte-idx)))
+              (bit-set? (- 7 bit-idx) byte))))
+        (define (pixel-setter x y b)
+          (let-values (((byte-idx bit-idx) (xy->byte-idx+bit-idx x y)))
+            (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 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)
diff --git a/pnm/ppm.scm b/pnm/ppm.scm
index 95ce837..496eee1 100644
--- a/pnm/ppm.scm
+++ b/pnm/ppm.scm
@@ -17,70 +17,70 @@
 ;;; along with R7RS-PNM. If not, see <https://www.gnu.org/licenses/>.
 
 (define-library (pnm ppm)
-  (export make-ppm-image)
+  (export make-ppm-image
+          %make-ppm-image)
   (import (scheme base)
           (scheme case-lambda)
           (pnm image))
   (begin
-    (define make-ppm-image
-      (case-lambda
-        ((width height maxval)
-         (when (or (< maxval 0)
-                   (< 65536 maxval))
-           (error "(pnm ppm) make-ppm-image: Maxval is out of range"))
-         (let ((data (make-bytevector (* width
-                                         height
-                                         (if (< maxval 256)
-                                             3
-                                             6))
-                                      0)))
-           (make-ppm-image width height maxval data)))
-        ((width height maxval data)
-         (when (or (< maxval 0)
-                   (< 65536 maxval))
-           (error "(pnm ppm) make-ppm-image: Maxval is out of range"))
-         (if (< maxval 256)
-             (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)))
-                   (values (bytevector-u8-ref data idx)
-                           (bytevector-u8-ref data (+ idx 1))
-                           (bytevector-u8-ref data (+ idx 2)))))
-               (define (pixel-setter x y r g b)
-                 (let ((idx (xy->idx x y)))
-                   (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))
-                    (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)))
-                   (values (combine-values (bytevector-u8-ref data idx)
-                                           (bytevector-u8-ref data (+ idx 1)))
-                           (combine-values (bytevector-u8-ref data (+ idx 2))
-                                           (bytevector-u8-ref data (+ idx 3)))
-                           (combine-values (bytevector-u8-ref data (+ idx 4))
-                                           (bytevector-u8-ref data (+ idx 5))))))
-               (define (pixel-setter x y r g b)
-                 (let ((idx (xy->idx x y)))
-                   (let-values (((r1 r2) (split-value r))
-                                ((g1 g2) (split-value g))
-                                ((b1 b2) (split-value b)))
-                     (bytevector-u8-set! data idx r1)
-                     (bytevector-u8-set! data (+ idx 1) r2)
-                     (bytevector-u8-set! data (+ idx 2) g1)
-                     (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 (make-ppm-image width height maxval)
+      (when (or (< maxval 0)
+                (< 65536 maxval))
+        (error "(pnm ppm) make-ppm-image: Maxval is out of range"))
+      (let ((data (make-bytevector (* width
+                                      height
+                                      (if (< maxval 256)
+                                          3
+                                          6))
+                                   0)))
+        (%make-ppm-image width height maxval data)))
+
+    (define (%make-ppm-image width height maxval data)
+      (when (or (< maxval 0)
+                (< 65536 maxval))
+        (error "(pnm ppm) make-ppm-image: Maxval is out of range"))
+      (if (< maxval 256)
+          (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)))
+                (values (bytevector-u8-ref data idx)
+                        (bytevector-u8-ref data (+ idx 1))
+                        (bytevector-u8-ref data (+ idx 2)))))
+            (define (pixel-setter x y r g b)
+              (let ((idx (xy->idx x y)))
+                (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))
+                 (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)))
+                (values (combine-values (bytevector-u8-ref data idx)
+                                        (bytevector-u8-ref data (+ idx 1)))
+                        (combine-values (bytevector-u8-ref data (+ idx 2))
+                                        (bytevector-u8-ref data (+ idx 3)))
+                        (combine-values (bytevector-u8-ref data (+ idx 4))
+                                        (bytevector-u8-ref data (+ idx 5))))))
+            (define (pixel-setter x y r g b)
+              (let ((idx (xy->idx x y)))
+                (let-values (((r1 r2) (split-value r))
+                             ((g1 g2) (split-value g))
+                             ((b1 b2) (split-value b)))
+                  (bytevector-u8-set! data idx r1)
+                  (bytevector-u8-set! data (+ idx 1) r2)
+                  (bytevector-u8-set! data (+ idx 2) g1)
+                  (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)
       (values (modulo (quotient v 256) 256)
diff --git a/pnm/read.scm b/pnm/read.scm
index e277a32..a2e0555 100644
--- a/pnm/read.scm
+++ b/pnm/read.scm
@@ -64,8 +64,8 @@
             (case magic-number
               ((P4)
                (read-single-whitespace*)
-               (make-pbm-image width height
-                               (read-bytevector (* (ceiling (/ width 8)) height) in)))
+               (%make-pbm-image width height
+                                (read-bytevector (* (ceiling (/ width 8)) height) in)))
               ((P1)
                (let ((byte-width (ceiling (/ width 8)))
                      (pbm-image (make-pbm-image width height)))
@@ -81,10 +81,10 @@
                  (case magic-number
                    ((P6)
                     (read-single-whitespace*)
-                    (make-ppm-image width height maxval
-                                    (if (< maxval 256)
-                                        (read-bytevector (* 3 width height) in)
-                                        (read-bytevector (* 6 width height) in))))
+                    (%make-ppm-image width height maxval
+                                     (if (< maxval 256)
+                                         (read-bytevector (* 3 width height) in)
+                                         (read-bytevector (* 6 width height) in))))
                    ((P3)
                     (let ((ppm-image (make-ppm-image width height maxval)))
                       (read-text-raster width height #t in (image-pixel-setter ppm-image)
@@ -93,10 +93,10 @@
                       ppm-image))
                    ((P5)
                     (read-single-whitespace*)
-                    (make-pgm-image width height maxval
-                                    (if (< maxval 256)
-                                        (read-bytevector (* width height) in)
-                                        (read-bytevector (* 2 width height) in))))
+                    (%make-pgm-image width height maxval
+                                     (if (< maxval 256)
+                                         (read-bytevector (* width height) in)
+                                         (read-bytevector (* 2 width height) in))))
                    ((P2)
                     (let ((pgm-image (make-pgm-image width height maxval)))
                       (read-text-raster width height #f in (image-pixel-setter pgm-image)
-- 
cgit v1.2.3