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 ++++++++++++++++++++++++++++----------------------------
 1 file changed, 28 insertions(+), 28 deletions(-)

(limited to 'pnm/pbm.scm')

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)))))
-- 
cgit v1.2.3