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/pgm.scm | 86 ++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 43 insertions(+), 43 deletions(-)

(limited to 'pnm/pgm.scm')

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