Add `unsafe?` option for image creation procedures

- Add (private bitwise) module and use it
- Add (private checker) module and use it
- Add (private double-byte) module and use it

1 files changed, 27 insertions, 15 deletions

diff --git a/pnm/pbm.scm b/pnm/pbm.scm
index b3d2c3c..696c4d3 100644
--- a/pnm/pbm.scm
+++ b/pnm/pbm.scm
@@ -21,22 +21,21 @@
           %make-pbm-image)
   (import (scheme base)
           (scheme case-lambda)
-          (pnm image))
-  (cond-expand
-    ((library (scheme bitwise))
-     (import (only (scheme bitwise) bit-set? copy-bit)))
-    ((library (srfi 60))
-     (import (only (srfi 60) bit-set? copy-bit)))
-    ((library (srfi 151))
-     (import (only (srfi 151) bit-set? copy-bit))))
+          (pnm image)
+          (pnm private checker)
+          (pnm private bitwise))
   (begin
-    (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
+      (case-lambda
+        ((width height)
+         (make-pbm-image width height #f))
+        ((width height unsafe?)
+         (let* ((byte-width (ceiling (/ width 8)))
+                (byte-count (* byte-width height))
+                (data (make-bytevector byte-count 0)))
+           (%make-pbm-image width height data unsafe?)))))
 
-    (define (%make-pbm-image width height data)
+    (define (%make-pbm-image width height data unsafe?)
       (let* ((byte-width (ceiling (/ width 8)))
              (byte-count (* byte-width height)))
         (define (xy->byte-idx+bit-idx x y)
@@ -55,4 +54,17 @@
                                   (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 #t data pixel-getter pixel-setter)))))
+        (let ((check-xy (make-xy-checker width height))
+              (check-boolean-value (make-boolean-value-checker)))
+          (make-image 'pbm width height #t data
+                      (if unsafe?
+                          pixel-getter
+                          (lambda (x y)
+                            (check-xy x y)
+                            (pixel-getter x y)))
+                      (if unsafe?
+                          pixel-setter
+                          (lambda (x y v)
+                            (check-xy x y)
+                            (check-boolean-value v)
+                            (pixel-setter x y v)))))))))